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 Lib data Flag = Changed | Created | Help deriving (Show,Read,Eq) clOption :: [OptDescr Flag] clOption = [ Option "" ["if"] (ReqArg read "MODE") "Redo mode, valid modes are: Changed, Created" , Option "h" ["help"] (NoArg Help) "Print usage info" ] variableInfo :: String variableInfo = unlines $ "Environment variables:" : map ('\t':) [ "GDO_DEFAULTS : List of paths to directories containing default do files" ] usageHeader :: String usageHeader = unlines [ "gdo" ] printUsage :: IO () printUsage = do putStrErr $ usageInfo usageHeader clOption putStrLn "" putStrLn variableInfo getCliOpts :: (MonadIO m) => ExceptT ExitCode m ([Flag],[FilePath]) getCliOpts = do args <- liftIO getArgs case getOpt RequireOrder clOption args of (_,_,_:_) -> do liftIO printUsage throwE (ExitFailure 1) (opts,deps,_) -> return (opts,deps) optsToMode :: [Flag] -> Maybe Flag optsToMode flags = getFirst . mconcat . map (First . ($flags)) $ [ find (==Help) , listToMaybe . reverse ] withTarget :: (MonadIO m) => FilePath -> (FilePath -> m a) -> m a withTarget target fun = do dir <- liftIO getCurrentDirectory let (targetDir,file) = splitFileName target liftIO $ setCurrentDirectory targetDir result <- fun file liftIO $ setCurrentDirectory dir return result main :: IO () main = do defaultDirs <- getDefaultDirs either exitWith (const exitSuccess) =<< runExceptT (do (mMode,deps) <- getCliOpts case optsToMode mMode of Just Changed -> do buildTarget <- getBuildTarget mapM_ (redoIfChanged defaultDirs buildTarget) deps Just Created -> do buildTarget <- getBuildTarget mapM_ (redoIfCreated defaultDirs buildTarget) deps Just Help -> liftIO printUsage Nothing -> mapM_ (`withTarget` redo defaultDirs) deps return () ) redo :: (MonadIO m) => [FilePath] -> FilePath -> ExceptT ExitCode m () redo mDefaultsDir target = do targetDoesExist <- liftIO $ doesFileExist target isUpToDate <- upToDate mDefaultsDir target unless (isUpToDate && targetDoesExist) $ do void . liftIO . tryJust (guard . isDoesNotExistError) $ purgeRecordedDependencies target maybe (do targetExists <- liftIO $ doesFileExist target unless targetExists $ do (liftIO . putStrLnErr) ("Neither target nor do file found for "++show target) throwE (ExitFailure 1)) (\recipe -> do liftIO $ putStrLnErr $ "redo "++show target 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) =<< getRecipeFile mDefaultsDir target redoIfCreated :: (MonadIO m) => [FilePath] -- ^ directory path of defaults -> FilePath -- ^ build target -> FilePath -- ^ path of the dependency -> ExceptT ExitCode m () redoIfCreated mDefaultsDir buildTarget dep = do depExists <- liftIO $ doesFileExist dep if depExists then redoIfChanged mDefaultsDir buildTarget dep else liftIO $ recordMissingDependency buildTarget dep redoIfChanged :: MonadIO m => [FilePath] -- ^ directory of defaults -> FilePath -- ^ build target -> FilePath -- ^ path of the dependency -> ExceptT ExitCode m () redoIfChanged mDefaultsDir buildTarget dep = do (`withTarget` redo mDefaultsDir) dep liftIO $ recordDependency buildTarget dep getBuildTarget :: (MonadIO m) => ExceptT ExitCode m FilePath getBuildTarget = do mTarget <- liftIO $ lookupEnv "REDO_TARGET" case mTarget of Nothing -> do putStrLnErr "Could not detect build target" throwE $ ExitFailure 1 Just target -> return target