cake 0.4.2.0 → 1.0.0

raw patch · 6 files changed

+214/−181 lines, 6 filesdep ~bytestringdep ~containersPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: bytestring, containers

API changes (from Hackage documentation)

Files

• Cake.hs +2/−0
• Cake/Actions.hs +134/−0
• Cake/Core.hs +65/−36
• Cake/Marxup.hs +1/−1
• Cake/Rules.hs +8/−140
• cake.cabal +4/−4

@@ -1,8 +1,10 @@ module Cake (module Cake.Core, +             module Cake.Actions,               module Cake.Rules,              module Cake.Process) where  import Cake.Core+import Cake.Actions import Cake.Rules import Cake.Process 

@@ -0,0 +1,134 @@+module Cake.Actions where++import Cake.Core+import Cake.Process+import System.Directory+import System.FilePath+import Control.Applicative+import Control.Monad (when)+import Control.Monad.RWS (liftIO)+import Data.List+import Data.List.Split+import Data.Char (isSpace)++copy :: FilePath -> FilePath -> Act()+copy from to = shielded $ produce to $ do+  needs [from]+  cut $ do+    mkdir $ takeDirectory to+    liftIO $ copyFile from to++mkdir :: FilePath -> Act ()    +mkdir d = liftIO $ createDirectoryIfMissing True d+    +touch :: FilePath -> Act ()+touch x = shielded $ produce x $ do+  system ["touch",x]+  +readFile :: FilePath -> Act String+readFile x = do+  need x+  liftIO $ Prelude.readFile x+  +_pdflatex x = system ["pdflatex",x]+  +_bibtex x = system ["bibtex",x]+++pandoc inp typ options = produce out $ do +  need inp+  cut $ system $ ["pandoc",inp,"-t",typ,"-o",out] ++ options+ where out = replaceExtension inp ext+       ext = case typ of +               "latex" -> "tex"+               _ -> typ++graphviz program inp typ options = produce out $ do+  needs [inp]          +  cut $ system $ [program, "-T"++typ, "-o"++out, inp] ++ options+ where out = replaceExtension inp typ+  +-- | Argument of a latex macro+argsOf s = map (init . (drop $ 2 + length s)) . filter (("\\" ++ s ++ "{") `isPrefixOf`) ++-- | Find the bib files used in a tex file+getBibFiles input = distill (Custom ["bibfiles",input]) $ do+    ls <- map (drop 14) . filter ("\\bibliography{" `isPrefixOf`) . lines <$> Cake.Actions.readFile input+    let bibs = map (++".bib") $ case ls of+            [] -> []+            (l:_) -> splitOn "," $ reverse . dropWhile (== '}') . reverse $ l+    return $ Text bibs++s ++? e = if e `isSuffixOf` s then s else s ++ e++dropSpaces = reverse . dropWhile isSpace . reverse . dropWhile isSpace ++includedTex input = map (++? ".tex") . argsOf "input" . lines <$> Cake.Actions.readFile input++includedLhs input = filter (`notElem` stdinclude) . map (dropSpaces . drop 8) . filter ("%include" `isPrefixOf`) . map (dropWhile isSpace). lines <$> Cake.Actions.readFile input+  where stdinclude = ["lhs2TeX.fmt","polycode.fmt"]++chaseDeps includedFiles i = do+  is <- includedFiles i+  mapM_ (chaseDeps includedFiles) is+  +pdflatexBibtex c = do+  let input = c ++ ".tex"+      aux = c ++ ".aux"+      pdf = c ++ ".pdf"+      bbl = c ++ ".bbl"++  produces [aux,pdf] $ do+    chaseDeps includedTex input+    cut $ _pdflatex c+  +  produce bbl $ do+    Text bibs <- getBibFiles input  +    needs bibs      +    cut $ _bibtex c    +    +  shielded $ do+    use aux+    use bbl+    updates [aux,pdf] $ cut $ _pdflatex c+  ++{-+pdf_tex_bibtex = extension ".pdf" ==> \(_,c) -> pdflatexBibtex c++pdflatexBiblatex c = do+  let input = c ++ ".tex"+      aux = c ++ ".aux"+      pdf = c ++ ".pdf"+  produce pdf $ do+    produce aux $ do +      chaseDeps includedTex input+      cut $ _pdflatex c+    +    produce (c ++ ".bbl") $ do+      -- Note that this does not depend on the actual tex file; only the list of bibs.+      Text bibs <- getBibFiles input+      mapM_ need bibs+      use aux+      when (not $ null bibs) $+        cut $ _bibtex c++    cut $ do _pdflatex c+             overwrote aux+             return ()+    ++pdf_tex_biblatex = anyExtension [".pdf",".aux"] ==> \(_,c) -> +  pdflatexBibtex c++-}+_lhs2TeX i o = do+  system ["lhs2TeX","-o",o,i]+++lhs2tex c = produce tex $ do+  chaseDeps includedLhs lhs+  cut $ _lhs2TeX lhs tex+ where lhs = c ++ ".lhs"+       tex = c ++ ".tex"+

@@ -8,19 +8,18 @@   -- * High-level interface   Act,                cake,-  need,           +  need, needs,              list,   -- * Mid-level interface-  produce,-  produce',-  use,-  overwrote,+  produce, produces,+  cut, independently,   -- * Low-level interface   debug,   distill,   fileStamp,-  cut,-  -- shielded,+  shielded,+  use,+  updates,   Question(..),   Answer(..),   Failure(..),@@ -92,7 +91,7 @@   deriving (Functor, Applicative, Monad, MonadIO, MonadState State, MonadWriter Written, MonadReader Context, MonadError Failure)  data Status = Clean | Dirty -            deriving Eq+            deriving (Eq,Ord)  instance Error Failure where    noMsg = Panic@@ -107,6 +106,8 @@   empty = Parsek.pzero                       +-- | Primitve for rule construction. The given action must produce+-- files matched by the pattern. (==>) :: P x -> (x -> Act a) -> Rule p ==> a = (\s -> do a s;return ()) <$> p @@ -137,51 +138,51 @@  modCx q (Context {..}) = Context {ctxProducing = q:ctxProducing,..}     --- | Answer a question using the action given.--- The action must be independent of the context.+-- | Answer a question using the action given.   distill :: Question -> Act Answer -> Act Answer distill q act = local (modCx q) $ do-  debug $ "Starting to answer"+  debug $ "Starting to answer: " ++ show q   db <- ctxDB <$> ask-  a1 <- refresh q act-  when (Just a1 /= M.lookup q db) $ do-    clobber-    debug $ "Question has not the same answer"+  a1 <- refresh q $ noClobber act+  let same = Just a1 == M.lookup q db+  debug $ "Old answer: " ++ show (M.lookup q db)+  debug $ "New answer: " ++ show a1+  when (not same) clobber+  debug $ "Same? "  ++ show same   return a1 --- | Answer a question using the action given. The action must be--- independent of the context. The result is not compared to the+-- | Answer a question using the action given. +-- The result is not compared to the -- previous run, so it is the caller responsibility that the new -- answer is properly taken into account. refresh :: Question -> Act Answer -> Act Answer refresh q act = -  do a <- shielded act+  do a <- act      tell (Dual $ M.singleton q a)      return a   `catchError` \ e -> do -- on error      tell (Dual $ M.singleton q $ Failed e) -- Answering the question failed...      throwError e -- and questions depending on it will also fail +produce x = produces [x]+ -- | Produce a file, using the given action.--- The action should be independent of the context.-produce :: FilePath -> Act () -> Act ()-produce f a = do-  p <- produced f -- Do nothing if the file is already produced.-  when (not p) $ do-     produce' f a-     return ()+produces :: [FilePath] -> Act () -> Act ()+produces fs a = do+  ps <- mapM produced fs -- Do nothing if the file is already produced.+  when (not $ and ps) $ updates fs a --- | Produce a file, using with the given action.--- The action should be independent of the context.--- BUT: no problem to produce the same file multiple times.-produce' :: FilePath -> Act () -> Act Answer-produce' f a = distill (FileContents f) $ do+-- | Produce a file, using with the given action.  BUT: no problem to+-- produce the same file multiple times.  +updates :: [FilePath] -> Act () -> Act ()+updates [] a = a +updates (f:fs) a = distill (FileContents f) (do           e <- liftIO $ doesFileExist f-          when (not e) clobber -          a+          updates fs (when (not e) clobber >> a)+          -- force running the action if the file is not present, even if in a clean state.           modify $ first $ S.insert f            -- remember that the file has been produced already-          fileStamp f+          fileStamp f) >> return ()   -- | List directory contents by extension@@ -201,6 +202,7 @@ -- | File was modified by some command, but in a way that does not -- invalidate previous computations. (This is probably only useful for -- latex processing).+overwrote :: FilePath -> Act Answer overwrote f = refresh (FileContents f) (fileStamp f)  -- | Run the argument in a clean context, and do not clobber the state@@ -214,14 +216,33 @@ -- must be set independently in the context if the produced object is -- not present. shielded :: Act a -> Act a-shielded a = do +shielded a = do   (ps,s) <- RWS.get   RWS.put (ps,Clean)   x <- a   (ps',_) <- RWS.get-  RWS.put (ps',s)+  RWS.modify (second (const s))   return x +-- | Run the action, but do not clobber the state.+noClobber :: Act a -> Act a  +noClobber a = do+  s <- snd <$> RWS.get+  x <- a+  RWS.modify (second (const s))+  return x++independently :: [Act a] -> Act ()  +independently as = do+  (ps,s) <- RWS.get+  ds <- forM as $ \a -> do+    RWS.modify (second (const s))+    a  +    snd <$> RWS.get+  RWS.modify (second (const (maximum $ s:ds)))+    ++     runAct :: Rule -> DB -> Act () -> IO DB runAct r db (Act act) = do    h <- openFile logFile WriteMode@@ -255,15 +276,17 @@   liftIO $ hPutStrLn h $ st ++ " "++ concat (map (++": ") $ reverse $ map show ps) ++ x   -- | Return a stamp (hash) for a file+fileStamp :: FilePath -> Act Answer   fileStamp f = liftIO $ do   e <- doesFileExist f   Stamp <$> if e      then Just <$> md5 <$> B.readFile f     else return Nothing -clobber = RWS.modify $ second $ const Dirty+clobber = RWS.modify $ second $ (const Dirty)  -- | Run the action in only in a clobbered state+cut :: Act () -> Act () cut x = do   (_,s) <- RWS.get   case s of@@ -283,3 +306,9 @@       use f       return ()     Just a -> a++needs = independently . map need++++

@@ -1,7 +1,7 @@ module Cake.Marxup where         import Cake.Core       -import Cake.Rules+import Cake.Actions import Cake.Process import System.FilePath 

@@ -2,13 +2,11 @@  import Cake.Core import Cake.Process+import Cake.Actions import System.Directory import System.FilePath import Control.Applicative-import Control.Monad (when)-import Control.Monad.RWS (liftIO) import qualified Parsek-import Parsek (completeResults, parse, Parser) import Data.List import Data.List.Split @@ -23,166 +21,36 @@ anyExtension :: [String] -> P (String,String) anyExtension ss = foldr (<|>) empty (map extension ss) ------------------------------------------------------------- Actions--copy :: FilePath -> FilePath -> Act()-copy from to = produce to $ needing [from] $ do-  mkdir $ takeDirectory to-  liftIO $ copyFile from to--mkdir :: FilePath -> Act ()    -mkdir d = liftIO $ createDirectoryIfMissing True d-    -touch :: FilePath -> Act ()-touch x = produce x $ do-  system ["touch",x]-  -readFile :: FilePath -> Act String-readFile x = do-  need x-  liftIO $ Prelude.readFile x-  -_pdflatex x = system ["pdflatex",x]-  -_bibtex x = system ["bibtex",x]--pandoc inp typ options = produce out $ do -  need inp-  cut $ system $ ["pandoc",inp,"-t",typ,"-o",out] ++ options- where out = replaceExtension inp ext-       ext = case typ of -               "latex" -> "tex"-               _ -> typ- -graphviz program inp typ options = produce out $ needing [inp] $ do-  system $ [program, "-T"++typ, "-o"++out, inp] ++ options- where out = replaceExtension inp typ-  -{--mpostDeriv = extension "-delayed.mp" ==> \s -> do-  let input = s ++ ".mp"-  need input-  rm (s ++ "-delayed.mp")-  mpost input-  mpost input-   -}--needing :: [FilePath] -> Act () -> Act ()-needing xs act = do-  mapM_ need xs-  cut act-           -------------------------------------------------------------- -- Rules  simple outExt inExt f = extension outExt ==> \(output,base) ->   let input = base ++ inExt -  in  produce output $ needing [input]  $ f output input+  in  produce output $ do+        need input+        f output input     tex_markdown_standalone = simple ".tex" ".markdown" $ \o i ->    pandoc i "latex" ["--standalone"]+ {- html_markdown_standalone = simple ".html" ".markdown" $ \o i ->    system ["pandoc","--tab-stop=2","--standalone","-f","markdown","-t","latex",            "-o", o, i]   -}   -{--tex_lhs = extension ".tex" $ \c -> do   -  -- chase includes-  -}--   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--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-  --pdflatexBibtex c = do-  let input = c ++ ".tex"-      aux = c ++ ".aux"-      pdf = c ++ ".pdf"-      bbl = c ++ ".bbl"-  produce pdf $ do -    -    produce' aux $ do-      produce bbl $ do-        produce' aux $ do-          chaseDeps input-          cut $ _pdflatex c--        Text bibs <- getBibFiles input-        -- Note that this does not depend on the actual tex file; only the list of bibs. (aux1)-        mapM_ need bibs-        when (not $ null bibs) $-          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 ()--pdf_tex_bibtex = extension ".pdf" ==> \(_,c) -> pdflatexBibtex c--pdflatexBiblatex c = do-  let input = c ++ ".tex"-      aux = c ++ ".aux"-      pdf = c ++ ".pdf"-  produce pdf $ do-    produce aux $ do -      chaseDeps input-      cut $ _pdflatex c-    -    produce (c ++ ".bbl") $ do-      -- Note that this does not depend on the actual tex file; only the list of bibs.-      Text bibs <- getBibFiles input-      mapM_ need bibs-      use aux-      when (not $ null bibs) $-        cut $ _bibtex c--    cut $ do _pdflatex c-             overwrote aux-             return ()-    -+{- pdf_tex_biblatex = anyExtension [".pdf",".aux"] ==> \(_,c) ->    pdflatexBibtex c---_lhs2TeX i o = do-  system ["lhs2TeX","-o",o,i]--lhs2tex c = do-  let lhs = c ++ ".lhs"-      tex = c ++ ".tex"-  produce tex $ do-    need lhs-    _lhs2TeX lhs tex+-}  tex_lhs = extension ".tex" ==> \(_,c) -> lhs2tex c  allRules = tex_markdown_standalone -         <|> pdf_tex_biblatex+--         <|> pdf_tex_bibtex          <|> tex_lhs

@@ -1,5 +1,5 @@ name:           cake-version:        0.4.2.0+version:        1.0.0 category:       Development synopsis:       A build-system library and driver description:@@ -21,13 +21,13 @@   build-depends: filepath==1.3.*     build-depends: process==1.1.*   build-depends: binary==0.5.*-  build-depends: containers==0.5.*+  build-depends: containers>=0.4 && <0.6   build-depends: directory==1.2.*-  build-depends: bytestring==0.10.*+  build-depends: bytestring>=0.9&&<1   build-depends: pureMD5==2.1.*   build-depends: split==0.1.* -  exposed-modules: Cake, Cake.Core, Cake.Rules, Cake.Process, Cake.Marxup, Parsek+  exposed-modules: Cake, Cake.Actions, Cake.Core, Cake.Rules, Cake.Process, Cake.Marxup, Parsek  executable cake   default-language: Haskell2010