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