[commit: packages/directory] improve-tests-for-real: Fix dependency cycle problem (c9a879b)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/directory

On branch  : improve-tests-for-real
Link       : http://ghc.haskell.org/trac/ghc/changeset/c9a879bc362da2be31da018b62bcfd50a5802cb7/directory

>---------------------------------------------------------------

commit c9a879bc362da2be31da018b62bcfd50a5802cb7
Author: Phil Ruffwind <rf at rufflewind.com>
Date:   Mon Mar 2 17:57:03 2015 -0500

    Fix dependency cycle problem


>---------------------------------------------------------------

c9a879bc362da2be31da018b62bcfd50a5802cb7
 directory.cabal   |  5 ++++-
 testsuite/Main.hs | 41 +++++++++++++++++++++++++++++++++++++----
 2 files changed, 41 insertions(+), 5 deletions(-)

diff --git a/directory.cabal b/directory.cabal
index ad62a8b..36e1b39 100644
--- a/directory.cabal
+++ b/directory.cabal
@@ -83,9 +83,12 @@ Library
 
 test-suite test
   default-language: Haskell2010
+  other-extensions:
+    CPP
+    ForeignFunctionInterface
+  ghc-options: -Wall
   hs-source-dirs: testsuite
   main-is: Main.hs
   type: exitcode-stdio-1.0
   build-depends: base
                , directory
-               , process
diff --git a/testsuite/Main.hs b/testsuite/Main.hs
index 052add8..bee6bc7 100644
--- a/testsuite/Main.hs
+++ b/testsuite/Main.hs
@@ -1,9 +1,42 @@
+{-# LANGUAGE CPP, ForeignFunctionInterface #-}
 module Main (main) where
-import System.Directory ()
+import Foreign (Ptr)
+import Foreign.C (CChar(..), CInt(..), withCString)
+import Data.Functor ((<$>))
+import System.Directory ()    -- make sure `directory` is built beforehand
 import System.Environment (getArgs)
-import System.Process (callProcess)
+import System.Exit (ExitCode(ExitSuccess, ExitFailure), exitWith)
 
 main :: IO ()
 main =
-  -- execute in the Cabal sandbox environment
-  callProcess "cabal" . (["exec", "--", "sh", "testsuite/run"] ++) =<< getArgs
+  exitWith =<<
+  rawSystem "cabal" .         -- execute in the Cabal sandbox environment
+  (["exec", "--", "sh", "testsuite/run"] ++) =<<
+  getArgs
+
+-- we can't use the `process` library as it causes a dependency cycle with
+-- Cabal, so we reinvent the wheel here in a simplistic way; this will
+-- probably break with non-ASCII characters on Windows
+rawSystem :: String -> [String] -> IO ExitCode
+rawSystem cmd args  =
+  withCString (unwords (quoteArgument <$> cmd : args)) $ \ c_command ->
+  makeExitCode . fromIntegral <$> c_system c_command
+
+makeExitCode :: Int -> ExitCode
+makeExitCode 0 = ExitSuccess
+makeExitCode e = ExitFailure e
+
+-- handle the different quoting rules in CMD.EXE vs POSIX shells
+quoteArgument :: String -> String
+#ifdef mingw32_HOST_OS
+quoteArgument s = "\"" ++ replaceElem '"' "\"\"" s ++ "\""
+#else
+quoteArgument s = "'" ++ replaceElem '\'' "'\\''" s ++ "'"
+#endif
+
+replaceElem :: Eq a => a -> [a] -> [a] -> [a]
+replaceElem match repl = concat . (replace <$>)
+  where replace c | c == match = repl
+                  | otherwise  = [c]
+
+foreign import ccall safe "stdlib.h system" c_system :: Ptr CChar -> IO CInt