DSL.hs

{-# LANGUAGE NamedFieldPuns #-}

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