From 51e543878bfdece416fbc4f158a3780cc51eb139 Mon Sep 17 00:00:00 2001
From: "John J. Camilleri" <john@digitalgrammars.com>
Date: Thu, 18 Feb 2021 21:34:23 +0100
Subject: [PATCH] Add support for wildcards when specifying modules names in
 benchmark compilation

---
 testsuite/lpgf/README.md | 10 +++++-----
 testsuite/lpgf/bench.hs  | 25 ++++++++++++++++++-------
 2 files changed, 23 insertions(+), 12 deletions(-)

diff --git a/testsuite/lpgf/README.md b/testsuite/lpgf/README.md
index b2e335395..8ce550e90 100644
--- a/testsuite/lpgf/README.md
+++ b/testsuite/lpgf/README.md
@@ -32,9 +32,9 @@ The `+RTS -T -RTS` is so that GHC can report its own memory usage.
 
 ```
 stack build --test --bench --no-run-tests --no-run-benchmarks
-stack bench --benchmark-arguments "compile pgf  Foods*.gf +RTS -T -RTS"
-stack bench --benchmark-arguments "compile lpgf Foods*.gf +RTS -T -RTS"
-stack bench --benchmark-arguments "run pgf  Foods.pgf  foods.trees +RTS -T -RTS"
-stack bench --benchmark-arguments "run pgf2 Foods.pgf  foods.trees +RTS -T -RTS"
-stack bench --benchmark-arguments "run lpgf Foods.lpgf foods.trees +RTS -T -RTS"
+stack bench --benchmark-arguments "compile pgf  testsuite/lpgf/Foods*.gf +RTS -T -RTS"
+stack bench --benchmark-arguments "compile lpgf testsuite/lpgf/Foods*.gf +RTS -T -RTS"
+stack bench --benchmark-arguments "run pgf  Foods.pgf  testsuite/lpgf/foods-all.trees +RTS -T -RTS"
+stack bench --benchmark-arguments "run pgf2 Foods.pgf  testsuite/lpgf/foods-all.trees +RTS -T -RTS"
+stack bench --benchmark-arguments "run lpgf Foods.lpgf testsuite/lpgf/foods-all.trees +RTS -T -RTS"
 ```
diff --git a/testsuite/lpgf/bench.hs b/testsuite/lpgf/bench.hs
index cc32b5101..96538edad 100644
--- a/testsuite/lpgf/bench.hs
+++ b/testsuite/lpgf/bench.hs
@@ -9,7 +9,7 @@ import GF.Support (Options, Flags (..), Verbosity (..), noOptions, addOptions, m
 
 import Control.DeepSeq (force)
 import Control.Exception (evaluate)
-import Control.Monad (when)
+import Control.Monad (when, forM)
 import qualified Data.List as L
 import Data.Maybe (fromJust, isJust, isNothing)
 import qualified Data.Map as Map
@@ -18,7 +18,7 @@ import Data.Time.Clock (getCurrentTime, diffUTCTime)
 import System.Directory (listDirectory, getFileSize)
 import System.Environment (getArgs)
 import System.Exit (die)
-import System.FilePath ((</>), (<.>), takeBaseName, takeExtension, dropExtension)
+import System.FilePath ((</>), (<.>), takeFileName, takeDirectory, dropExtension)
 import Text.Printf (printf)
 
 import GHC.Stats
@@ -43,11 +43,22 @@ main = do
   when (mode == "compile" && argc < 2) (die usage)
   when (mode == "run" && argc < 3) (die usage)
   let target = let a1 = args !! 1 in if a1 `elem` ["pgf", "pgf2", "lpgf"] then Just a1 else Nothing
-  let mods = if mode == "compile" then drop (if isJust target then 2 else 1) args else []
-  -- If * is supplied in module name, collect modules ourselves
-  -- mods <- map (dir </>)
-  --       . filter (\p -> grammarName `L.isPrefixOf` takeBaseName p && takeExtension p == ".gf")
-  --       <$> listDirectory dir
+  let mods' = if mode == "compile" then drop (if isJust target then 2 else 1) args else []
+
+  mods <- concat <$> forM mods' (\mod ->
+    -- If * is supplied in module name, collect modules ourselves
+    if '*' `elem` mod
+    then do
+      let
+        dir = takeDirectory mod
+        pre = takeWhile (/='*') (takeFileName mod)
+        post = drop 1 $ dropWhile (/='*') (takeFileName mod)
+      map (dir </>)
+        . filter (\p -> let fn = takeFileName p in pre `L.isPrefixOf` fn && post `L.isSuffixOf` fn)
+        <$> listDirectory dir
+    else
+      return [mod]
+    )
 
   let binaryFile = if mode == "run" then Just $ args !! (if isJust target then 2 else 1) else Nothing
   let treesFile = if mode == "run" then Just $ args !! (if isJust target then 3 else 2) else Nothing