Skip to content

Commit

Permalink
Use -package-db instead of package path env.
Browse files Browse the repository at this point in the history
  • Loading branch information
cchalmers committed Jan 19, 2015
1 parent 90367a3 commit 3bf6025
Show file tree
Hide file tree
Showing 2 changed files with 28 additions and 27 deletions.
16 changes: 8 additions & 8 deletions src/Diagrams/Backend/CmdLine.hs
Original file line number Diff line number Diff line change
Expand Up @@ -580,12 +580,12 @@ defaultLoopRender opts = when (opts ^. loop) $ do
++ "Specify source file with '-s' or '--src'")
srcPath' <- canonicalizePath srcPath

sandbox <- findSandbox []
case sandbox of
Nothing -> return ()
sandbox <- findSandbox []
sandboxArgs <- case sandbox of
Nothing -> return []
Just sb -> do
ghcPackagePath sb
putStrLn ("Using sandbox " ++ takeDirectory sb)
return ["-package-db", sb]

let srcFilePath = fromText $ T.pack srcPath'
args' = delete "-l" . delete "--loop" $ args
Expand All @@ -600,7 +600,7 @@ defaultLoopRender opts = when (opts ^. loop) $ do
(existsEvents (== srcFilePath))
-- Call the new program without the looping option
(\ev -> putStrF ("Modified " ++ show (eventTime ev) ++ " ... ")
>> recompile srcPath newProg >>= run newProg args')
>> recompile srcPath newProg sandboxArgs >>= run newProg args')
putStrLn $ "Watching source file " ++ srcPath
putStrLn $ "Compiling target: " ++ newProg
putStrLn $ "Program args: " ++ unwords args'
Expand All @@ -609,9 +609,9 @@ defaultLoopRender opts = when (opts ^. loop) $ do
"darwin" -> 5000000000000
_ -> maxBound

recompile :: FilePath -> FilePath -> IO ExitCode
recompile srcFile outFile = do
let ghcArgs = ["--make", srcFile, "-o", outFile]
recompile :: FilePath -> FilePath -> [String] -> IO ExitCode
recompile srcFile outFile args = do
let ghcArgs = ["--make", srcFile, "-o", outFile] ++ args
putStrF "compiling ... "
(exit, _, stderr) <- readProcessWithExitCode "ghc" ghcArgs ""
when (exit /= ExitSuccess) $ putStrLn ('\n':stderr)
Expand Down
39 changes: 20 additions & 19 deletions src/Diagrams/Util.hs
Original file line number Diff line number Diff line change
Expand Up @@ -22,7 +22,7 @@ module Diagrams.Util

-- * Finding sandboxes
, findSandbox
, ghcPackagePath
, globalPackage

-- * Internal utilities
, foldB
Expand Down Expand Up @@ -175,11 +175,9 @@ isDB path =
findSandbox :: [FilePath] -> IO (Maybe FilePath)
findSandbox paths = runMaybeT $ pathsTest <|> diaSB <|> envDB <|> wdConfig
where
lookEnv = MaybeT . lookupEnv
ghcPkg = lookEnv "GHC_PACKAGE_PATH"
hsenv = lookEnv "HSENV"
pkgDB = lookEnv "PACKAGE_DB_FOR_GHC"
envDB = ghcPkg <|> hsenv <|> pkgDB
-- first path in environment
lookEnv = MaybeT . (fmap . fmap) (head . splitSearchPath) . lookupEnv
envDB = foldMaybeT lookEnv ["GHC_PACKAGE_PATH", "HSENV", "PACKAGE_DB_FOR_GHC"]

-- test if path points directly to db or contains a config file
test x = isDB x <|> configSearch x
Expand All @@ -191,11 +189,22 @@ findSandbox paths = runMaybeT $ pathsTest <|> diaSB <|> envDB <|> wdConfig
-- environment (appending the ghc global package database from @ghc
-- --info@. @GHC_PACKAGE_PATH@ if the variable ghc and other tools use
-- to find the package database. (This is what @cabal exec@ sets)
ghcPackagePath :: FilePath -> IO ()
ghcPackagePath db = do
gdb <- globalPackage
let dbs = intercalate [searchPathSeparator] [db,gdb]
setEnv "GHC_PACKAGE_PATH" dbs
-- ghcPackagePath :: FilePath -> IO ()
-- ghcPackagePath db = do
-- gdb <- globalPackage
-- let dbs = intercalate [searchPathSeparator] [db,gdb]
-- setEnv "GHC_PACKAGE_PATH" dbs
--
-- setEnv is only in base > 4.7, either need to use setenv package or
-- -package-db flag

-- | Find ghc's global package database. Throws an error if it isn't
-- found.
globalPackage :: IO FilePath
globalPackage = do
info <- read <$> readProcess "ghc" ["--info"] ""
return $ fromMaybe (error "Unable to parse ghc --info.")
(lookup "Global Package DB" info)

-- MaybeT utilities

Expand All @@ -217,11 +226,3 @@ foldMaybeT f (a:as) = MaybeT $ do
then return x
else runMaybeT (foldMaybeT f as)

-- | Find ghc's global package database. Throws in error if it isn't
-- found.
globalPackage :: IO FilePath
globalPackage = do
info <- read <$> readProcess "ghc" ["--info"] ""
return $ fromMaybe (error "Unable to parse ghc --info.")
(lookup "Global Package DB" info)

0 comments on commit 3bf6025

Please sign in to comment.