gdo 0.1.2 → 0.1.3
raw patch · 3 files changed
+116/−68 lines, 3 filesdep ~base
Dependency ranges changed: base
Files
Lib.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE RecordWildCards #-}+ module Lib ( putStrErr , putStrLnErr@@ -16,23 +18,33 @@ ) where -import Control.Exception (finally,tryJust)-import Control.Monad (when,filterM,guard)+import Control.Exception (finally)+import Control.Monad (when,filterM,foldM)+import Control.Monad.Fail (MonadFail(fail)) import Control.Monad.IO.Class (liftIO, MonadIO)+import Control.Monad.Trans.Maybe (runMaybeT) import Crypto.Hash (hash,Digest,MD5) import qualified Data.ByteString as BS import qualified Data.Map as Map (toList,fromList,insert)-import Data.Maybe (listToMaybe)-import System.Directory (getCurrentDirectory, makeAbsolute, doesFileExist, renameFile, removeFile, createDirectoryIfMissing, getDirectoryContents, removeDirectoryRecursive, withCurrentDirectory)+import Data.Maybe (listToMaybe, isJust)+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))+import System.Exit (ExitCode(ExitSuccess),exitFailure) import System.FilePath ((</>), takeBaseName, dropFileName, replaceBaseName, addExtension,splitSearchPath) import System.IO (hPutStrLn,stderr,hPutStr,withFile,IOMode(ReadMode,WriteMode,AppendMode),hFileSize)-import System.IO.Error (isDoesNotExistError) import qualified System.Process as Proc (env, waitForProcess, createProcess, proc) import DepInfo +type Hash = String++readFile :: (MonadFail m, MonadIO m) => FilePath -> m String+readFile p = ifM (liftIO $ doesFileExist p)+ (liftIO $ Prelude.readFile p)+ (fail $ "File "++p++"does not exist")+ -- | Print a string to standard error output with a newline character -- in the end. putStrLnErr :: (MonadIO m) => String -> m ()@@ -80,7 +92,9 @@ (_,_,_,ph) <- liftIO $ Proc.createProcess process code <- liftIO $ Proc.waitForProcess ph if code /= ExitSuccess- then putStrLnErr $ "*** redo failed for target "++show target+ then do+ putStrLnErr $ "*** redo failed for target "++show target+ exitFailure else do filesize <- getFileSize tempFilePath when (filesize /= 0) $ renameFile tempFilePath target return code@@ -125,87 +139,106 @@ getDefaultDirs = maybe [] splitSearchPath <$> liftIO (lookupEnv "GDO_DEFAULTS") -hashFile :: (MonadIO m) => FilePath -> m (Digest MD5)+hashFile :: (MonadIO m, MonadFail m) => FilePath -> m Hash hashFile target = do- bs <- liftIO $ BS.readFile target- return $ hash bs+ targetExists <- liftIO (doesFileExist target)+ if targetExists+ then (show :: Digest MD5 -> String) . hash <$> liftIO (BS.readFile target)+ else fail $ "Files "++target++"does not exist!" upToDate :: (MonadIO m) => [FilePath] -> FilePath -> m Bool upToDate mDefaultsDir buildTarget = do- metaDepDir <- getMetaDir buildTarget- liftIO $- maybe- -- When no recipe exists, we assume the target is up to date.- (return True)- ( const $ do- r <- tryJust- (guard . isDoesNotExistError)- ( do md5s <- Prelude.filter (not . (`elem` metaIgnoreFiles)) <$>- getDirectoryContents metaDepDir- depsNotChanged <- and <$> mapM upToDate' md5s- noNewFiles <- not <$> newFilesCreated- return $ depsNotChanged && noNewFiles- )- return $ fromRight (const False) r- ) =<< getRecipeFile mDefaultsDir buildTarget+ recipeExists <- isJust <$> liftIO (getRecipeFile mDefaultsDir buildTarget)+ if recipeExists+ then do+ mDepInfos <- runMaybeT (getHashesAndDepsForTarget buildTarget)+ case mDepInfos of+ Nothing -> return False+ Just depInfos -> do+ directDepsUpToDate <- if recipeExists+ then do+ return $ and . map depInfoUpToDate $ depInfos+ else return True+ depsUpToDate <-+ mapM (upToDate mDefaultsDir . depInfoFilePath) depInfos+ return (and $ directDepsUpToDate:depsUpToDate)+ else return True++ifM :: (Monad m) => m Bool -> m a -> m a -> m a+ifM condM consequence alternative = do+ cond <- condM+ if cond+ then consequence+ else alternative++getOldHashes :: (MonadIO m, MonadFail m) => String -> m [(String, FilePath)]+getOldHashes target = do+ metaDir <- liftIO $ getMetaDir target+ ifM (liftIO $ doesDirectoryExist metaDir)+ (liftIO $ withCurrentDirectory metaDir+ ( foldM putHashInMap mempty =<<+ (filter (not . (`elem` metaIgnoreFiles)) <$>+ (getDirectoryContents metaDir)))+ )+ ( fail "Metadata directory does not exist" ) where- fromRight :: (a -> b) -> Either a b -> b- fromRight f = either f id- upToDate' :: String -> IO Bool- upToDate' oldHash = do- metaDepDir <- getMetaDir buildTarget- r <- tryJust (guard . isDoesNotExistError) $ do- dep <- readFile $ metaDepDir </> oldHash- newHash <- show <$> hashFile dep- depUpToDate <- upToDate mDefaultsDir dep- let allUpToDate = oldHash == newHash && depUpToDate- return allUpToDate- case r of- Right b -> return b- Left _ -> return False- newFilesCreated :: IO Bool- newFilesCreated = do- missingDepsFile <- getMissingDepsFile buildTarget- r <- tryJust (guard . isDoesNotExistError) $+ putHashInMap hashmap filepath =+ (:) <$> ((,) <$> readFile filepath <*> pure filepath) <*> pure hashmap++getHashesAndDepsForTarget :: (MonadIO m, MonadFail m) =>+ String -> m [DepInfo]+getHashesAndDepsForTarget target = do+ existingDeps <- mapM (liftIO . getDepInfo) =<< getOldHashes target+ nonExistingDeps <- futureDependencies+ return (existingDeps ++ nonExistingDeps)+ where+ getDepInfo (depInfoFilePath, oldHash) = do+ let+ depInfoSavedMD5 = Just oldHash+ depInfoCurrentMD5 <- runMaybeT $ hashFile depInfoFilePath+ return DepInfo {..}+ futureDependencies = do+ missingDepsFile <- getMissingDepsFile target+ r <- runMaybeT $ Prelude.filter (\e -> (e `notElem` metaIgnoreFiles) || Prelude.null e) . lines <$> readFile missingDepsFile case r of- Left _ -> return False- Right watchlist -> or <$> mapM- doesFileExist watchlist--getHashesAndDepsForTarget :: FilePath -> IO [DepInfo]-getHashesAndDepsForTarget target = do- metaDir <- getMetaDir target- (filenames, oldMd5s) <- withCurrentDirectory metaDir $ do- hashes <- filter (not . (`elem` metaIgnoreFiles)) <$>- getDirectoryContents metaDir- (,) <$> mapM readFile hashes <*> pure hashes- md5s <- mapM hashFromPath filenames- return (zipWith3 DepInfo- filenames- (map Just oldMd5s)- (map (Just . show) md5s))- where- hashFromPath :: FilePath -> IO (Digest MD5)- hashFromPath f = hash <$> BS.readFile f+ Nothing -> return []+ Just watchlist ->+ mapM (\ depInfoFilePath -> do+ let+ depInfoSavedMD5 = Nothing+ depInfoCurrentMD5 <- runMaybeT (hashFile depInfoFilePath)+ return DepInfo {..}+ )+ watchlist +-- | `recordDependency target dep` records the existing file `dep` as+-- a dependency of `target`.+--+-- `target` can be absolute paths or paths relative to the current+-- working directory. recordDependency :: FilePath -- ^ target name -> FilePath -- ^ dependency name -> IO () recordDependency target dep = do- newHash <- show <$> hashFile dep+ newHash <- hashFile dep metaDepDir <- getMetaDir target let md5file = metaDepDir </> newHash liftIO $ createDirectoryIfMissing True metaDepDir liftIO $ withFile md5file WriteMode (`hPutStr` dep) +-- | `recordMissingDependency target dep` records `dep` as a+-- dependency of `target` if it should be created.+--+-- `target` can be absolute paths or paths relative to the current+-- working directory. recordMissingDependency :: FilePath -> FilePath -> IO () recordMissingDependency target dep = do metaDepsDir <- getMetaDir target@@ -216,6 +249,8 @@ AppendMode (`hPutStrLn` dep) +-- | Remove all recorded dependencies for a target. This makes the+-- target stale by definition. purgeRecordedDependencies :: FilePath -> IO () purgeRecordedDependencies target = removeDirectoryRecursive =<< getMetaDir target
gdo.cabal view
@@ -2,7 +2,7 @@ -- see http://haskell.org/cabal/users-guide/ name: gdo-version: 0.1.2+version: 0.1.3 synopsis: recursive atomic build system description: *gdo* is a build system similar to **GNU Make**. It builds files from@@ -40,7 +40,7 @@ main-is: Main.hs other-modules: Lib , DepInfo- build-depends: base >=4.8 && <4.10,+ build-depends: base >=4.8 && < 5, process >= 1.1, filepath >= 1.0, directory >= 1.2,
gdo.do view
@@ -1,14 +1,27 @@ #!/bin/sh # build the gdo executable+set -e HC="ghc -v0" -gdo --if Changed Main.hs Lib.hs DepInfo.hs+gdo --if Changed build_util.sh Main.hs gdo --if Created environment +source ./build_util.sh+ if [ -e environment ]; then source ./environment fi -${HC} Main.hs -o ${3}+TEMPMAKEFILE=$(mktemp)++trap "rm ${TEMPMAKEFILE} -rf" EXIT SIGTERM SIGINT++${HC} Main.hs -M -dep-suffix '' -dep-makefile ${TEMPMAKEFILE}+OBJECTS=$(cat ${TEMPMAKEFILE} | filter_comments | extract_exec_deps)+++gdo --if Changed ${OBJECTS}++${HC} ${OBJECTS} ${GHC_PACKAGES} -o ${3}