aboutsummaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
authorDaniel Gröber <dxld@darkboxed.org>2018-12-16 17:43:47 +0100
committerDaniel Gröber <dxld@darkboxed.org>2019-01-22 03:06:51 +0100
commit344753970fa7bc929b62ea8c25a77bddfdee9f15 (patch)
treec9bdb977dbe00b4511d100a4bd04abd62bd975a3 /tests
parent227b8a3bf1302626339be3c35e3e4102fe8bc874 (diff)
Add example to show off cabal-helper's functionality
Diffstat (limited to 'tests')
-rw-r--r--tests/Examples.hs65
1 files changed, 65 insertions, 0 deletions
diff --git a/tests/Examples.hs b/tests/Examples.hs
new file mode 100644
index 0000000..607b83d
--- /dev/null
+++ b/tests/Examples.hs
@@ -0,0 +1,65 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Main where
+
+import Distribution.Helper
+import Data.Foldable
+ ( toList )
+import System.Process
+ ( system )
+import System.Environment
+ ( getArgs )
+import System.Exit
+ ( ExitCode(ExitSuccess) )
+import System.IO
+ ( hPutStrLn, stderr )
+import System.Console.GetOpt
+ ( OptDescr(Option), ArgDescr(NoArg), ArgOrder(RequireOrder), getOpt
+ , usageInfo )
+
+main :: IO ()
+main = do
+ args <- getArgs
+ actions <- parseOpts args
+ sequence_ actions
+
+-- | Run shell command and
+systemV :: String -> IO ()
+systemV shell_cmd = do
+ hPutStrLn stderr $ "$ " ++ shell_cmd
+ ExitSuccess <- system shell_cmd
+ return ()
+
+options :: [OptDescr (IO ())]
+options =
+ [ Option [] ["cabal"] (NoArg doCabalV2) ""
+ , Option [] ["cabal-old-v1"] (NoArg doCabalV1) ""
+ , Option [] ["stack"] (NoArg doCabalV2) ""
+ ]
+
+parseOpts :: [String] -> IO [IO ()]
+parseOpts argv =
+ case getOpt RequireOrder options argv of
+ (o, [], [] ) ->
+ return o
+ (_, _, errs) ->
+ ioError (userError (concat errs ++ usageInfo header options))
+ where header = "Usage: examples (--cabal|--cabal-old-v1|--stack)..."
+
+doCabalV2 :: IO ()
+doCabalV2 = do
+ _ <- systemV "cabal new-build --builddir=dist-newstyle"
+ qe <- mkQueryEnv (ProjLocV2Dir ".") (DistDirV2 "dist-newstyle/")
+ printUnitInfos qe
+
+doCabalV1 :: IO ()
+doCabalV1 = return ()
+
+doStack :: IO ()
+doStack = return ()
+
+printUnitInfos :: QueryEnv pt -> IO ()
+printUnitInfos qe = do
+ components :: [ChComponentInfo]
+ <- concat <$> runQuery (allUnits (toList . uiComponents)) qe
+ print components