Setup.hs

   1
   2 module Main (main) where
   3
   4 import Data.List
   5 import Distribution.Simple
   6 import Distribution.PackageDescription
   7 import Distribution.Setup
   8 import Distribution.Simple.LocalBuildInfo
   9 import System.Environment
  10
  11 main :: IO ()
  12 main = do args <- getArgs
  13           let (ghcArgs, args') = extractGhcArgs args
  14               (_, args'') = extractConfigureArgs args'
  15               hooks = defaultUserHooks {
  16                   buildHook = add_ghc_options ghcArgs
  17                             $ buildHook defaultUserHooks }
  18           withArgs args'' $ defaultMainWithHooks hooks
  19
  20 extractGhcArgs :: [String] -> ([String], [String])
  21 extractGhcArgs = extractPrefixArgs "--ghc-option="
  22
  23 extractConfigureArgs :: [String] -> ([String], [String])
  24 extractConfigureArgs = extractPrefixArgs "--configure-option="
  25
  26 extractPrefixArgs :: String -> [String] -> ([String], [String])
  27 extractPrefixArgs the_prefix args
  28  = let f [] = ([], [])
  29        f (x:xs) = case f xs of
  30                       (wantedArgs, otherArgs) ->
  31                           case removePrefix the_prefix x of
  32                               Just wantedArg ->
  33                                   (wantedArg:wantedArgs, otherArgs)
  34                               Nothing ->
  35                                   (wantedArgs, x:otherArgs)
  36    in f args
  37
  38 removePrefix :: String -> String -> Maybe String
  39 removePrefix "" ys = Just ys
  40 removePrefix _  "" = Nothing
  41 removePrefix (x:xs) (y:ys)
  42  | x == y = removePrefix xs ys
  43  | otherwise = Nothing
  44
  45 type Hook a = PackageDescription -> LocalBuildInfo -> UserHooks -> a -> IO ()
  46
  47 add_ghc_options :: [String] -> Hook a -> Hook a
  48 add_ghc_options args f pd lbi uhs x
  49  = do let lib' = case library pd of
  50                      Just lib ->
  51                          let bi = libBuildInfo lib
  52                              opts = options bi ++ [(GHC, args)]
  53                              bi' = bi { options = opts }
  54                          in lib { libBuildInfo = bi' }
  55                      Nothing -> error "Expected a library"
  56           pd' = pd { library = Just lib' }
  57       f pd' lbi uhs x
  58