cake-0.1.0: Cake/Rules.hs

module Cake.Rules 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 qualified Parsek
import Parsek (completeResults, parse, Parser)
import Data.List
import Data.List.Split

------------------------------------------------------
-- Patterns
extension :: String -> P (String,String)
extension s = do
  base <- Parsek.many Parsek.anyChar
  Parsek.string s
  return (base++s,base)

anyExtension :: [String] -> P (String,String)
anyExtension ss = foldr (<|>) empty (map extension ss)

---------------------------------------------------------
-- Actions
list :: FilePath -> String -> Act [String]
list dir ext = do
  Text xs <- query (Listing dir ext)
  return xs

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 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
  

tex_markdown_standalone = simple ".tex" ".markdown" $ \o i -> 
  pandoc i o ["--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]

pdflatexBibtex c = do
  let input = c ++ ".tex"
      aux1 = c ++ ".aux1"
      aux = c ++ ".aux"
      pdf = c ++ ".pdf"
  produce pdf $ do 
    produce aux1 $ needing [input] $ do _pdflatex c
                                        liftIO $ copyFile aux aux1
      
    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
    
    produce aux $ do
      produce (c ++ ".bbl") $ do
        -- Note that this does not depend on the actual tex file; only the list of bibs. (aux1)
        mapM_ need bibs
        use aux1
        cut $ _bibtex c
      cut $ _pdflatex c
    
    cut $ _pdflatex c

pdf_tex_bibtex = extension ".pdf" ==> \(_,c) -> pdflatexBibtex c


pdf_tex_biblatex = anyExtension [".pdf",".aux"] ==> \(_,c) -> do  
  let input = c ++ ".tex"
      aux = c ++ ".aux"
      pdf = c ++ ".pdf"
  produce pdf $ do 
    produce aux $ needing [input] $ _pdflatex c
      
    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
    
    produce (c ++ ".bbl") $ do
      -- Note that this does not depend on the actual tex file; only the list of bibs.
      mapM_ need bibs
      use aux
      cut $ _bibtex c

    cut $ _pdflatex c
    

allRules = tex_markdown_standalone <|> pdf_tex_biblatex