Add example to show off cabal-helper's functionality

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