diff options
author | Daniel Gröber <dxld@darkboxed.org> | 2018-12-16 17:43:47 +0100 |
---|---|---|
committer | Daniel Gröber <dxld@darkboxed.org> | 2019-01-22 03:06:51 +0100 |
commit | 344753970fa7bc929b62ea8c25a77bddfdee9f15 (patch) | |
tree | c9bdb977dbe00b4511d100a4bd04abd62bd975a3 /tests | |
parent | 227b8a3bf1302626339be3c35e3e4102fe8bc874 (diff) |
Add example to show off cabal-helper's functionality
Diffstat (limited to 'tests')
-rw-r--r-- | tests/Examples.hs | 65 |
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 |