module Anansi.Tangle (tangle) where
import Prelude hiding (FilePath)
import Control.Monad.Trans (lift)
import qualified Control.Monad.State as S
import qualified Control.Monad.Writer as W
import qualified Data.Text.Lazy as TL
import qualified Data.Map as Map
import System.FilePath (FilePath)
import qualified System.FilePath.CurrentOS as FP
import Anansi.Types
import Anansi.Util
type ContentMap = Map.Map TL.Text [Content]
data TangleState = TangleState Position TL.Text ContentMap
type TangleT m a = W.WriterT TL.Text (S.StateT TangleState m) a
buildMacros :: [Block] -> ContentMap
buildMacros blocks = S.execState (mapM_ accumMacro blocks) Map.empty
accumMacro :: Block -> S.State ContentMap ()
accumMacro b = case b of
BlockText _ -> return ()
BlockFile _ _ -> return ()
BlockDefine name content -> do
macros <- S.get
S.put $ Map.insertWith (\new old -> old ++ new) name content macros
BlockOption _ _ -> return ()
buildFiles :: [Block] -> ContentMap
buildFiles blocks = S.execState (mapM_ accumFile blocks) Map.empty
accumFile :: Block -> S.State ContentMap ()
accumFile b = case b of
BlockText _ -> return ()
BlockDefine _ _ -> return ()
BlockFile name content -> do
let accum new old = old ++ new
files <- S.get
S.put $ Map.insertWith accum name content files
BlockOption _ _ -> return ()
tangle :: Monad m
=> (FilePath -> TL.Text -> m ())
-> Bool
-> [Block]
-> m ()
tangle writeFile' enableLine blocks = S.evalStateT (mapM_ putFile files) initState where
initState = (TangleState (Position "" 0) "" macros)
fileMap = buildFiles blocks
macros = buildMacros blocks
files = Map.toAscList fileMap
putFile (path, content) = do
text <- W.execWriterT (mapM_ (putContent enableLine) content)
lift $ writeFile' (FP.fromString (TL.unpack path)) text
putContent :: Monad m => Bool -> Content -> TangleT m ()
putContent enableLine (ContentText pos t) = do
TangleState _ indent _ <- S.get
putPosition enableLine pos
W.tell indent
W.tell t
W.tell "\n"
putContent enableLine (ContentMacro pos indent name) = addIndent putMacro where
addIndent m = do
TangleState lastPos old macros <- S.get
S.put $ TangleState lastPos (TL.append old indent) macros
void m
TangleState newPos _ _ <- S.get
S.put $ TangleState newPos old macros
putMacro = do
putPosition enableLine pos
lookupMacro name >>= mapM_ (putContent enableLine)
putPosition :: Monad m => Bool -> Position -> TangleT m ()
putPosition enableLine pos = do
TangleState lastPos indent macros <- S.get
let expectedPos = Position (positionFile lastPos) (positionLine lastPos + 1)
let filename = FP.toString (positionFile pos)
let line = if enableLine
then "\n#line " ++ show (positionLine pos) ++ " " ++ show filename ++ "\n"
else "\n"
S.put $ TangleState pos indent macros
if pos == expectedPos
then return ()
else W.tell $ TL.pack line
lookupMacro :: Monad m => TL.Text -> TangleT m [Content]
lookupMacro name = do
TangleState _ _ macros <- S.get
case Map.lookup name macros of
Nothing -> error $ "unknown macro: " ++ show name
Just content -> return content