[commit: packages/time] format-widths, improve-leapseconds, master, posix-perf, tasty, wip/travis: Make Setup.hs suitable for building in a GHC tree (2f507d7)

[git at git.haskell.org]

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

On branches: format-widths,improve-leapseconds,master,posix-perf,tasty,wip/travis
Link       : http://git.haskell.org/packages/time.git/commitdiff/2f507d73fbd98f417b70fd4ce01c1108c211847e

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

commit 2f507d73fbd98f417b70fd4ce01c1108c211847e
Author: Ian Lynagh <igloo at earth.li>
Date:   Sat Apr 7 10:41:49 2007 -0700

    Make Setup.hs suitable for building in a GHC tree
    
    darcs-hash:20070407174149-3fd76-51c9fae37e93e4f367400b38078fc490266864f0


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

2f507d73fbd98f417b70fd4ce01c1108c211847e
 Setup.hs | 68 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++--------
 1 file changed, 60 insertions(+), 8 deletions(-)

diff --git a/Setup.hs b/Setup.hs
index 2859262..9ef61d3 100644
--- a/Setup.hs
+++ b/Setup.hs
@@ -1,21 +1,73 @@
 module Main (main) where
 
+import Control.Exception
+import Data.List
 import Distribution.Simple
 import Distribution.PackageDescription
+import Distribution.PreProcess
+import Distribution.Setup
 import Distribution.Simple.LocalBuildInfo
-import System.Exit
 import System.Cmd
 import System.Directory
-import Control.Exception
+import System.Environment
+import System.Exit
+
+main :: IO ()
+main = do args <- getArgs
+          let (ghcArgs, args') = extractGhcArgs args
+              (_, args'') = extractConfigureArgs args'
+              hooks = defaultUserHooks {
+                  buildHook = add_ghc_options ghcArgs
+                            $ buildHook defaultUserHooks,
+                  runTests = runTestScript }
+          withArgs args'' $ defaultMainWithHooks hooks
 
 withCurrentDirectory :: FilePath -> IO a -> IO a
 withCurrentDirectory path f = do
-	cur <- getCurrentDirectory
-	setCurrentDirectory path
-	finally f (setCurrentDirectory cur)
+    cur <- getCurrentDirectory
+    setCurrentDirectory path
+    finally f (setCurrentDirectory cur)
 
-runTestScript :: Args -> Bool -> PackageDescription -> LocalBuildInfo -> IO ExitCode
+runTestScript :: Args -> Bool -> PackageDescription -> LocalBuildInfo
+              -> IO ExitCode
 runTestScript args flag pd lbi = withCurrentDirectory "test" (system "make")
 
-main :: IO ()
-main = defaultMainWithHooks defaultUserHooks{runTests = runTestScript}
+extractGhcArgs :: [String] -> ([String], [String])
+extractGhcArgs = extractPrefixArgs "--ghc-option="
+
+extractConfigureArgs :: [String] -> ([String], [String])
+extractConfigureArgs = extractPrefixArgs "--configure-option="
+
+extractPrefixArgs :: String -> [String] -> ([String], [String])
+extractPrefixArgs prefix args
+ = let f [] = ([], [])
+       f (x:xs) = case f xs of
+                      (wantedArgs, otherArgs) ->
+                          case removePrefix prefix x of
+                              Just wantedArg ->
+                                  (wantedArg:wantedArgs, otherArgs)
+                              Nothing ->
+                                  (wantedArgs, x:otherArgs)
+   in f args
+
+removePrefix :: String -> String -> Maybe String
+removePrefix "" ys = Just ys
+removePrefix (x:xs) (y:ys)
+ | x == y = removePrefix xs ys
+ | otherwise = Nothing
+
+type Hook a = PackageDescription -> LocalBuildInfo -> Maybe UserHooks -> a
+           -> IO ()
+
+add_ghc_options :: [String] -> Hook a -> Hook a
+add_ghc_options args f pd lbi muhs x
+ = do let lib' = case library pd of
+                     Just lib ->
+                         let bi = libBuildInfo lib
+                             opts = options bi ++ [(GHC, args)]
+                             bi' = bi { options = opts }
+                         in lib { libBuildInfo = bi' }
+                     Nothing -> error "Expected a library"
+          pd' = pd { library = Just lib' }
+      f pd' lbi muhs x
+