module System.Nemesis.DSL where import Control.Arrow ((>>>)) import Control.Lens import Control.Monad (when) import Data.List (sort, nub) import System.Directory (doesFileExist, doesDirectoryExist, removeFile, removeDirectoryRecursive) import System.Exit (ExitCode( ExitSuccess, ExitFailure), exitWith) import System.FilePath.Glob (globDir, compile) import System.Process (system) import Text.Printf (printf) import Prelude hiding ((-)) import System.Nemesis.Driver import System.Nemesis.Type import System.Nemesis.Utils desc :: String -> Unit desc = (currentDesc .=) . Just task :: String -> IO () -> Unit task s aAction = if ':' `elem` s then let h = s & takeWhile (/= ':') t = s & dropWhile (/= ':') & tail in task' (strip h ) (words t) else task' s [] where task' _name _deps = insertTask - emptyTask & name .~ _name & deps .~ _deps & action .~ ShowIO aAction strip = dropWhile (== ' ') >>> reverse >>> dropWhile (== ' ') >>> reverse namespace :: String -> Unit -> Unit namespace aName aUnit = do push aName aUnit pop where push :: String -> Unit push = (currentNamespace %=) . (:) pop :: Unit pop = (currentNamespace %= tail) sh :: String -> IO () sh s = do status <- system s case status of ExitSuccess -> return () ExitFailure code -> do putStrLn - printf "%s failed with status code: %s" s (show code) exitWith status clean :: [String] -> Unit clean xs = do desc "Remove any temporary products." task "clean" - do paths <- globDir (xs & map compile) "." <&> concat <&> nub <&> sort <&> reverse mapM_ rmAny paths where rmAny s = do _fileExist <- doesFileExist s when _fileExist - removeFile s _dirExist <- doesDirectoryExist s when _dirExist - removeDirectoryRecursive s