module System.Nemesis.DSL where
import Control.Arrow
import Control.Lens
import Control.Monad.State hiding (State)
import Data.List
import Prelude hiding (())
import System.Directory
import System.Exit
import System.FilePath.Glob
import System.Nemesis.Driver
import System.Nemesis.Type
import System.Nemesis.Utils
import System.Process
import Text.Printf
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) "." <&> fst <&> 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