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