compile-test: Add program commandline options

3 files changed, 40 insertions, 28 deletions

diff --git a/tests/CompileTest.hs b/tests/CompileTest.hs
index 1b024d2..77698c5 100644
--- a/tests/CompileTest.hs
+++ b/tests/CompileTest.hs
@@ -38,6 +38,8 @@ import CabalHelper.Compiletime.Program.GHC
 import CabalHelper.Compiletime.Types
 import CabalHelper.Shared.Common
 
+import TestOptions
+
 withinRange'CH :: Version -> VersionRange -> Bool
 withinRange'CH v r =
     withinRange (fromDataVersion v) r
@@ -61,11 +63,12 @@ createHOME = do
 
 main :: IO ()
 main = do
-  let ?progs = defaultPrograms
+  (modProgs, args) <- testOpts =<< getArgs
+
+  let ?progs = modProgs defaultPrograms
   let ?opts = defaultCompileOptions { oVerbose = True }
   let ?verbose = \level -> case level of 1 -> True; _ -> False
 
-  args <- getArgs
   case args of
     "list-versions":[] -> do
         mapM_ print =<< relevantCabalVersions =<< ghcVersion
diff --git a/tests/GhcSession.hs b/tests/GhcSession.hs
index e4ae431..6662b41 100644
--- a/tests/GhcSession.hs
+++ b/tests/GhcSession.hs
@@ -22,7 +22,6 @@ import Data.Maybe
 import Data.Version
 import Data.Bifunctor
 import qualified Data.Map as Map
-import System.Console.GetOpt as GetOpt
 import System.Environment (getArgs)
 import System.Exit
 import System.FilePath ((</>), (<.>), makeRelative, takeDirectory)
@@ -43,6 +42,8 @@ import CabalHelper.Compiletime.Program.GHC
 import CabalHelper.Compiletime.Program.CabalInstall
   (CabalInstallVersion(..), cabalInstallVersion)
 
+import TestOptions
+
 data TestConfig = TC
   { location        :: TestLocation
   , cabalLowerBound :: Version
@@ -60,31 +61,6 @@ testConfigToTestSpec (TC loc _ _ _) pt =
   let (topdir, projdir, cabal_file) = testLocPath loc in
   "- " ++ intercalate ":" [topdir, projdir, cabal_file, show pt]
 
-type ModProgs = (Programs -> Programs)
-
-options :: [OptDescr ModProgs]
-options =
-    [ GetOpt.Option [] ["with-cabal"]
-        (ReqArg (\arg -> \p -> p { cabalProgram = arg }) "PROG")
-        "name or path of 'cabal' executable"
-    , GetOpt.Option [] ["with-stack"]
-        (ReqArg (\arg -> \p -> p { stackProgram = arg }) "PROG")
-        "name or path of 'stack' executable"
-    , GetOpt.Option [] ["with-ghc"]
-        (ReqArg (\arg -> \cp -> cp { ghcProgram = arg }) "PROG")
-        "name or path of 'ghc' executable"
-    , GetOpt.Option [] ["with-ghc-pkg"]
-        (ReqArg (\arg -> \cp -> cp { ghcPkgProgram = arg }) "PROG")
-        "name or path of 'ghc-pkg' executable"
-    ]
-
-testOpts :: [String] -> IO (ModProgs, [String])
-testOpts args =
-   case getOpt Permute options args of
-      (o,n,[]  ) -> return (foldl (flip (.)) id o, n)
-      (_,_,errs) -> ioError (userError (concat errs ++ usageInfo header options))
-  where header = "Usage: ghc-session [OPTION..] [TEST_SPEC..]"
-
 main :: IO ()
 main = do
   (modProgs, args) <- testOpts =<< getArgs
diff --git a/tests/TestOptions.hs b/tests/TestOptions.hs
new file mode 100644
index 0000000..0504f8f
--- /dev/null
+++ b/tests/TestOptions.hs
@@ -0,0 +1,33 @@
+module TestOptions
+    ( ModProgs
+    , testOpts
+    ) where
+
+import System.Console.GetOpt as GetOpt
+
+import CabalHelper.Compiletime.Types
+
+type ModProgs = (Programs -> Programs)
+
+options :: [OptDescr ModProgs]
+options =
+    [ GetOpt.Option [] ["with-cabal"]
+        (ReqArg (\arg -> \p -> p { cabalProgram = arg }) "PROG")
+        "name or path of 'cabal' executable"
+    , GetOpt.Option [] ["with-stack"]
+        (ReqArg (\arg -> \p -> p { stackProgram = arg }) "PROG")
+        "name or path of 'stack' executable"
+    , GetOpt.Option [] ["with-ghc"]
+        (ReqArg (\arg -> \cp -> cp { ghcProgram = arg }) "PROG")
+        "name or path of 'ghc' executable"
+    , GetOpt.Option [] ["with-ghc-pkg"]
+        (ReqArg (\arg -> \cp -> cp { ghcPkgProgram = arg }) "PROG")
+        "name or path of 'ghc-pkg' executable"
+    ]
+
+testOpts :: [String] -> IO (ModProgs, [String])
+testOpts args =
+   case getOpt Permute options args of
+      (o,n,[]  ) -> return (foldl (flip (.)) id o, n)
+      (_,_,errs) -> ioError (userError (concat errs ++ usageInfo header options))
+  where header = "Usage: ghc-session [OPTION..] [TEST_SPEC..]"