diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,15 @@ +2009.6.13 +--------- + +### Feature + +* add `desc` dsl + +### Fix + +* super fast compile +* -Wall clean + 2009.6.12 --------- diff --git a/nemesis.cabal b/nemesis.cabal --- a/nemesis.cabal +++ b/nemesis.cabal @@ -1,5 +1,5 @@ Name: nemesis -Version: 2009.6.12 +Version: 2009.6.13 Build-type: Simple Synopsis: a rake like task management tool Description: @@ -18,13 +18,16 @@ library ghc-options: -Wall - build-depends: base >= 4 && < 5, haskell98, mtl, process, containers, data-default, mps >= 2009.5.13 + build-depends: base >= 4 && < 5, haskell98, mtl, process, containers, data-default hs-source-dirs: src/ exposed-modules: System.Nemesis + other-modules: + Nemesis.Util Executable nemesis ghc-options: -Wall - build-depends: base >= 4 && < 5, haskell98, mtl, process, containers, data-default, mps >= 2009.5.13 + build-depends: base >= 4 && < 5, haskell98, mtl, process, containers, data-default, directory hs-source-dirs: src/ - main-is: Runner.hs + main-is: Nemesis/Runner.hs + other-modules: Nemesis.Util diff --git a/readme.md b/readme.md --- a/readme.md +++ b/readme.md @@ -9,13 +9,16 @@ in `nem.hs` nemesis = do - task "clean: hello-world" (print "cleaning") + desc "learn Haskell" + task "learn-haskell: learn-fp" (putStrLn "Haskell is awesome!") - task "hello-world: ls" $ do - sh "echo HELLO" + desc "learn Functional Programming" + task "learn-fp: learn-lisp" $ do + sh "echo 'into FP'" - task "ls" $ do - sh "ls" + desc "learn LISP" + task "learn-lisp" $ do + sh "echo 'LISP is cool!'" run `nemesis` @@ -25,18 +28,22 @@ run `./nem` - clean: hello-world ls - hello-world: ls - ls: + learn-fp: learn Functional Programming + learn-haskell: learn Haskell + learn-lisp: learn LISP -run `./nem ls` +run `./nem learn-haskell` + LISP is cool! + into FP + Haskell is awesome! + Advance usage ------------- -### Use LANGUAGEW +### Use LANGUAGE Use a separator below language extensions, e.g. diff --git a/src/Nemesis/Runner.hs b/src/Nemesis/Runner.hs new file mode 100644 --- /dev/null +++ b/src/Nemesis/Runner.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE QuasiQuotes #-} + +import Prelude hiding ((.), (>), (^)) +import System.Cmd +import Nemesis.Util + +start, end :: String +start = "\n\n\n\nmodule Main where\n" ++ "import System.Nemesis" +end = "\n\n\nmain = run nemesis\n" + +main :: IO () +main = do + dir <- ls "." + src <- readFile $ dir.filter (belongs_to possible_source) .get_name + let h = src.lines.takeWhile (lower > starts_with sep > not) .unlines + t = src.lines.dropWhile (lower > starts_with sep > not) .unlines + if t.null + then output $ start ++ h ++ end + else output $ h ++ start ++ t ++ end + + system $ "ghc --make -O1 " ++ tmp_name ++ " -o " ++ bin + system $ "rm " ++ tmp_name + return () + + where + get_name [] = error "Nemesis does not exists" + get_name xs = xs.first + possible_source = ["Nemesis", "nemesis", "nemesis.hs", "Nemesis.hs"] + sep = "-- nem" + output = writeFile tmp_name + tmp_name = "nemesis-tmp.hs" + bin = "nem" + +-- helper from mps diff --git a/src/Nemesis/Util.hs b/src/Nemesis/Util.hs new file mode 100644 --- /dev/null +++ b/src/Nemesis/Util.hs @@ -0,0 +1,65 @@ +{-# LANGUAGE NoMonomorphismRestriction #-} + +module Nemesis.Util where + +import Prelude hiding ((>), (.), (^)) +import qualified Data.List as L +import Data.Function (on) +import Control.Arrow ((>>>)) +import Data.Char (toLower) +import Data.List (isPrefixOf, (\\)) +import System.Directory +import Control.Category (Category) + + +-- utility functions from mps + +-- base DSL +(.) :: a -> (a -> b) -> b +a . f = f a +infixl 9 . + +(^) :: (Functor f) => f a -> (a -> b) -> f b +(^) = flip fmap +infixl 8 ^ + +(>) :: (Category cat) => cat a b -> cat b c -> cat a c +(>) = (>>>) +infixl 8 > + + +join :: [a] -> [[a]] -> [a] +join = L.intercalate + +join' :: [[a]] -> [a] +join' = concat + +ljust :: Int -> a -> [a] -> [a] +ljust n x xs + | n < xs.length = xs + | otherwise = ( n.times x ++ xs ).reverse.take n.reverse + +compare_by :: (Ord b) => (a -> b) -> a -> a -> Ordering +compare_by = on compare + +first :: [a] -> a +first = head + +times :: b -> Int -> [b] +times = flip replicate + +has :: (Eq a) => a -> [a] -> Bool +has = elem + +belongs_to :: (Eq a) => [a] -> a -> Bool +belongs_to = flip elem + + +lower :: String -> String +lower = map toLower + +starts_with :: String -> String -> Bool +starts_with = isPrefixOf + +ls :: String -> IO [String] +ls s = getDirectoryContents s ^ (\\ [".", ".."]) diff --git a/src/Runner.hs b/src/Runner.hs deleted file mode 100644 --- a/src/Runner.hs +++ /dev/null @@ -1,44 +0,0 @@ -{-# LANGUAGE QuasiQuotes #-} - -import MPS -import Prelude hiding ((.), (>), (^)) -import System.Cmd - - -start, end :: String -start = [$here| -module Main where -import System.Nemesis - - -|] - -end = [$here| - - -main = run nemesis -|] - -main :: IO () -main = do - dir <- ls "." - src <- readFile $ dir.filter (belongs_to possible_source) .get_name - let h = src.lines.takeWhile (lower > starts_with sep > not) .unlines - t = src.lines.dropWhile (lower > starts_with sep > not) .unlines - if t.null - then output $ start ++ h ++ end - else output $ h ++ start ++ t ++ end - - system $ "ghc --make " ++ tmp_name ++ " -o " ++ bin - system $ "rm " ++ tmp_name - return () - - where - get_name [] = error "nem.hs does not exists" - get_name xs = xs.first - possible_source = ["Nem.hs", "nem.hs", "nemesis.hs", "Nemesis.hs"] - sep = "-- nem" - output = writeFile tmp_name - tmp_name = "nemesis-tmp.hs" - bin = "nem" - diff --git a/src/System/Nemesis.hs b/src/System/Nemesis.hs --- a/src/System/Nemesis.hs +++ b/src/System/Nemesis.hs @@ -1,45 +1,42 @@ {-# LANGUAGE NamedFieldPuns #-} -module System.Nemesis (run, sh, task) where +module System.Nemesis (run, sh, task, desc) where -import MPS hiding (empty) +-- import MPS hiding (empty) import Prelude hiding ((.), (>), (^), lookup) import Control.Monad.State hiding (State, join) import Data.Default import Data.Map (Map, insert, empty, lookup, elems) -import System.Cmd (system) import System import GHC.IOBase hiding (liftIO) +import Nemesis.Util data Task = Task { name :: String , action :: IO () , deps :: [String] + , description :: Maybe String } data Nemesis = Nemesis { tasks :: Map String Task , target :: String + , current_desc :: Maybe String } deriving (Show) instance Default Nemesis where - def = Nemesis empty def + def = Nemesis empty def def instance Default Task where - def = Task def (return ()) def + def = Task def (return ()) def def instance Show Task where - show x - | x.deps.null = title - | otherwise = - [ - title - , x.deps.join " " - , "" - ] .concat + show x = case x.description of + Nothing -> title + Just s -> title ++ s where title = x.name.ljust 20 ' ' ++ ": " @@ -57,7 +54,7 @@ status <- system s case status of ExitSuccess -> return () - ExitFailure code -> error $ s ++ " failed with status code" ++ show code + ExitFailure code -> error $ s ++ " failed with status code: " ++ show code run :: Unit -> IO () run unit = do @@ -74,19 +71,31 @@ br br = putStrLn "" +desc :: String -> Unit +desc s = do + n <- get + put n {current_desc = Just s} + task :: String -> IO () -> Unit task s action = - let x:xs = s.split "\\s*:\\s*" - in - task' x (xs.join'.words) + if s.has ':' + then + let h = s.takeWhile (/= ':') + t = s.dropWhile (/= ':') .tail + in + task' h (t.words) + else + task' s [] where - task' name deps = insert_task Task {name, deps, action} + task' name deps = insert_task def {name, deps, action} insert_task :: Task -> Unit insert_task t = do n <- get - let tasks' = n.tasks.insert (t.name) t - put n {tasks = tasks'} + let description = n.current_desc + tasks' = n.tasks.insert (t.name) t {description} + + put n {tasks = tasks', current_desc = Nothing} run_nemesis :: Nemesis -> IO () run_nemesis n = run' (n.target) @@ -99,8 +108,9 @@ bye = error $ s ++ " does not exist!" revenge :: Task -> IO () - revenge t = t.deps.to_list.mapM_ run' >> revenge_and_say + revenge t = t.deps.mapM_ run' >> revenge_and_say where revenge_and_say = do -- putStrLn $ "running: " ++ t.name t.action +