gdo 0.1.4 → 0.1.5

raw patch · 3 files changed

+54/−23 lines, 3 files

Files

• Lib.hs +15/−3
• Main.hs +38/−19
• gdo.cabal +1/−1

@@ -15,6 +15,8 @@        , recordMissingDependency        , purgeRecordedDependencies        , getHashesAndDepsForTarget+       , getInvocationDir+       , setInvocationDir        )        where @@ -30,8 +32,8 @@ import qualified Prelude import           Prelude hiding (fail,readFile) import           System.Directory (getCurrentDirectory, makeAbsolute, doesFileExist, renameFile, removeFile, createDirectoryIfMissing, getDirectoryContents, removeDirectoryRecursive, withCurrentDirectory, doesDirectoryExist)-import           System.Environment (getEnvironment,lookupEnv)-import           System.Exit (ExitCode(ExitSuccess),exitFailure)+import           System.Environment (getEnvironment,lookupEnv,setEnv)+import           System.Exit (ExitCode(ExitSuccess)) import           System.FilePath ((</>), takeBaseName, dropFileName, replaceBaseName, addExtension,splitSearchPath) import           System.IO (hPutStrLn,stderr,hPutStr,withFile,IOMode(ReadMode,WriteMode,AppendMode),hFileSize) import qualified System.Process as Proc (env, waitForProcess, createProcess, proc)@@ -94,7 +96,6 @@         if code /= ExitSuccess           then do             putStrLnErr $ "*** redo failed for target "++show target-            exitFailure           else do filesize <- getFileSize tempFilePath                   when (filesize /= 0) $ renameFile tempFilePath target         return code@@ -138,6 +139,17 @@ getDefaultDirs :: (MonadIO m) => m [FilePath] getDefaultDirs =   maybe [] splitSearchPath <$> liftIO (lookupEnv "GDO_DEFAULTS")++gdoInvocationDir :: String+gdoInvocationDir = "GDO_INVOCATION_DIR"++getInvocationDir :: (MonadIO m) => m (Maybe FilePath)+getInvocationDir =+  liftIO $ lookupEnv gdoInvocationDir++setInvocationDir :: (MonadIO m) => m ()+setInvocationDir =+  liftIO (setEnv gdoInvocationDir =<< getCurrentDirectory)  hashFile :: (MonadIO m, MonadFail m) => FilePath -> m Hash hashFile target = do

@@ -1,16 +1,18 @@-import           Control.Exception-import           Control.Monad-import           Control.Monad.IO.Class-import           Control.Monad.Trans.Except-import           Data.List-import           Data.Maybe-import           Data.Monoid-import           System.Console.GetOpt-import           System.Directory-import           System.Environment-import           System.Exit-import           System.FilePath-import           System.IO.Error+import Control.Exception+import Control.Monad+import Control.Monad.IO.Class+import Control.Monad.Trans.Class+import Control.Monad.Trans.Except+import Control.Monad.Trans.Reader+import Data.List+import Data.Maybe+import Data.Monoid+import System.Console.GetOpt+import System.Directory+import System.Environment+import System.Exit+import System.FilePath+import System.IO.Error  import Lib @@ -70,8 +72,13 @@           main :: IO () main = do+  invocationDir <-+    fromMaybeM+    (setInvocationDir >> getCurrentDirectory)+    getInvocationDir   defaultDirs <- getDefaultDirs-  either exitWith (const exitSuccess) =<< runExceptT+  either exitWith (const exitSuccess) =<<+    (flip runReaderT invocationDir . runExceptT)     (do (mMode,deps) <- getCliOpts         case optsToMode mMode of          Just Changed -> do@@ -85,9 +92,14 @@         return ()     ) +type Redo m = ExceptT ExitCode (ReaderT FilePath m)+ redo :: (MonadIO m) =>-        [FilePath] -> FilePath -> ExceptT ExitCode m ()+        [FilePath] -> FilePath -> Redo m () redo mDefaultsDir target = do+  invocationDir <- lift $ ask+  targetRelativePath <- makeRelative invocationDir <$>+    liftIO (makeAbsolute target)   targetDoesExist <- liftIO $ doesFileExist target   isUpToDate <- upToDate mDefaultsDir target   unless (isUpToDate && targetDoesExist) $ do@@ -99,21 +111,28 @@                   ("Neither target nor do file found for "++show target)                 throwE (ExitFailure 1))           (\recipe ->-            do liftIO $ putStrLnErr $ "redo "++show target+            do liftIO $ putStrLnErr $ "redo "++show targetRelativePath                redoIfCreated mDefaultsDir target (target++".do")                redoIfChanged mDefaultsDir target recipe                buildResult <- liftIO $ executeRecipe target recipe                when (buildResult /= ExitSuccess)                  (do liftIO $ purgeRecordedDependencies target                      throwE buildResult)-               liftIO $ putStrLnErr $ "redone "++show target)+               liftIO $ putStrLnErr $ "redone "++show targetRelativePath)       =<< getRecipeFile mDefaultsDir target +fromMaybeM :: (Monad m) => m a -> m (Maybe a) -> m a+fromMaybeM fallback action = do+  mValue <- action+  case mValue of+    Just value -> return value+    Nothing -> fallback+ redoIfCreated :: (MonadIO m) =>                  [FilePath]     -- ^ directory path of defaults               -> FilePath       -- ^ build target               -> FilePath       -- ^ path of the dependency-              -> ExceptT ExitCode m ()+              -> Redo m () redoIfCreated mDefaultsDir buildTarget dep = do   depExists <- liftIO $ doesFileExist dep   if depExists@@ -124,7 +143,7 @@                  [FilePath]     -- ^ directory of defaults               -> FilePath       -- ^ build target               -> FilePath       -- ^ path of the dependency-              -> ExceptT ExitCode m ()+              -> Redo m () redoIfChanged mDefaultsDir buildTarget dep = do   (`withTarget` redo mDefaultsDir) dep   liftIO $ recordDependency buildTarget dep

@@ -2,7 +2,7 @@ -- see http://haskell.org/cabal/users-guide/  name:                gdo-version:             0.1.4+version:             0.1.5 synopsis:            recursive atomic build system description:   *gdo* is a build system similar to **GNU Make**. It builds files from