Permalink
Browse files

Added a 'lib' dir to go with the main config file.

  • Loading branch information...
willdonnelly committed Jan 5, 2011
1 parent 3907538 commit ae5b8bbb9ffed797d41f3f6f33c8ff77bf82cb1b
Showing with 33 additions and 13 deletions.
  1. +23 −4 Config/Dyre.hs
  2. +7 −6 Config/Dyre/Compile.hs
  3. +3 −3 Config/Dyre/Paths.hs
View
@@ -96,15 +96,18 @@ when run.
module Config.Dyre ( wrapMain, Params(..), defaultParams ) where
import System.IO ( hPutStrLn, stderr )
-import System.Directory ( doesFileExist, removeFile, canonicalizePath )
+import System.Directory ( doesFileExist, removeFile, canonicalizePath
+ , getDirectoryContents, doesDirectoryExist )
+import System.FilePath ( (</>) )
import System.Environment ( getArgs )
-import Control.Monad ( when )
+import Control.Monad ( when, filterM )
import Config.Dyre.Params ( Params(..) )
import Config.Dyre.Compile ( customCompile, getErrorPath, getErrorString )
import Config.Dyre.Compat ( customExec )
-import Config.Dyre.Options ( getForceReconf, getDenyReconf, getDebug, withDyreOptions )
+import Config.Dyre.Options ( getForceReconf, getDenyReconf, getDebug
+ , withDyreOptions )
import Config.Dyre.Paths ( getPaths, maybeModTime )
-- | A set of reasonable defaults for configuring Dyre. The fields that
@@ -135,7 +138,9 @@ wrapMain params@Params{projectName = pName} cfg = withDyreOptions params $
then realMain params cfg
else do
-- Get the important paths
- (thisBinary, tempBinary, configFile, cacheDir) <- getPaths params
+ (thisBinary,tempBinary,configFile,cacheDir,libsDir) <- getPaths params
+ libFiles <- recFiles libsDir
+ libTimes <- mapM maybeModTime libFiles
-- Check their modification times
thisTime <- maybeModTime thisBinary
@@ -148,6 +153,7 @@ wrapMain params@Params{projectName = pName} cfg = withDyreOptions params $
-- Either the user or timestamps indicate we need to recompile
let needReconf = or [ tempTime < confTime
, tempTime < thisTime
+ , or . map (tempTime <) $ libTimes
, forceReconf
]
@@ -190,3 +196,16 @@ wrapMain params@Params{projectName = pName} cfg = withDyreOptions params $
Just ed -> showError params cfg ed
-- Enter the main program
realMain params mainConfig
+
+recFiles :: FilePath -> IO [FilePath]
+recFiles d = do
+ exists <- doesDirectoryExist d
+ if exists
+ then do
+ nodes <- getDirectoryContents d
+ let nodes' = map (d </>) . filter (`notElem` [".", ".."]) $ nodes
+ files <- filterM doesFileExist nodes'
+ dirs <- filterM doesDirectoryExist nodes'
+ subfiles <- concat `fmap` mapM recFiles dirs
+ return $ files ++ subfiles
+ else return []
View
@@ -19,7 +19,7 @@ import Config.Dyre.Params ( Params(..) )
-- | Return the path to the error file.
getErrorPath :: Params cfgType -> IO FilePath
getErrorPath params = do
- (_,_,_, cacheDir) <- getPaths params
+ (_,_,_, cacheDir, _) <- getPaths params
return $ cacheDir </> "errors.log"
-- | If the error file exists and actually has some contents, return
@@ -39,14 +39,14 @@ getErrorString params = do
-- containing any compiler output.
customCompile :: Params cfgType -> IO ()
customCompile params@Params{statusOut = output} = do
- (thisBinary, tempBinary, configFile, cacheDir) <- getPaths params
+ (thisBinary, tempBinary, configFile, cacheDir, libsDir) <- getPaths params
output $ "Configuration '" ++ configFile ++ "' changed. Recompiling."
createDirectoryIfMissing True cacheDir
-- Compile occurs in here
errFile <- getErrorPath params
result <- bracket (openFile errFile WriteMode) hClose $ \errHandle -> do
- ghcOpts <- makeFlags params configFile tempBinary cacheDir
+ ghcOpts <- makeFlags params configFile tempBinary cacheDir libsDir
ghcProc <- runProcess ghc ghcOpts (Just cacheDir) Nothing
Nothing Nothing (Just errHandle)
waitForProcess ghcProc
@@ -57,11 +57,12 @@ customCompile params@Params{statusOut = output} = do
else output "Program reconfiguration successful."
-- | Assemble the arguments to GHC so everything compiles right.
-makeFlags :: Params cfgType -> FilePath -> FilePath -> FilePath -> IO [String]
+makeFlags :: Params cfgType -> FilePath -> FilePath -> FilePath
+ -> FilePath -> IO [String]
makeFlags Params{ghcOpts = flags, hidePackages = hides, forceRecomp = force}
- cfgFile tmpFile cacheDir = do
+ cfgFile tmpFile cacheDir libsDir = do
currentDir <- getCurrentDirectory
- return . concat $ [ ["-v0", "-i" ++ currentDir]
+ return . concat $ [ ["-v0", "-i" ++ currentDir, "-i" ++ libsDir]
, ["-outputdir", cacheDir]
, prefix "-hide-package" hides, flags
, ["--make", cfgFile, "-o", tmpFile]
View
@@ -12,7 +12,7 @@ import Config.Dyre.Options
-- | Return the paths to, respectively, the current binary, the custom
-- binary, the config file, and the cache directory.
-getPaths :: Params c -> IO (FilePath, FilePath, FilePath, FilePath)
+getPaths :: Params c -> IO (FilePath, FilePath, FilePath, FilePath, FilePath)
getPaths params@Params{projectName = pName} = do
thisBinary <- getExecutablePath
debugMode <- getDebug
@@ -28,8 +28,8 @@ getPaths params@Params{projectName = pName} = do
let tempBinary = cacheDir </> pName ++ "-" ++ os ++ "-" ++ arch
<.> takeExtension thisBinary
let configFile = configDir </> pName ++ ".hs"
-
- return (thisBinary, tempBinary, configFile, cacheDir)
+ let libsDir = configDir </> "lib"
+ return (thisBinary, tempBinary, configFile, cacheDir, libsDir)
-- | Check if a file exists. If it exists, return Just the modification
-- time. If it doesn't exist, return Nothing.

0 comments on commit ae5b8bb

Please sign in to comment.