module System.Nemesis.Driver where
import Control.Arrow ((>>>))
import Control.Lens
import Control.Monad.State (get, put, execStateT)
import Data.List (intercalate, isPrefixOf, sort)
import qualified Data.Map as Map
import Data.Monoid ((<>))
import Prelude hiding (())
import System.Environment (getArgs)
import Text.Printf (printf)
import System.Nemesis.Type
import System.Nemesis.Utils ((), ljust)
displayName :: Task -> String
displayName t = (t ^. name : t ^. namespace) & reverse & map (printf "%-10s") & intercalate " "
showTask :: Task -> String
showTask = showWithLeftJust 44
showWithLeftJust :: Int -> Task -> String
showWithLeftJust n task =
case task ^. description of
Nothing -> fullName task
Just x -> fullName task & ljust n ' ' & (<> x)
run :: Unit -> IO ()
run unit = do
args <- getArgs
case args of
[] -> help
_target:_ -> execStateT unit (emptyNemesis & target .~ _target) >>= runNemesis
where
help = execStateT unit (emptyNemesis) >>= list_task
list_task n = do
let _tasks = n ^. tasks & Map.elems
_task_len = _tasks & map (fullName >>> length) & maximum & (+ 5)
br
n ^. tasks & Map.elems & sort & map (showWithLeftJust _task_len) & traverse putStrLn
br
br = putStrLn ""
insertTask :: Task -> Unit
insertTask t = do
n <- get
let _description = n ^. currentDesc
_namespace = n ^. currentNamespace
_deps = t ^. deps & map (withCurrent _namespace)
_task = t
& deps .~ _deps
& description .~ _description
& namespace .~ _namespace
_tasks = n ^. tasks & Map.insert (_task & fullName) _task
put n
& tasks .~ _tasks
& currentDesc .~ mempty
where
withCurrent aNamespace x
| "/" `isPrefixOf` x = tail x
| otherwise = (x : aNamespace) & reverse & intercalate "/"
runNemesis :: Nemesis -> IO ()
runNemesis n = run' (n ^. target)
where
run' :: String -> IO ()
run' s = case n ^. (tasks . at s) of
Nothing -> bye
Just x -> run_task x
where
bye = do
printf "%s does not exist!" s
run_task :: Task -> IO ()
run_task t = do
t ^. deps & traverse run'
t ^. action & unShowIO