diff options
-rw-r--r-- | cabal-helper.cabal | 8 | ||||
-rw-r--r-- | tests/Examples.hs | 65 |
2 files changed, 73 insertions, 0 deletions
diff --git a/cabal-helper.cabal b/cabal-helper.cabal index 5bcf6ba..f88891c 100644 --- a/cabal-helper.cabal +++ b/cabal-helper.cabal @@ -158,6 +158,14 @@ test-suite ghc-session , cabal-helper , c-h-internal +test-suite examples + import: build-deps, extensions + type: exitcode-stdio-1.0 + main-is: Examples.hs + hs-source-dirs: tests + ghc-options: -Wall + build-depends: cabal-helper + executable cabal-helper-main default-language: Haskell2010 default-extensions: NondecreasingIndentation 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 |