dyre 0.8.5 → 0.8.6

raw patch · 4 files changed

+47/−27 lines, 4 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Config/Dyre.hs +34/−16
• Config/Dyre/Compile.hs +7/−6
• Config/Dyre/Paths.hs +4/−3
• dyre.cabal +2/−2

@@ -96,15 +96,18 @@ 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 @@        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 @@         -- Either the user or timestamps indicate we need to recompile         let needReconf = or [ tempTime < confTime                             , tempTime < thisTime+                            , or . map (tempTime <) $ libTimes                             , forceReconf                             ] @@ -163,14 +169,17 @@         errorData    <- getErrorString params         customExists <- doesFileExist tempBinary -        -- Canonicalize the paths for comparison to avoid symlinks throwing-        -- us off. We do it here instead of earlier because canonicalizePath-        -- drops path components when one of them is nonexistent.-        thisBinary' <- canonicalizePath thisBinary-        tempBinary' <- canonicalizePath tempBinary--        if confExists && customExists && (thisBinary' /= tempBinary')-           then launchSub errorData tempBinary+        if confExists && customExists+           then do+               -- Canonicalize the paths for comparison to avoid symlinks+               -- throwing us off. We do it here instead of earlier because+               -- canonicalizePath throws an exception when the file is+               -- nonexistent.+               thisBinary' <- canonicalizePath thisBinary+               tempBinary' <- canonicalizePath tempBinary+               if thisBinary' /= tempBinary'+                  then launchSub errorData tempBinary+                  else enterMain errorData            else enterMain errorData   where launchSub errorData tempBinary = do             statusOut params $ "Launching custom binary " ++ tempBinary ++ "\n"@@ -185,9 +194,18 @@             let mainConfig = case errorData of                                   Nothing -> cfg                                   Just ed -> showError params cfg ed-            -- Remove the error file if it exists-            errorFile <- getErrorPath params-            errorExists <- doesFileExist errorFile-            when errorExists $ removeFile errorFile             -- 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 []

@@ -19,7 +19,7 @@ -- | 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 @@ --   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 @@        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]

@@ -12,7 +12,7 @@  -- | 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@@ -26,9 +26,10 @@                       (False, Nothing) -> getUserConfigDir pName                       (False, Just cd) -> cd     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.

@@ -1,5 +1,5 @@ name:          dyre-version:       0.8.5+version:       0.8.6 category:      Development, Configuration synopsis:      Dynamic reconfiguration in Haskell @@ -16,7 +16,7 @@ stability:     beta author:        Will Donnelly maintainer:    Will Donnelly <will.donnelly@gmail.com>-copyright:     (c) 2010 Will Donnelly+copyright:     (c) 2011 Will Donnelly license:       BSD3 license-file:  LICENSE