module Lib ( putStrErr , putStrLnErr -- * directory names , getMetaDir , getMissingDepsFile , metaIgnoreFiles , getDefaultDirs -- * Actions , executeRecipe , getRecipeFile , upToDate , recordDependency ) where import Control.Exception (finally,tryJust) import Control.Monad (when,filterM,guard) import Control.Monad.IO.Class (liftIO, MonadIO) 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) import System.Environment (getEnvironment,lookupEnv) import System.Exit (ExitCode(ExitSuccess)) import System.FilePath ((), takeBaseName, dropFileName, replaceBaseName, addExtension,splitSearchPath) import System.IO (hPutStrLn,stderr,hPutStr,withFile,IOMode(ReadMode,WriteMode),hFileSize) import System.IO.Error (isDoesNotExistError) import qualified System.Process as Proc putStrLnErr :: (MonadIO m) => String -> m () putStrLnErr msg = liftIO $ hPutStrLn stderr msg putStrErr :: (MonadIO m) => String -> m () putStrErr = liftIO . hPutStr stderr getMetaDir :: (MonadIO m) => String -- ^ target name -> m FilePath getMetaDir target = do current <- liftIO $ makeAbsolute =<< getCurrentDirectory return $ current metadir target metadir :: FilePath metadir = ".gdo" getMissingDepsFile :: (MonadIO m) => String -> m FilePath getMissingDepsFile target = ( gdoMissingFile) <$> getMetaDir target gdoMissingFile :: FilePath gdoMissingFile = "gdo---watch-dir" metaIgnoreFiles :: [FilePath] metaIgnoreFiles = [".","..",gdoMissingFile] -- | Execute a build recipe for a given target. executeRecipe :: FilePath -- ^ build target -> FilePath -- ^ recipe file -> IO ExitCode executeRecipe target recipe = do createFile tempFileName finally (do process <- modEnv $ Proc.proc recipe [targetDir,takeBaseName target, tempFileName] (_,_,_,ph) <- liftIO $ Proc.createProcess process code <- liftIO $ Proc.waitForProcess ph if code /= ExitSuccess then putStrLnErr $ "*** redo failed for target "++show target else do filesize <- getFileSize tempFileName when (filesize /= 0) $ renameFile tempFileName target return code ) (do exists <- doesFileExist tempFileName when exists $ removeFile tempFileName ) where modEnv process = do oldEnv <- liftIO getEnvironment return process {Proc.env = Just (Map.toList . Map.insert "REDO_TARGET" target . Map.fromList $ oldEnv) } targetDir = dropFileName target tempFileName = target ++ "---gdo" getFileSize :: FilePath -> IO Integer getFileSize path = withFile path ReadMode hFileSize createFile :: FilePath -> IO () createFile path = writeFile path "" -- | Find out which recipe file to use to build a target. getRecipeFile :: (MonadIO m) => [FilePath] -- ^ List of extra search paths with -- potential default do files -> FilePath -- ^ the target name -> m (Maybe FilePath) getRecipeFile defaultDirs target = liftIO $ mapM makeAbsolute =<< listToMaybe <$> filterM doesFileExist ( [ addExtension target ".do" , replaceBaseName target "default" ++ ".do" ] ++ defaultsDirFile ) where defaultDoFile = replaceBaseName target "default" ++ ".do" defaultsDirFile = fmap ( defaultDoFile) defaultDirs -- Get the default dirs from the environment. getDefaultDirs :: (MonadIO m) => m [FilePath] getDefaultDirs = maybe [] splitSearchPath <$> liftIO (lookupEnv "GDO_DEFAULTS") upToDate :: (MonadIO m) => [FilePath] -> FilePath -> m Bool upToDate mDefaultsDir buildTarget = do metaDepDir <- getMetaDir buildTarget liftIO $ not . Prelude.null <$> getRecipeFile mDefaultsDir buildTarget >>= \canBuild -> if canBuild then 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 $ either (const False) id r else return True where 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) $ Prelude.filter (\e -> (e `notElem` metaIgnoreFiles) || Prelude.null e) . lines <$> readFile missingDepsFile case r of Left _ -> return False Right watchlist -> or <$> mapM doesFileExist watchlist recordDependency :: FilePath -- ^ target name -> FilePath -- ^ dependency name -> IO () recordDependency target dep = do newHash <- show <$> hashFile dep metaDepDir <- getMetaDir target let md5file = metaDepDir newHash liftIO $ createDirectoryIfMissing True metaDepDir liftIO $ withFile md5file WriteMode (`hPutStr` dep) hashFile :: (MonadIO m) => FilePath -> m (Digest MD5) hashFile target = do bs <- liftIO $ BS.readFile target return $ hash bs