CodeExtract.hs

{-# LANGUAGE PatternGuards #-}
module Main where

import Text.Pandoc.Definition
import Text.Pandoc.Generic
import Text.Pandoc.Readers.Markdown
import Text.Pandoc.Templates
import System.Environment
import System.FilePath
import qualified Data.Set as S
import qualified Data.Map as M
import Data.IORef
import System.IO
import Data.Default

main = do args <- getArgs
 case args of
 [file] -> do f <- readFile file
 let p = readMarkdown def f
 process p
 _ -> error usage

usage = "usage: extract <file>"

process :: Pandoc -> IO ()
process p = do
 s <- newIORef S.empty
 m <- newIORef M.empty
 bottomUpM (extractCode s m) p
 t <- readIORef m
 M.foldrWithKey writeTemplate (return ()) t

writeTemplate templateF vars k
 = do template <- readFile templateF
 writeFile dest (renderTemplate vars template)
 k
 where
 (dest,_) = splitExtension templateF

extractCode :: IORef (S.Set String) -> IORef (M.Map String [(String,String)]) ->
 Block -> IO Block
extractCode r m b@(CodeBlock (id,cls,attrs) code)
 | Just fileName <- lookup "file" attrs =
 do s <- readIORef r
 if S.member fileName s
 then appendFile fileName (code ++ "\n")
 else do writeFile fileName (code ++ "\n")
 writeIORef r (S.insert fileName s)
 return b
 | Just template <- lookup "template" attrs,
 Just var <- lookup "var" attrs =
 do t <- readIORef m
 writeIORef m (M.insertWith (++) template [(var,code ++ "\n")] t)
 return b
extractCode r m b = return b