nemesis 2015.5.4 → 2016.3.19

raw patch · 15 files changed

+251/−339 lines, 15 filesdep +lensdep −airdep −air-thdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: lens

Dependencies removed: air, air-th

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• LICENSE +1/−1
• Nemesis +0/−76
• changelog.md +5/−0
• nemesis.cabal +34/−28
• readme.md +5/−5
• src/System/Nemesis.hs +8/−108
• src/System/Nemesis/DSL.hs +39/−40
• src/System/Nemesis/Driver.hs +86/−0
• src/System/Nemesis/Env.hs +3/−4
• src/System/Nemesis/Type.hs +55/−0
• src/System/Nemesis/Util.hs +0/−21
• src/System/Nemesis/Utils.hs +15/−0
• test/N1.hs +0/−19
• test/N2.hs +0/−22
• test/N3.hs +0/−15

@@ -1,4 +1,4 @@-Copyright (c) 2009-2013, Jinjing Wang+Copyright (c) 2009-2016, Jinjing Wang  All rights reserved. 

@@ -1,76 +0,0 @@-import System.Nemesis.Env-import Air.Env ((-))-import Prelude hiding ((-))--main = run nemesis--nemesis = do-  -  clean-    [ "**/*.hi"-    , "**/*.o"-    , "manifest"-    , "main"-    , "nemesis-tmp.*"-    , "dist"-    ]-  --  desc "prepare cabal dist"-  task "dist" - do-    sh "cabal clean"-    sh "cabal configure"-    sh "cabal sdist"---  desc "put all .hs files in manifest"-  task "manifest" - do-    sh "find . | grep 'hs$' > manifest"---  desc "start console"-  task "i" (sh "ghci -isrc src/System/Nemesis/DSL.hs")-  --  task "runner" (sh "ghci -isrc src/System/Nemesis/Runner.hs")--  desc "show sloc"-  task "stat" - do-    sh "cloc -match-f=hs$ --quiet ."--  -- test for readme--  -- desc is optional, it gives some description to the following task-  desc "Hunter attack macro"-  -  -- syntax: task "keyword: dependencies" io-action-  task "attack: pet-attack auto-attack" (putStrLn "attack macro done!")--  desc "Pet attack"-  task "pet-attack: mark" - do-    sh "echo 'pet attack'"--  desc "Hunter's mark"-  task "mark" - do-    sh "echo \"casting hunter's mark\""-  -  desc "Auto attack"-  task "auto-attack" - do-    sh "echo 'auto shoot'"-    -    -    -  namespace "eat" - do--    task "bread: salad" - putStrLn "eating bread"-    task "salad: /drink/coke" - putStrLn "nice salad"---  namespace "drink" - do--    task "coke" - putStrLn "drinking coke"-    -  -  desc "test"-  task "test" - do-    sh "runghc test/N1.hs"

@@ -1,3 +1,8 @@+2016.3.19+---------++* remove `air` dependency+ 2013.6.16 --------- 

@@ -1,46 +1,52 @@-Name:                 nemesis-Version:              2015.5.4-Build-type:           Simple-Synopsis:             a task management tool for Haskell-Description:          Organize common shell tasks into a meaningful tree like structure with dependency tracking+name:                 nemesis+category:             Tools+version:              2016.3.19+cabal-version:        >= 1.6 -License:              BSD3-License-file:         LICENSE-Author:               Jinjing Wang-Maintainer:           Jinjing Wang <nfjinjing@gmail.com>-Cabal-version:        >= 1.6-category:             Web+license:              BSD3+license-file:         LICENSE++author:               Jinjing Wang+maintainer:           Jinjing Wang <nfjinjing@gmail.com>++build-type:           Simple+tested-with:          GHC == 7.10.3++synopsis:             a task management tool for Haskell+description:          Organize common shell tasks into a meaningful tree like structure with dependency tracking+ homepage:             http://github.com/nfjinjing/nemesis -data-files:           readme.md+extra-doc-files:      readme.md                     , changelog.md                     , known-issues.md-                    , Nemesis-                    , test/N1.hs-                    , test/N2.hs-                    , test/N3.hs  source-repository head   type: git   location: https://github.com/nfjinjing/nemesis.git  library-  ghc-options: -Wall-  build-depends:      base >= 4 && < 100-                    , time-                    , mtl-                    , process-                    , containers-                    , air >= 2014.5.19-                    , air-th-                    , dlist+  ghc-options:      -Wall -fno-warn-unused-do-bind+  build-depends:+                      base > 4 && <= 6                     , Glob+                    , containers                     , directory+                    , dlist+                    , lens+                    , mtl+                    , process+                    , time -  hs-source-dirs: src/+                    -- testing+                    -- , foreign-store >= 0.2+                    -- , air++  hs-source-dirs:     src/   exposed-modules:                       System.Nemesis                       System.Nemesis.DSL                       System.Nemesis.Env-  other-modules:-                      System.Nemesis.Util+                      System.Nemesis.Driver+                      System.Nemesis.Type+                      System.Nemesis.Utils

@@ -4,7 +4,7 @@ Demo ----   -    import System.Nemesis.Env+    import System.Nemesis      main = run $ do @@ -36,8 +36,8 @@  Create a file named `Nemesis` -    import System.Nemesis.Env-    import Air.Env ((-))+    import System.Nemesis+    import System.Nemesis.Utils ((-))     import Prelude hiding ((-))          main = run - do@@ -80,8 +80,8 @@  Create namespaces for tasks with the keyword `namespace`     -    import System.Nemesis.Env-    import Air.Env ((-))+    import System.Nemesis+    import System.Nemesis.Utils ((-))     import Prelude hiding ((-))      main = run - do

@@ -1,116 +1,16 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE TemplateHaskell #-} -module System.Nemesis where--import Prelude ()-import Air.Env hiding (lookup)-import Air.TH hiding (get)-import Control.Monad.State hiding (State, join)-import Data.List (sort)-import Data.Map (Map, insert, lookup, elems)-import System.Environment-import Text.Printf--newtype ShowIO = ShowIO {unShowIO :: IO () }--instance Show ShowIO where-  show _ = "IO"--instance Default ShowIO where-  def = ShowIO (return ())--data Task = Task-  {-    name :: String-  , action :: ShowIO-  , deps :: [String]-  , description :: Maybe String-  , namespace :: [String]-  }-  deriving (Show)--mkDefault ''Task--data Nemesis = Nemesis-  {-    tasks :: Map String Task-  , target :: String-  , current_desc :: Maybe String-  , current_namespace :: [String]-  }-  deriving (Show)--mkDefault ''Nemesis--full_name :: Task -> String-full_name t = (t.name : t.namespace).reverse.join "/"--display_name :: Task -> String-display_name t = (t.name : t.namespace).reverse.map (printf "%-10s") .join " "--show_task :: Task -> String-show_task = show_with_ljust 44--instance Eq Task where-  a == b = a.name == b.name--instance Ord Task where-  compare = compare_by full_name--type Unit = StateT Nemesis IO ()--show_with_ljust :: Int -> Task -> String-show_with_ljust n task=-  case task.description of-    Nothing -> task.full_name-    Just x -> task.full_name.ljust n ' ' + x--run :: Unit -> IO ()-run unit = do-  args <- getArgs-  case args of-    [] -> help-    _target:_ -> execStateT unit def {target = _target} >>= run_nemesis--  where-    help = execStateT unit def >>= list_task-    list_task n = do-      let _tasks = n.tasks.elems--          _task_len = _tasks.map (full_name > length) .maximum + 5--      br-      n.tasks.elems.sort.map (show_with_ljust _task_len) .mapM_ putStrLn-      br-    br = puts ""+module System.Nemesis -insert_task :: Task -> Unit-insert_task t = do-  n <- get-  let description = n.current_desc-      namespace   = n.current_namespace-      deps'       = t.deps.map (with_current namespace)-      task        = t {deps = deps', description, namespace}-      tasks'      = n.tasks.insert (task.full_name) task+( -  put n {tasks = tasks', current_desc = Nothing}-  where-    with_current namespace x-      | x.starts_with "/" = x.tail-      | otherwise = (x : namespace).reverse.join "/"+  module System.Nemesis.DSL+, module System.Nemesis.Driver -run_nemesis :: Nemesis -> IO ()-run_nemesis n = run' (n.target)-  where-    run' :: String -> IO ()-    run' s = case (n.tasks.lookup s) of-      Nothing -> bye-      Just x -> run_task x-      where-        bye = do-          printf "%s does not exist!" s+) +where -    run_task :: Task -> IO ()-    run_task t = t.deps.mapM_ run' >> t.action.unShowIO+import System.Nemesis.DSL+import System.Nemesis.Driver (run)

@@ -2,55 +2,53 @@  module System.Nemesis.DSL where -import Control.Monad.State hiding (State, join)-import Data.List (nub, sort)-import Prelude ()-import Air.Env-import System.Exit-import System.Process-import System.Directory-import System.FilePath.Glob-import System.Nemesis-import System.Nemesis.Util-import Text.Printf+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 s = do-  n <- get-  put n {current_desc = Just s}+desc = (currentDesc .=) . Just  task :: String -> IO () -> Unit-task s action =-  if s.has ':'+task s aAction =+  if ':' `elem` s     then-      let h = s.takeWhile (/= ':')-          t = s.dropWhile (/= ':') .tail+      let h = s & takeWhile (/= ':')+          t = s & dropWhile (/= ':') & tail       in-      task' (h.strip) (t.words)+      task' (strip h ) (words t)     else       task' s []   where-    task' name deps = insert_task def {name, deps, action = ShowIO action}-    strip = dropWhile (== ' ') > reverse > dropWhile (== ' ') > reverse+    task' _name _deps = insertTask -+                      emptyTask+                        & name .~ _name+                        & deps .~ _deps+                        & action .~ ShowIO aAction+    strip = dropWhile (== ' ') >>> reverse >>> dropWhile (== ' ') >>> reverse  namespace :: String -> Unit -> Unit-namespace name unit = do-  push name-  unit+namespace aName aUnit = do+  push aName+  aUnit   pop    where     push :: String -> Unit-    push s = do-      n <- get-      let current_namespace' = s : n.current_namespace-      put n {current_namespace = current_namespace'}+    push = (currentNamespace %=) . (:)      pop :: Unit-    pop = do-      n <- get-      let current_namespace' = n.current_namespace.tail-      put n {current_namespace = current_namespace'}+    pop = (currentNamespace %= tail)  sh :: String -> IO () sh s = do@@ -58,7 +56,7 @@   case status of     ExitSuccess -> return ()     ExitFailure code -> do-      puts - printf "%s failed with status code: %s" s (show code)+      putStrLn - printf "%s failed with status code: %s" s (show code)       exitWith status  @@ -66,11 +64,12 @@ clean xs = do   desc "Remove any temporary products."   task "clean" - do-    paths <- globDir (xs.map compile) "." ^ fst ^ concat ^ nub ^ sort ^ reverse-    mapM_ rm_any paths+    paths <- globDir (xs & map compile) "." <&> fst <&> concat <&> nub <&> sort <&> reverse+    mapM_ rmAny paths     where-      rm_any s = do-        file_exist <- doesFileExist s-        when file_exist - rm s-        dir_exist <- doesDirectoryExist s-        when dir_exist - rm_rf s+      rmAny s = do+        _fileExist <- doesFileExist s+        when _fileExist - removeFile s+        _dirExist <- doesDirectoryExist s+        when _dirExist - removeDirectoryRecursive s+

@@ -0,0 +1,86 @@+{-# LANGUAGE TemplateHaskell #-}++module System.Nemesis.Driver where++import           Control.Arrow        ((>>>))+import           Control.Lens+import           Control.Monad.State  hiding (State, join)+import           Data.List+import qualified Data.Map             as Map+import           Data.Monoid+import           Prelude              hiding ((-))+import           System.Environment+import           System.Nemesis.Type+import           System.Nemesis.Utils+import           Text.Printf++++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

@@ -1,4 +1,4 @@-module System.Nemesis.Env +module System.Nemesis.Env  ( @@ -8,7 +8,6 @@ )  where-   -import System.Nemesis.DSL-import System.Nemesis (run)+import           System.Nemesis     (run)+import           System.Nemesis.DSL

@@ -0,0 +1,55 @@+{-# LANGUAGE TemplateHaskell #-}++module System.Nemesis.Type where++import           Control.Lens+import           Control.Monad.State hiding (State, join)+import           Data.Function+import           Data.List+import           Data.Map            (Map)+import           Prelude             hiding ((-))++newtype ShowIO = ShowIO {unShowIO :: IO () }++instance Show ShowIO where+  show _ = "IO"++data Task = Task+  {+    _name        :: String+  , _action      :: ShowIO+  , _deps        :: [String]+  , _description :: Maybe String+  , _namespace   :: [String]+  }+  deriving (Show)++emptyTask :: Task+emptyTask = Task mempty (ShowIO (pure ())) mempty mempty mempty++makeLenses ''Task++data Nemesis = Nemesis+  {+    _tasks            :: Map String Task+  , _target           :: String+  , _currentDesc      :: Maybe String+  , _currentNamespace :: [String]+  }+  deriving (Show)++emptyNemesis :: Nemesis+emptyNemesis = Nemesis mempty mempty mempty mempty++makeLenses ''Nemesis++instance Eq Task where+  (==) = (==) `on` (view name)++fullName :: Task -> String+fullName t = intercalate "/" . reverse $ (t ^. name : t ^. namespace)++instance Ord Task where+  compare = compare `on` fullName++type Unit = StateT Nemesis IO ()

@@ -1,21 +0,0 @@-{-# LANGUAGE NoMonomorphismRestriction #-}--module System.Nemesis.Util (-    ls-  , rm-  , rm_rf-) where--import System.Directory-import Air.Env-import Prelude ()-import Data.List ((\\))--ls :: String -> IO [String]-ls s = getDirectoryContents s ^ (\\ [".", ".."])--rm :: String -> IO ()-rm = removeFile--rm_rf :: String -> IO ()-rm_rf = removeDirectoryRecursive

@@ -0,0 +1,15 @@+{-# LANGUAGE OverloadedStrings #-}++module System.Nemesis.Utils where++import           Prelude          hiding ((-))++infixr 0 -+{-# INLINE (-) #-}+(-) :: (a -> b) -> a -> b+f - x = f x++ljust :: Int -> a -> [a] -> [a]+ljust n x xs+  | n < length xs = xs+  | otherwise     = take n (xs ++ replicate n x)

@@ -1,19 +0,0 @@-import System.Nemesis.Env--main = run $ do--  clean-    [ "**/*.hi"-    , "**/*.o"-    , "manifest"-    ]-    -  task "dist" $ do-    sh "cabal clean"-    sh "cabal configure"-    sh "cabal sdist"--  task "i" (sh "ghci -isrc src/System/Nemesis.hs")--  task "manifest" $ do-    sh "find . | grep 'hs$' > manifest"

@@ -1,22 +0,0 @@-import System.Nemesis.Env-import Air.Env ((-))-import Prelude hiding ((-))--main = run - do--  -- desc is optional, it gives some description to the task-  -- task syntax: task "keyword: space seperated dependencies" io-action-  desc "Hunter attack macro"-  task "attack: pet-attack auto-attack" (putStrLn "attack macro done!")--  desc "Pet attack"-  task "pet-attack: mark" - do-    sh "echo 'pet attack'"--  desc "Hunter's mark"-  task "mark" - do-    sh "echo \"casting hunter's mark\""--  desc "Auto attack"-  task "auto-attack" - do-    sh "echo 'auto shoot'"

@@ -1,15 +0,0 @@-import System.Nemesis.Env-import Air.Env ((-))-import Prelude hiding ((-))--main = run - do--  namespace "eat" - do--    task "bread: salad" - putStrLn "eating bread"-    task "salad: /drink/coke" - putStrLn "eating salad"---  namespace "drink" - do--    task "coke" - putStrLn "drinking coke"