{- Setup.hs: based on code from ghc-paths of Simon Marlow Fixed to not use the .buildinfo, and use -Dfoo flags for both libraries and executables -} import Distribution.Simple import Distribution.Simple.Setup import Distribution.PackageDescription import Distribution.Simple.LocalBuildInfo import Distribution.InstalledPackageInfo import Distribution.Simple.Program import Distribution.Simple.PackageIndex as Pkg import System.Exit import System.IO import Data.IORef import Data.Char import Data.Maybe main = defaultMainWithHooks simpleUserHooks { confHook = myCustomConfHook } where myCustomConfHook :: (GenericPackageDescription, HookedBuildInfo) -> ConfigFlags -> IO LocalBuildInfo myCustomConfHook egpdpdhbi flags = do -- get the default LBI lbi <- confHook simpleUserHooks egpdpdhbi flags let programs = withPrograms lbi libdir_ <- rawSystemProgramStdoutConf (fromFlag (configVerbosity flags)) ghcProgram programs ["--print-libdir"] let libdir = reverse $ dropWhile isSpace $ reverse libdir_ ghc_pkg = case lookupProgram ghcPkgProgram programs of Just p -> programPath p Nothing -> error "ghc-pkg was not found" ghc = case lookupProgram ghcProgram programs of Just p -> programPath p Nothing -> error "ghc was not found" -- figure out docdir from base's haddock-html field base_pkg = case searchByName (installedPkgs lbi) "base" of None -> error "no base package" Unambiguous (x:_) -> x _ -> error "base ambiguous" base_html = case haddockHTMLs base_pkg of [] -> "" (x:_) -> x docdir = fromMaybe base_html $ fmap reverse (stripPrefix (reverse "/libraries/base") (reverse base_html)) let programs' = userSpecifyArgs "ghc" ["-DGHC_PATHS_GHC_PKG=" ++ show ghc_pkg, "-DGHC_PATHS_GHC=" ++ show ghc, "-DGHC_PATHS_LIBDIR=" ++ show libdir, "-DGHC_PATHS_DOCDIR=" ++ show docdir ] programs -- returning our modified LBI that includes the -D definitions return lbi { withPrograms = programs' } die :: String -> IO a die msg = do hFlush stdout hPutStr stderr msg exitWith (ExitFailure 1) stripPrefix :: Eq a => [a] -> [a] -> Maybe [a] stripPrefix [] ys = Just ys stripPrefix (x:xs) (y:ys) | x == y = stripPrefix xs ys stripPrefix _ _ = Nothing