cake 0.3.2.1 → 0.4.0.0
raw patch · 5 files changed
+81/−41 lines, 5 files
Files
- Cake/Core.hs +30/−26
- Cake/Marxup.hs +40/−0
- Cake/Process.hs +1/−2
- Cake/Rules.hs +8/−10
- cake.cabal +2/−3
Cake/Core.hs view
@@ -23,8 +23,10 @@ shielded, Question(..), Answer(..),+ Failure(..), -- * Re-exports module Control.Applicative,+ throwError, ) where import Data.Digest.Pure.MD5@@ -37,6 +39,7 @@ import Control.Monad (when) import Control.Monad.RWS hiding (put,get) import qualified Control.Monad.RWS as RWS+import Control.Monad.Error import qualified Parsek import Parsek (completeResults, parse, Parser) import qualified Data.Map as M@@ -75,14 +78,23 @@ type Rule = P (Act ()) type State = (Produced,Status) type Written = Dual DB -- take the dual so the writer overwrites old entries in the DB.+data Failure = CakeError String | Panic | ProcessError ExitCode data Context = Context {ctxHandle :: Handle, ctxRule :: Rule, ctxDB :: DB, ctxProducing :: [Question]}-newtype Act a = Act (RWST Context Written State IO a)- deriving (Functor, Applicative, Monad, MonadIO, MonadState State, MonadWriter Written, MonadReader Context)--- Take the dual here so that new info overwrites old.+newtype Act a = Act (ErrorT Failure (RWST Context Written State IO) a)+ deriving (Functor, Applicative, Monad, MonadIO, MonadState State, MonadWriter Written, MonadReader Context, MonadError Failure) data Status = Clean | Dirty deriving Eq- ++instance Error Failure where+ noMsg = Panic+ strMsg = CakeError ++instance Show Failure where+ show (CakeError x) = x+ show (ProcessError code) = "Process returned exit code " ++ show code+ show (Panic) = "PANIC"+ instance Applicative P where (<*>) = ap pure = return@@ -113,7 +125,7 @@ putStrLn $ (show k) ++ " => " ++ (show v) encodeFile databaseFile newDB -+-- | Was the file already produced? produced :: FilePath -> Act Bool produced f = do (ps,_) <- RWS.get@@ -122,8 +134,8 @@ -- | Answer a question using the action given. -- The action should be independent of the context. distill :: Question -> Act Answer -> Act Answer-distill q act = do- a1 <- local (modCx q) $ do+distill q act = + local (modCx q) $ do debug $ "Starting to answer" db <- ctxDB <$> ask let a0 = M.lookup q db@@ -133,8 +145,6 @@ clobber debug $ "Question has not the same answer" return a1- debug $ "..."- return a1 modCx q (Context {..}) = Context {ctxProducing = q:ctxProducing,..} @@ -145,7 +155,7 @@ tell (Dual $ M.singleton q a) return a --- | Produce a file, using with the given action.+-- | Produce a file, using the given action. -- The action should be independent of the context. produce :: FilePath -> Act () -> Act () produce f a = do@@ -178,8 +188,7 @@ -- | Mark that a file is used. Do not chase dependencies on this file -- though.-use f = do- distill (FileContents f) (fileStamp f)+use f = distill (FileContents f) (fileStamp f) -- | File was modified by some command, but in a way that does not@@ -209,7 +218,10 @@ runAct :: Rule -> DB -> Act () -> IO DB runAct r db (Act act) = do h <- openFile logFile WriteMode- (_a,Dual db) <- evalRWST act (Context h r db []) (S.empty,Clean)+ (a,Dual db) <- evalRWST (runErrorT act) (Context h r db []) (S.empty,Clean)+ case a of+ Right _ -> putStrLn "Success!"+ Left e -> putStrLn $ "cake: " ++ show e hClose h return db @@ -219,7 +231,7 @@ let rs = parse r completeResults f case rs of Right [x] -> return (Just x)- Right _ -> fail $ "More than one rule for file " ++ f+ Right _ -> throwError $ CakeError $ "More than one rule for file " ++ f Left e -> do debug $ "No rule for file: " ++ f -- debug $ "Parser says: " ++ show e@@ -233,18 +245,9 @@ let st = case s of Clean -> "O" Dirty -> "X"- liftIO $ hPutStrLn h $ "cake: " ++ st ++ " "++ concat (map (++": ") $ reverse $ map show ps) ++ x --{--runQuery :: Question -> IO Answer -runQuery (Listing directory extension) = do- files <- filter (filt . takeExtension) <$> getDirectoryContents directory- return $ Text (map (directory </>) files)- where filt = if null extension then const True else (== '.':extension)- -runQuery (Stamp f) = fileStamp f--}+ liftIO $ hPutStrLn h $ st ++ " "++ concat (map (++": ") $ reverse $ map show ps) ++ x +-- | Return a stamp (hash) for a file fileStamp f = liftIO $ do e <- doesFileExist f Stamp <$> if e @@ -253,6 +256,7 @@ clobber = RWS.modify $ second $ const Dirty +-- | Run the action in only in a clobbered state cut x = do (_,s) <- RWS.get case s of@@ -267,7 +271,7 @@ case r of Nothing -> do e <- liftIO $ doesFileExist f- when (not e) $ fail $ "No rule to create " ++ f+ when (not e) $ throwError $ CakeError $ "No rule to create " ++ f debug $ "using existing file" use f return ()
+ Cake/Marxup.hs view
@@ -0,0 +1,40 @@+module Cake.Marxup where+ +import Cake.Core +import Cake.Rules+import Cake.Process+import System.FilePath++import Parsek++ghcMake x = produce x $ do+ let src = x <.> "hs"+ need src+ system ["ghc", "-o", x, "--make", src]+ ++marxup x = do + produce (x <.> "tex") $ do+ ghcMake x+ cut $ + system $ ["./" ++ x]+ produce (x <.> "mp") $ return ()++mpost x = system ["mpost", x]++remove x = system ["rm", "-f", x]++pdf_marxup x = produce (x <.> "pdf") $ do + marxup x+ let delayed = x ++ "-delayed.mp"+ produce delayed $ do+ let mp = x <.> "mp"+ need mp+ cut $ do + remove delayed+ mpost mp+ mpost mp+ + cut $ _pdflatex x++
Cake/Process.hs view
@@ -12,7 +12,6 @@ quote :: String -> String quote = show - maybeM :: Applicative m => (a -> m Handle) -> Maybe a -> m StdStream maybeM f Nothing = pure Inherit maybeM f (Just x) = UseHandle <$> f x@@ -33,7 +32,7 @@ succeed :: Act ExitCode -> Act () succeed act = do code <- act- when (code /= ExitSuccess) $ fail "Command returned non-zero exitcode."+ when (code /= ExitSuccess) $ throwError $ ProcessError code system xs = succeed $ system' xs processIO c a i o = succeed $ processIO' c a i o
Cake/Rules.hs view
@@ -96,21 +96,19 @@ pdf_tex = simple ".pdf" ".tex" $ \o i -> system ["latexmk","-pdf",i] +argsOf s = map (init . (drop $ 2 + length s)) . filter (("\\" ++ s ++ "{") `isPrefixOf`) + getBibFiles input = distill (Custom ["bibfiles",input]) $ do- ls <- map (drop 14) . filter ("\\bibliography{" `isPrefixOf`) . lines <$> Cake.Rules.readFile input let bibs = map (++".bib") $ case ls of [] -> [] (l:_) -> splitOn "," $ reverse . dropWhile (== '}') . reverse $ l return $ Text bibs -includedTex input = do- ls <- map (drop 7) . filter ("\\input{" `isPrefixOf`) . lines <$> Cake.Rules.readFile input- let inputs = map (++".tex") $ case ls of- [] -> []- (l:_) -> splitOn "," $ reverse . dropWhile (== '}') . reverse $ l- return $ inputs+s ++? e = if e `isSuffixOf` s then s else s ++ e +includedTex input = map (++? ".tex") . argsOf "input" . lines <$> Cake.Rules.readFile input+ chaseDeps i = do is <- includedTex i mapM_ chaseDeps is@@ -122,9 +120,7 @@ pdf = c ++ ".pdf" bbl = c ++ ".bbl" produce pdf $ do - - -- hack: if nothing changed in the aux file, there is no need to- -- do the final pdflatex, because pdflatex has already produced the tex file.+ produce' aux $ do produce bbl $ do produce' aux $ do@@ -138,6 +134,8 @@ cut $ _bibtex c cut $ _pdflatex c + -- hack: if nothing changed in the aux file, there is no need to+ -- do the final pdflatex, because pdflatex has already produced the tex file. cut $ do _pdflatex c overwrote aux return ()
cake.cabal view
@@ -1,5 +1,5 @@ name: cake-version: 0.3.2.1+version: 0.4.0.0 category: Development synopsis: A build-system library and driver description:@@ -9,7 +9,6 @@ author: Jean-Philippe Bernardy maintainer: jeanphilippe.bernardy@gmail.com Cabal-Version: >= 1.12-tested-with: GHC==6.12.1 tested-with: GHC==7.4.1 build-type: Simple @@ -28,7 +27,7 @@ build-depends: pureMD5==2.1.* build-depends: split==0.1.* - exposed-modules: Cake, Cake.Core, Cake.Rules, Cake.Process, Parsek+ exposed-modules: Cake, Cake.Core, Cake.Rules, Cake.Process, Cake.Marxup, Parsek executable cake default-language: Haskell2010