packages feed

anansi 0.2.1 → 0.2.1.1

raw patch · 23 files changed

+866/−841 lines, 23 filesdep +anansidep ~parsecdep ~text

Dependencies added: anansi

Dependency ranges changed: parsec, text

Files

− Anansi.hs 
@@ -1,43 +0,0 @@--- Copyright (C) 2010 John Millikin <jmillikin@gmail.com>--- --- This program is free software: you can redistribute it and/or modify--- it under the terms of the GNU General Public License as published by--- the Free Software Foundation, either version 3 of the License, or--- any later version.--- --- This program is distributed in the hope that it will be useful,--- but WITHOUT ANY WARRANTY; without even the implied warranty of--- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the--- GNU General Public License for more details.--- --- You should have received a copy of the GNU General Public License--- along with this program.  If not, see <http://www.gnu.org/licenses/>.--- -module Anansi-	( Block (..)-	, Content (..)-	, Position (..)-	-	, ParseError (..)-	, parseFile-	-	, Loom (..)-	, looms-	, loomDebug-	, loomHTML-	, loomLaTeX-	, loomNoWeb-	-	, tangle-	) where-import Anansi.Types-import Anansi.Loom-import Anansi.Loom.Debug-import Anansi.Loom.HTML-import Anansi.Loom.LaTeX-import Anansi.Loom.NoWeb-import Anansi.Parser-import Anansi.Tangle--looms :: [Loom]-looms = [loomDebug, loomHTML, loomLaTeX, loomNoWeb]
− Anansi/Loom.hs 
@@ -1,26 +0,0 @@--- Copyright (C) 2010 John Millikin <jmillikin@gmail.com>--- --- This program is free software: you can redistribute it and/or modify--- it under the terms of the GNU General Public License as published by--- the Free Software Foundation, either version 3 of the License, or--- any later version.--- --- This program is distributed in the hope that it will be useful,--- but WITHOUT ANY WARRANTY; without even the implied warranty of--- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the--- GNU General Public License for more details.--- --- You should have received a copy of the GNU General Public License--- along with this program.  If not, see <http://www.gnu.org/licenses/>.--- -module Anansi.Loom-	( Loom (..)-	) where-import Control.Monad.Writer-import Data.Text.Lazy (Text)-import Anansi.Types--data Loom = Loom-	{ loomName :: Text-	, loomWeave :: [Block] -> Writer Text ()-	}
− Anansi/Loom/Debug.hs 
@@ -1,28 +0,0 @@--- Copyright (C) 2010 John Millikin <jmillikin@gmail.com>--- --- This program is free software: you can redistribute it and/or modify--- it under the terms of the GNU General Public License as published by--- the Free Software Foundation, either version 3 of the License, or--- any later version.--- --- This program is distributed in the hope that it will be useful,--- but WITHOUT ANY WARRANTY; without even the implied warranty of--- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the--- GNU General Public License for more details.--- --- You should have received a copy of the GNU General Public License--- along with this program.  If not, see <http://www.gnu.org/licenses/>.--- -{-# LANGUAGE OverloadedStrings #-}-module Anansi.Loom.Debug (loomDebug) where-import Data.Text.Lazy (pack)-import Control.Monad (forM_)-import Control.Monad.Writer (tell)-import Anansi.Loom--loomDebug :: Loom-loomDebug = Loom "debug" $ \blocks -> do-	tell "\nweaving\n"-	tell "==========================\n"-	forM_ blocks $ \b -> do-		tell . pack $ show b ++ "\n"
− Anansi/Loom/HTML.hs 
@@ -1,54 +0,0 @@--- Copyright (C) 2010 John Millikin <jmillikin@gmail.com>--- --- This program is free software: you can redistribute it and/or modify--- it under the terms of the GNU General Public License as published by--- the Free Software Foundation, either version 3 of the License, or--- any later version.--- --- This program is distributed in the hope that it will be useful,--- but WITHOUT ANY WARRANTY; without even the implied warranty of--- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the--- GNU General Public License for more details.--- --- You should have received a copy of the GNU General Public License--- along with this program.  If not, see <http://www.gnu.org/licenses/>.--- -{-# LANGUAGE OverloadedStrings #-}-module Anansi.Loom.HTML (loomHTML) where-import qualified Data.Text.Lazy as TL-import Control.Monad (forM_)-import Control.Monad.Writer (tell)-import Anansi.Types-import Anansi.Loom--loomHTML :: Loom-loomHTML = Loom "html" $ mapM_ putBlock where-	putBlock b = case b of-		BlockText text -> tell text-		BlockFile path content -> let-			label = TL.concat ["<b>&#xBB; ", escape path, "</b>"]-			in putContent label content-		BlockDefine name content -> let-			label = TL.concat ["<b>&#xAB;", escape name, "&#xBB;</b>"]-			in putContent label content-	-	putContent label cs = do-		tell "<pre>"-		tell label-		tell "\n"-		forM_ cs $ \c -> case c of-			ContentText _ text -> tell . escape $ TL.append text "\n"-			ContentMacro _ indent name -> tell $ formatMacro indent name-		tell "</pre>"--formatMacro :: TL.Text -> TL.Text -> TL.Text-formatMacro indent name = TL.concat [indent, "<i>&#xAB;", escape name, "&#xBB;</i>\n"]--escape :: TL.Text -> TL.Text-escape = TL.concatMap $ \c -> case c of-	'&' -> "&amp;"-	'<' -> "&lt;"-	'>' -> "&gt;"-	'"' -> "&quot;"-	'\'' -> "&apos;"-	_ -> TL.singleton c
− Anansi/Loom/LaTeX.hs 
@@ -1,58 +0,0 @@--- Copyright (C) 2010 John Millikin <jmillikin@gmail.com>--- --- This program is free software: you can redistribute it and/or modify--- it under the terms of the GNU General Public License as published by--- the Free Software Foundation, either version 3 of the License, or--- any later version.--- --- This program is distributed in the hope that it will be useful,--- but WITHOUT ANY WARRANTY; without even the implied warranty of--- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the--- GNU General Public License for more details.--- --- You should have received a copy of the GNU General Public License--- along with this program.  If not, see <http://www.gnu.org/licenses/>.--- -{-# LANGUAGE OverloadedStrings #-}-module Anansi.Loom.LaTeX (loomLaTeX) where-import qualified Data.Text.Lazy as TL-import Control.Monad (forM_)-import Control.Monad.Writer (tell)-import Anansi.Types-import Anansi.Loom--loomLaTeX :: Loom-loomLaTeX = Loom "latex" $ mapM_ putBlock where-	putBlock b = case b of-		BlockText text -> tell text-		BlockFile path content -> do-			tell "\\begin{alltt}\n"-			tell "{\\bf\\(\\gg\\) "-			tell $ escape path-			tell "}\n"-			putContent content-			tell "\\end{alltt}\n"-			-		BlockDefine name content -> do-			tell "\\begin{alltt}\n"-			tell "{\\bf\\(\\ll\\)"-			tell $ escape name-			tell "\\(\\gg\\)}\n"-			putContent content-			tell "\\end{alltt}\n"-	-	putContent cs = forM_ cs $ \c -> case c of-		ContentText _ text -> tell . escape $ TL.append text "\n"-		ContentMacro _ indent name -> tell $ formatMacro indent name--formatMacro :: TL.Text -> TL.Text -> TL.Text-formatMacro indent name = TL.concat [escape indent, "|\\emph{", escape name, "}|\n"]--escape :: TL.Text -> TL.Text-escape = TL.concatMap $ \c -> case c of-	'\t' -> "        "-	'\\' -> "\\textbackslash{}"-	'{' -> "\\{"-	'}' -> "\\}"-	'_' -> "\\_"-	_ -> TL.singleton c
− Anansi/Loom/NoWeb.hs 
@@ -1,68 +0,0 @@--- Copyright (C) 2010 John Millikin <jmillikin@gmail.com>--- --- This program is free software: you can redistribute it and/or modify--- it under the terms of the GNU General Public License as published by--- the Free Software Foundation, either version 3 of the License, or--- any later version.--- --- This program is distributed in the hope that it will be useful,--- but WITHOUT ANY WARRANTY; without even the implied warranty of--- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the--- GNU General Public License for more details.--- --- You should have received a copy of the GNU General Public License--- along with this program.  If not, see <http://www.gnu.org/licenses/>.--- -{-# LANGUAGE OverloadedStrings #-}-module Anansi.Loom.NoWeb (loomNoWeb) where-import qualified Data.Text.Lazy as TL-import Control.Monad (forM_)-import Control.Monad.Writer (tell)-import Anansi.Types-import Anansi.Loom--loomNoWeb :: Loom-loomNoWeb = Loom "latex-noweb" $ mapM_ putBlock where-	putBlock b = case b of-		BlockText text -> tell text-		BlockFile path content -> do-			tell "\\nwbegincode{0}\\moddef{"-			tell $ escapeText path-			tell "}\\endmoddef\\nwstartdeflinemarkup\\nwenddeflinemarkup\n"-			putContent content-			tell "\\nwendcode{}\n"-			-		BlockDefine name content -> do-			tell "\\nwbegincode{0}\\moddef{"-			tell $ escapeText name-			tell "}\\endmoddef\\nwstartdeflinemarkup\\nwenddeflinemarkup\n"-			putContent content-			tell "\\nwendcode{}\n"-	-	putContent cs = forM_ cs $ \c -> case c of-		ContentText _ text -> tell . escapeCode $ TL.append text "\n"-		ContentMacro _ indent name -> tell $ formatMacro indent name--formatMacro :: TL.Text -> TL.Text -> TL.Text-formatMacro indent name = TL.concat [escapeCode indent, "\\LA{}", escapeText name, "\\RA{}\n"]--escapeCode :: TL.Text -> TL.Text-escapeCode = TL.concatMap $ \c -> case c of-	'\t' -> "        "-	'\\' -> "\\\\"-	'{' -> "\\{"-	'}' -> "\\}"-	'_' -> "\\_"-	_ -> TL.singleton c--escapeText :: TL.Text -> TL.Text-escapeText = TL.concatMap $ \c -> case c of-	'\t' -> "        "-	'\\' -> "\\\\"-	'{' -> "\\{"-	'}' -> "\\}"-	'_' -> "\\_"-	'<' -> "{$<$}"-	'>' -> "{$>$}"-	'$' -> "\\$"-	_ -> TL.singleton c
− Anansi/Parser.hs 
@@ -1,214 +0,0 @@--- Copyright (C) 2010 John Millikin <jmillikin@gmail.com>--- --- This program is free software: you can redistribute it and/or modify--- it under the terms of the GNU General Public License as published by--- the Free Software Foundation, either version 3 of the License, or--- any later version.--- --- This program is distributed in the hope that it will be useful,--- but WITHOUT ANY WARRANTY; without even the implied warranty of--- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the--- GNU General Public License for more details.--- --- You should have received a copy of the GNU General Public License--- along with this program.  If not, see <http://www.gnu.org/licenses/>.--- -{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE DeriveDataTypeable #-}-module Anansi.Parser-	( ParseError (..)-	, parseFile-	) where-import Prelude hiding (FilePath)-import Control.Applicative ((<|>), (<$>))-import Control.Monad.Trans (lift)-import qualified Control.Monad.State as S-import qualified Control.Exception as E-import Data.List (unfoldr)-import Data.Typeable (Typeable)-import qualified Text.Parsec as P-import qualified Data.ByteString as B-import qualified Data.Text as T-import qualified Data.Text.Encoding as TE-import qualified Data.Text.Lazy as TL-import qualified Data.Map as Map-import System.FilePath (replaceFileName)-import Anansi.Types-import Anansi.Util--data ParseError = ParseError-	{ parseErrorPosition :: Position-	, parseErrorMessage :: TL.Text-	}-	deriving (Show)---- too lazy to write proper error handling-data ParseExc = ParseExc ParseError-	deriving (Typeable, Show)--instance E.Exception ParseExc--data Command-	= CommandInclude TL.Text-	| CommandFile TL.Text-	| CommandDefine TL.Text-	| CommandColon-	| CommandEndBlock-	| CommandComment-	deriving (Show)--data Line-	= LineCommand Position Command-	| LineText Position TL.Text-	deriving (Show)--untilChar :: Char -> P.Parsec String u TL.Text-untilChar c = TL.pack <$> P.manyTill P.anyChar (P.try (P.char c))--getPosition :: Monad m => P.ParsecT s u m Position-getPosition = do-	pos <- P.getPosition-	return $ Position (TL.pack (P.sourceName pos)) (toInteger (P.sourceLine pos))--parseLines :: P.Parsec String u [Line]-parseLines = do-	lines' <- P.many parseLine-	P.eof-	return lines'--parseLine :: P.Parsec String u Line-parseLine = command <|> text where-	command = do-		P.char ':'-		pos <- getPosition-		LineCommand pos <$> parseCommand-	-	text = do-		pos <- getPosition-		line <- untilChar '\n'-		return . LineText pos $ TL.append line "\n"--parseCommand :: P.Parsec String u Command-parseCommand = parsed where-	string = P.try . P.string-	parsed = P.choice [file, include, define, colon, comment, endBlock]-	file = do-		string "file " <|> string "f "-		CommandFile <$> untilChar '\n'-	-	include = do-		string "include " <|> string "i "-		CommandInclude <$> untilChar '\n'-	-	define = do-		string "define " <|> string "d "-		-- TODO: verify no '|' in name-		CommandDefine <$> untilChar '\n'-	-	colon = do-		P.char ':'-		return $ CommandColon-	-	comment = do-		P.char '#'-		untilChar '\n'-		return $ CommandComment-	-	endBlock = do-		line <- untilChar '\n'-		if TL.all isSpace line-			then return $ CommandEndBlock-			else do-				pos <- getPosition-				let msg = TL.pack $ "unknown command: " ++ show (TL.append ":" line)-				E.throw $ ParseExc $ ParseError pos msg---- TODO: more unicode support-isSpace :: Char -> Bool-isSpace ' ' = True-isSpace '\t' = True-isSpace _ = False--parseBlocks :: [Line] -> Maybe (Either ParseError Block, [Line])-parseBlocks [] = Nothing-parseBlocks (line:xs) = parsed where-	parsed = case line of-		LineText _ text -> Just (Right $ BlockText text, xs)-		LineCommand pos cmd -> case cmd of-			CommandFile path -> parseContent pos (BlockFile path) xs-			CommandDefine name -> parseContent pos (BlockDefine name) xs-			CommandColon -> Just (Right $ BlockText ":", xs)-			CommandEndBlock -> Just (Right $ BlockText "\n", xs)-			CommandComment -> Just (Right $ BlockText "", xs)-			CommandInclude _ -> let-				msg = "unexpected CommandInclude (internal error)"-				in Just (Left $ ParseError pos msg, [])--parseContent :: Position -> ([Content] -> Block) -> [Line] -> Maybe (Either ParseError Block, [Line])-parseContent start block = parse [] where-	parse acc [] = Just (Right $ block acc, [])-	parse acc (line:xs) = case line of-		LineText pos text -> case parse' pos text of-			Left err -> Just (Left err, [])-			Right parsed -> parse (acc ++ [parsed]) xs-		LineCommand _ CommandEndBlock -> Just (Right $ block acc, xs)-		LineCommand _ _ -> let-			msg = "Unterminated content block"-			in Just (Left $ ParseError start msg, [])-	-	parse' pos text = case P.parse (parser pos) "" (TL.unpack text) of-		Right content -> Right content-		Left err -> let-			msg = TL.pack $ "Invalid content line " ++ show text ++ ": " ++ show err-			in Left $ ParseError pos msg-	-	parser pos = do-		content <- contentMacro pos <|> contentText pos-		P.optional $ P.char '\n'-		P.eof-		return content-	-	contentMacro pos = do-		(indent, c) <- P.try $ do-			indent <- P.many $ P.satisfy isSpace-			P.char '|'-			c <- P.satisfy (not . isSpace)-			return (indent, c)-		name <- untilChar '|'-		return $ ContentMacro pos (TL.pack indent) (TL.strip (TL.cons c name))-	-	contentText pos = do-		text <- untilChar '\n'-		return . ContentText pos $ text--type FilePath = TL.Text-type FileMap = Map.Map FilePath [Line]--genLines :: Monad m => (FilePath -> m [Line]) -> FilePath -> S.StateT FileMap m [Line]-genLines getLines = genLines' where-	genLines' path = lift (getLines path) >>= concatMapM (resolveIncludes path)-	-	relative x y = TL.pack $ replaceFileName (TL.unpack x) (TL.unpack y)-	-	resolveIncludes root line = case line of-		LineCommand _ (CommandInclude path) -> genLines' $ relative root path-		_ -> return [line]--parseFile :: TL.Text -> IO (Either ParseError [Block])-parseFile root = io where-	io = E.handle onError $ do-		lines' <- S.evalStateT (genLines getLines root) Map.empty-		return . catEithers $ unfoldr parseBlocks lines'-	-	onError (ParseExc err) = return $ Left err-	-	getLines :: FilePath -> IO [Line]-	getLines path = do-		-- TODO: encode 'path' into UTF-8?-		let path' = TL.unpack path-		bytes <- B.readFile path'-		case P.parse parseLines path' (T.unpack $ TE.decodeUtf8 bytes) of-			Right x -> return x-			Left err -> let-				msg = TL.pack $ "getLines parse failed (internal error): " ++ show err-				in E.throw $ ParseExc $ ParseError (Position path 0) msg
− Anansi/Tangle.hs 
@@ -1,103 +0,0 @@--- Copyright (C) 2010 John Millikin <jmillikin@gmail.com>--- --- This program is free software: you can redistribute it and/or modify--- it under the terms of the GNU General Public License as published by--- the Free Software Foundation, either version 3 of the License, or--- any later version.--- --- This program is distributed in the hope that it will be useful,--- but WITHOUT ANY WARRANTY; without even the implied warranty of--- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the--- GNU General Public License for more details.--- --- You should have received a copy of the GNU General Public License--- along with this program.  If not, see <http://www.gnu.org/licenses/>.--- -{-# LANGUAGE OverloadedStrings #-}-module Anansi.Tangle (tangle) where-import Control.Monad (when)-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 Anansi.Types--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--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--tangle :: Monad m-       => (TL.Text -> TL.Text -> m ())-       -> Bool -- ^ Enable writing #line declarations-       -> [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' path text--putContent :: Monad m => Bool -> Content -> TangleT m ()-putContent enableLine (ContentText pos t) = do-	TangleState _ indent _ <- S.get-	when enableLine $ putPosition 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-		m-		TangleState newPos _ _ <- S.get-		S.put $ TangleState newPos old macros-	putMacro = do-		when enableLine $ putPosition pos-		lookupMacro name >>= mapM_ (putContent enableLine)--putPosition :: Monad m => Position -> TangleT m ()-putPosition pos = do-	TangleState lastPos indent macros <- S.get-	let expectedPos = Position (positionFile lastPos) (positionLine lastPos + 1)-	let line = "\n#line " ++ show (positionLine pos) ++ " " ++ show (positionFile pos) ++ "\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
− Anansi/Types.hs 
@@ -1,38 +0,0 @@--- Copyright (C) 2010 John Millikin <jmillikin@gmail.com>--- --- This program is free software: you can redistribute it and/or modify--- it under the terms of the GNU General Public License as published by--- the Free Software Foundation, either version 3 of the License, or--- any later version.--- --- This program is distributed in the hope that it will be useful,--- but WITHOUT ANY WARRANTY; without even the implied warranty of--- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the--- GNU General Public License for more details.--- --- You should have received a copy of the GNU General Public License--- along with this program.  If not, see <http://www.gnu.org/licenses/>.--- -module Anansi.Types-	( Block (..)-	, Content (..)-	, Position (..)-	) where-import Data.Text.Lazy (Text)--data Block-	= BlockText Text-	| BlockFile Text [Content]-	| BlockDefine Text [Content]-	deriving (Show)--data Content-	= ContentText Position Text-	| ContentMacro Position Text Text-	deriving (Show)--data Position = Position-	{ positionFile :: Text-	, positionLine :: Integer-	}-	deriving (Show, Eq)
− Anansi/Util.hs 
@@ -1,36 +0,0 @@--- Copyright (C) 2010 John Millikin <jmillikin@gmail.com>--- --- This program is free software: you can redistribute it and/or modify--- it under the terms of the GNU General Public License as published by--- the Free Software Foundation, either version 3 of the License, or--- any later version.--- --- This program is distributed in the hope that it will be useful,--- but WITHOUT ANY WARRANTY; without even the implied warranty of--- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the--- GNU General Public License for more details.--- --- You should have received a copy of the GNU General Public License--- along with this program.  If not, see <http://www.gnu.org/licenses/>.--- -module Anansi.Util-	( concatMapM-	, replace-	, catEithers-	) where-import Control.Monad (liftM)--concatMapM :: Monad m => (a -> m [b]) -> [a] -> m [b]-concatMapM f xs = liftM concat $ mapM f xs--replace :: Eq a => a -> [a] -> [a] -> [a]-replace from to xs = flip concatMap xs $ \x -> if x == from-	then to-	else [x]--catEithers :: [Either e a] -> Either e [a]-catEithers = cat' [] where-	cat' acc [] = Right $ reverse acc-	cat' acc (e:es) = case e of-		Left err -> Left err-		Right x -> cat' (x : acc) es
− Main.hs 
@@ -1,167 +0,0 @@--- Copyright (C) 2010 John Millikin <jmillikin@gmail.com>--- --- This program is free software: you can redistribute it and/or modify--- it under the terms of the GNU General Public License as published by--- the Free Software Foundation, either version 3 of the License, or--- any later version.--- --- This program is distributed in the hope that it will be useful,--- but WITHOUT ANY WARRANTY; without even the implied warranty of--- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the--- GNU General Public License for more details.--- --- You should have received a copy of the GNU General Public License--- along with this program.  If not, see <http://www.gnu.org/licenses/>.--- -{-# LANGUAGE OverloadedStrings #-}-module Main (main) where--import Anansi-import Anansi.Util--import Control.Monad (unless)-import Control.Monad.Writer-import Control.Monad.Trans (MonadIO, liftIO)-import qualified Data.Text.Lazy as TL-import qualified Data.Text.Lazy.IO as TLIO-import Data.Text.Lazy.Encoding (encodeUtf8)-import qualified Data.ByteString.Lazy as BL--import System.Console.GetOpt-import System.Directory-import System.Environment-import System.Exit-import System.FilePath-import System.IO hiding (withFile)--data Output = Tangle | Weave--data Option-	= OptionOutput Output-	| OptionOutputPath TL.Text-	| OptionLoom TL.Text-	| OptionNoLines--optionInfo :: [OptDescr Option]-optionInfo =-	[ Option ['t'] ["tangle"] (NoArg (OptionOutput Tangle))-	  "Generate tangled source code (default)"-	, Option ['w'] ["weave"] (NoArg (OptionOutput Weave))-	  "Generate woven markup"-	, Option ['o'] ["out", "output"] (ReqArg (OptionOutputPath . TL.pack) "PATH")-	  "Output path (directory for tangle, file for weave)"-	, Option ['l'] ["loom"] (ReqArg (OptionLoom . TL.pack) "NAME")-	  "Which loom should be used to weave output"-	, Option [] ["noline"] (NoArg OptionNoLines)-	  "Disable generating #line declarations in tangled code"-	]--usage :: String -> String-usage name = "Usage: " ++ name ++ " [OPTION...]"--getOutput :: [Option] -> Output-getOutput [] = Tangle-getOutput (x:xs) = case x of-	OptionOutput o -> o-	_ -> getOutput xs--getPath :: [Option] -> TL.Text-getPath [] = ""-getPath (x:xs) = case x of-	OptionOutputPath p -> p-	_ -> getPath xs--withFile :: TL.Text -> (Handle -> IO a) -> IO a-withFile path io = case path of-	"" -> io stdout-	_ -> withBinaryFile (TL.unpack path) WriteMode io--loomMap :: [(TL.Text, Loom)]-loomMap = [(loomName l, l) | l <- looms]--getLoom :: [Option] -> Loom-getLoom [] = loomLaTeX-getLoom (x:xs) = case x of-	OptionLoom name -> case lookup name loomMap of-		Just loom -> loom-		Nothing -> error $ "Unknown loom: " ++ show name-	_ -> getLoom xs--getEnableLines :: [Option] -> Bool-getEnableLines [] = True-getEnableLines (x:xs) = case x of-	OptionNoLines -> False-	_ -> getEnableLines xs--main :: IO ()-main = do-	args <- getArgs-	let (options, inputs, errors) = getOpt Permute optionInfo args-	unless (null errors) $ do-		name <- getProgName-		hPutStrLn stderr $ concat errors-		hPutStrLn stderr $ usageInfo (usage name) optionInfo-		exitFailure-	-	let path = getPath options-	let loom = getLoom options-	let enableLines = getEnableLines options-	-	parsed <- parseInputs inputs-	case parsed of-		Left err -> do-			hPutStrLn stderr (formatError err)-			exitFailure-		Right blocks -> case getOutput options of-			Tangle -> case path of-				"" -> tangle debugTangle enableLines blocks-				_ -> tangle (realTangle path) enableLines blocks-			Weave -> let-				texts = execWriter $ loomWeave loom blocks-				in withFile path $ \h -> BL.hPut h $ encodeUtf8 texts--debugTangle :: TL.Text -> TL.Text -> IO ()-debugTangle path text = do-	putStr "\n"-	TLIO.putStrLn path-	putStrLn $ replicate (fromIntegral (TL.length path)) '='-	TLIO.putStr text--realTangle :: TL.Text -> TL.Text -> TL.Text -> IO ()-realTangle root path text = do-	let fullpath = combine (TL.unpack root) (TL.unpack path)-	createDirectoryIfMissing True $ takeDirectory fullpath-	let bytes = encodeUtf8 text-	withBinaryFile fullpath ReadWriteMode $ \h -> do-		equal <- fileContentsEqual h bytes-		unless equal $ do-			hSetFileSize h 0-			BL.hPut h bytes--fileContentsEqual :: Handle -> BL.ByteString -> IO Bool-fileContentsEqual h bytes = do-	hSeek h SeekFromEnd 0-	size <- hTell h-	hSeek h AbsoluteSeek 0-	-	if size /= toInteger (BL.length bytes)-		then return False-		else do-			-- FIXME: 'Int' overflow?-			contents <- BL.hGet h (fromInteger size)-			hSeek h AbsoluteSeek 0-			return $ bytes == contents--parseInputs :: [String] -> IO (Either ParseError [Block])-parseInputs inputs = do-	eithers <- mapM (parseFile . TL.pack) inputs-	return $ case catEithers eithers of-		Left err -> Left err-		Right bs -> Right $ concat bs--formatError :: ParseError -> String-formatError err = concat [filename, ":", line, ": error: ", message] where-	pos = parseErrorPosition err-	filename = TL.unpack $ positionFile pos-	line = show $ positionLine pos-	message = TL.unpack $ parseErrorMessage err
anansi.cabal view
@@ -1,12 +1,12 @@ name: anansi-version: 0.2.1+version: 0.2.1.1 synopsis: Simple literate programming preprocessor license: GPL-3 license-file: license.txt author: John Millikin maintainer: jmillikin@gmail.com build-type: Simple-cabal-version: >=1.6+cabal-version: >=1.8 category: Development stability: experimental bug-reports: mailto:jmillikin@gmail.com@@ -18,17 +18,22 @@   location: http://john-millikin.com/software/anansi/  library-  ghc-options: -Wall -fno-warn-unused-do-bind+  hs-source-dirs: lib +  if true+    ghc-options: -Wall++  if impl(ghc >= 6.11)+    ghc-options: -fno-warn-unused-do-bind+   build-depends:       base >=4.0 && < 5.0-    , parsec >= 3.0 && < 4+    , parsec >= 3.0 && < 3.2     , bytestring >= 0.9 && < 0.10-    , text >= 0.7 && < 0.10+    , text >= 0.7 && < 0.11     , monads-tf >= 0.1 && < 0.2     , containers >= 0.1 && < 0.4     , filepath >= 1.1 && < 1.2-    , directory >= 1.0 && < 1.1    exposed-modules:     Anansi@@ -45,4 +50,20 @@     Anansi.Util  executable anansi+  hs-source-dirs: src   main-is: Main.hs++  if true+    ghc-options: -Wall++  if impl(ghc >= 6.11)+    ghc-options: -fno-warn-unused-do-bind++  build-depends:+      base >=4.0 && < 5.0+    , bytestring >= 0.9 && < 0.10+    , text >= 0.7 && < 0.11+    , monads-tf >= 0.1 && < 0.2+    , filepath >= 1.1 && < 1.2+    , directory >= 1.0 && < 1.1+    , anansi
+ lib/Anansi.hs view
@@ -0,0 +1,43 @@+-- Copyright (C) 2010 John Millikin <jmillikin@gmail.com>+-- +-- This program is free software: you can redistribute it and/or modify+-- it under the terms of the GNU General Public License as published by+-- the Free Software Foundation, either version 3 of the License, or+-- any later version.+-- +-- This program is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the+-- GNU General Public License for more details.+-- +-- You should have received a copy of the GNU General Public License+-- along with this program.  If not, see <http://www.gnu.org/licenses/>.+-- +module Anansi+	( Block (..)+	, Content (..)+	, Position (..)+	+	, ParseError (..)+	, parseFile+	+	, Loom (..)+	, looms+	, loomDebug+	, loomHTML+	, loomLaTeX+	, loomNoWeb+	+	, tangle+	) where+import Anansi.Types+import Anansi.Loom+import Anansi.Loom.Debug+import Anansi.Loom.HTML+import Anansi.Loom.LaTeX+import Anansi.Loom.NoWeb+import Anansi.Parser+import Anansi.Tangle++looms :: [Loom]+looms = [loomDebug, loomHTML, loomLaTeX, loomNoWeb]
+ lib/Anansi/Loom.hs view
@@ -0,0 +1,26 @@+-- Copyright (C) 2010 John Millikin <jmillikin@gmail.com>+-- +-- This program is free software: you can redistribute it and/or modify+-- it under the terms of the GNU General Public License as published by+-- the Free Software Foundation, either version 3 of the License, or+-- any later version.+-- +-- This program is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the+-- GNU General Public License for more details.+-- +-- You should have received a copy of the GNU General Public License+-- along with this program.  If not, see <http://www.gnu.org/licenses/>.+-- +module Anansi.Loom+	( Loom (..)+	) where+import Control.Monad.Writer+import Data.Text.Lazy (Text)+import Anansi.Types++data Loom = Loom+	{ loomName :: Text+	, loomWeave :: [Block] -> Writer Text ()+	}
+ lib/Anansi/Loom/Debug.hs view
@@ -0,0 +1,28 @@+-- Copyright (C) 2010 John Millikin <jmillikin@gmail.com>+-- +-- This program is free software: you can redistribute it and/or modify+-- it under the terms of the GNU General Public License as published by+-- the Free Software Foundation, either version 3 of the License, or+-- any later version.+-- +-- This program is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the+-- GNU General Public License for more details.+-- +-- You should have received a copy of the GNU General Public License+-- along with this program.  If not, see <http://www.gnu.org/licenses/>.+-- +{-# LANGUAGE OverloadedStrings #-}+module Anansi.Loom.Debug (loomDebug) where+import Data.Text.Lazy (pack)+import Control.Monad (forM_)+import Control.Monad.Writer (tell)+import Anansi.Loom++loomDebug :: Loom+loomDebug = Loom "debug" $ \blocks -> do+	tell "\nweaving\n"+	tell "==========================\n"+	forM_ blocks $ \b -> do+		tell . pack $ show b ++ "\n"
+ lib/Anansi/Loom/HTML.hs view
@@ -0,0 +1,54 @@+-- Copyright (C) 2010 John Millikin <jmillikin@gmail.com>+-- +-- This program is free software: you can redistribute it and/or modify+-- it under the terms of the GNU General Public License as published by+-- the Free Software Foundation, either version 3 of the License, or+-- any later version.+-- +-- This program is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the+-- GNU General Public License for more details.+-- +-- You should have received a copy of the GNU General Public License+-- along with this program.  If not, see <http://www.gnu.org/licenses/>.+-- +{-# LANGUAGE OverloadedStrings #-}+module Anansi.Loom.HTML (loomHTML) where+import qualified Data.Text.Lazy as TL+import Control.Monad (forM_)+import Control.Monad.Writer (tell)+import Anansi.Types+import Anansi.Loom++loomHTML :: Loom+loomHTML = Loom "html" $ mapM_ putBlock where+	putBlock b = case b of+		BlockText text -> tell text+		BlockFile path content -> let+			label = TL.concat ["<b>&#xBB; ", escape path, "</b>"]+			in putContent label content+		BlockDefine name content -> let+			label = TL.concat ["<b>&#xAB;", escape name, "&#xBB;</b>"]+			in putContent label content+	+	putContent label cs = do+		tell "<pre>"+		tell label+		tell "\n"+		forM_ cs $ \c -> case c of+			ContentText _ text -> tell . escape $ TL.append text "\n"+			ContentMacro _ indent name -> tell $ formatMacro indent name+		tell "</pre>"++formatMacro :: TL.Text -> TL.Text -> TL.Text+formatMacro indent name = TL.concat [indent, "<i>&#xAB;", escape name, "&#xBB;</i>\n"]++escape :: TL.Text -> TL.Text+escape = TL.concatMap $ \c -> case c of+	'&' -> "&amp;"+	'<' -> "&lt;"+	'>' -> "&gt;"+	'"' -> "&quot;"+	'\'' -> "&apos;"+	_ -> TL.singleton c
+ lib/Anansi/Loom/LaTeX.hs view
@@ -0,0 +1,58 @@+-- Copyright (C) 2010 John Millikin <jmillikin@gmail.com>+-- +-- This program is free software: you can redistribute it and/or modify+-- it under the terms of the GNU General Public License as published by+-- the Free Software Foundation, either version 3 of the License, or+-- any later version.+-- +-- This program is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the+-- GNU General Public License for more details.+-- +-- You should have received a copy of the GNU General Public License+-- along with this program.  If not, see <http://www.gnu.org/licenses/>.+-- +{-# LANGUAGE OverloadedStrings #-}+module Anansi.Loom.LaTeX (loomLaTeX) where+import qualified Data.Text.Lazy as TL+import Control.Monad (forM_)+import Control.Monad.Writer (tell)+import Anansi.Types+import Anansi.Loom++loomLaTeX :: Loom+loomLaTeX = Loom "latex" $ mapM_ putBlock where+	putBlock b = case b of+		BlockText text -> tell text+		BlockFile path content -> do+			tell "\\begin{alltt}\n"+			tell "{\\bf\\(\\gg\\) "+			tell $ escape path+			tell "}\n"+			putContent content+			tell "\\end{alltt}\n"+			+		BlockDefine name content -> do+			tell "\\begin{alltt}\n"+			tell "{\\bf\\(\\ll\\)"+			tell $ escape name+			tell "\\(\\gg\\)}\n"+			putContent content+			tell "\\end{alltt}\n"+	+	putContent cs = forM_ cs $ \c -> case c of+		ContentText _ text -> tell . escape $ TL.append text "\n"+		ContentMacro _ indent name -> tell $ formatMacro indent name++formatMacro :: TL.Text -> TL.Text -> TL.Text+formatMacro indent name = TL.concat [escape indent, "|\\emph{", escape name, "}|\n"]++escape :: TL.Text -> TL.Text+escape = TL.concatMap $ \c -> case c of+	'\t' -> "        "+	'\\' -> "\\textbackslash{}"+	'{' -> "\\{"+	'}' -> "\\}"+	'_' -> "\\_"+	_ -> TL.singleton c
+ lib/Anansi/Loom/NoWeb.hs view
@@ -0,0 +1,68 @@+-- Copyright (C) 2010 John Millikin <jmillikin@gmail.com>+-- +-- This program is free software: you can redistribute it and/or modify+-- it under the terms of the GNU General Public License as published by+-- the Free Software Foundation, either version 3 of the License, or+-- any later version.+-- +-- This program is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the+-- GNU General Public License for more details.+-- +-- You should have received a copy of the GNU General Public License+-- along with this program.  If not, see <http://www.gnu.org/licenses/>.+-- +{-# LANGUAGE OverloadedStrings #-}+module Anansi.Loom.NoWeb (loomNoWeb) where+import qualified Data.Text.Lazy as TL+import Control.Monad (forM_)+import Control.Monad.Writer (tell)+import Anansi.Types+import Anansi.Loom++loomNoWeb :: Loom+loomNoWeb = Loom "latex-noweb" $ mapM_ putBlock where+	putBlock b = case b of+		BlockText text -> tell text+		BlockFile path content -> do+			tell "\\nwbegincode{0}\\moddef{"+			tell $ escapeText path+			tell "}\\endmoddef\\nwstartdeflinemarkup\\nwenddeflinemarkup\n"+			putContent content+			tell "\\nwendcode{}\n"+			+		BlockDefine name content -> do+			tell "\\nwbegincode{0}\\moddef{"+			tell $ escapeText name+			tell "}\\endmoddef\\nwstartdeflinemarkup\\nwenddeflinemarkup\n"+			putContent content+			tell "\\nwendcode{}\n"+	+	putContent cs = forM_ cs $ \c -> case c of+		ContentText _ text -> tell . escapeCode $ TL.append text "\n"+		ContentMacro _ indent name -> tell $ formatMacro indent name++formatMacro :: TL.Text -> TL.Text -> TL.Text+formatMacro indent name = TL.concat [escapeCode indent, "\\LA{}", escapeText name, "\\RA{}\n"]++escapeCode :: TL.Text -> TL.Text+escapeCode = TL.concatMap $ \c -> case c of+	'\t' -> "        "+	'\\' -> "\\\\"+	'{' -> "\\{"+	'}' -> "\\}"+	'_' -> "\\_"+	_ -> TL.singleton c++escapeText :: TL.Text -> TL.Text+escapeText = TL.concatMap $ \c -> case c of+	'\t' -> "        "+	'\\' -> "\\\\"+	'{' -> "\\{"+	'}' -> "\\}"+	'_' -> "\\_"+	'<' -> "{$<$}"+	'>' -> "{$>$}"+	'$' -> "\\$"+	_ -> TL.singleton c
+ lib/Anansi/Parser.hs view
@@ -0,0 +1,214 @@+-- Copyright (C) 2010 John Millikin <jmillikin@gmail.com>+-- +-- This program is free software: you can redistribute it and/or modify+-- it under the terms of the GNU General Public License as published by+-- the Free Software Foundation, either version 3 of the License, or+-- any later version.+-- +-- This program is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the+-- GNU General Public License for more details.+-- +-- You should have received a copy of the GNU General Public License+-- along with this program.  If not, see <http://www.gnu.org/licenses/>.+-- +{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable #-}+module Anansi.Parser+	( ParseError (..)+	, parseFile+	) where+import Prelude hiding (FilePath)+import Control.Applicative ((<|>), (<$>))+import Control.Monad.Trans (lift)+import qualified Control.Monad.State as S+import qualified Control.Exception as E+import Data.List (unfoldr)+import Data.Typeable (Typeable)+import qualified Text.Parsec as P+import qualified Data.ByteString as B+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import qualified Data.Text.Lazy as TL+import qualified Data.Map as Map+import System.FilePath (replaceFileName)+import Anansi.Types+import Anansi.Util++data ParseError = ParseError+	{ parseErrorPosition :: Position+	, parseErrorMessage :: TL.Text+	}+	deriving (Show)++-- too lazy to write proper error handling+data ParseExc = ParseExc ParseError+	deriving (Typeable, Show)++instance E.Exception ParseExc++data Command+	= CommandInclude TL.Text+	| CommandFile TL.Text+	| CommandDefine TL.Text+	| CommandColon+	| CommandEndBlock+	| CommandComment+	deriving (Show)++data Line+	= LineCommand Position Command+	| LineText Position TL.Text+	deriving (Show)++untilChar :: Char -> P.Parsec String u TL.Text+untilChar c = TL.pack <$> P.manyTill P.anyChar (P.try (P.char c))++getPosition :: Monad m => P.ParsecT s u m Position+getPosition = do+	pos <- P.getPosition+	return $ Position (TL.pack (P.sourceName pos)) (toInteger (P.sourceLine pos))++parseLines :: P.Parsec String u [Line]+parseLines = do+	lines' <- P.many parseLine+	P.eof+	return lines'++parseLine :: P.Parsec String u Line+parseLine = command <|> text where+	command = do+		P.char ':'+		pos <- getPosition+		LineCommand pos <$> parseCommand+	+	text = do+		pos <- getPosition+		line <- untilChar '\n'+		return . LineText pos $ TL.append line "\n"++parseCommand :: P.Parsec String u Command+parseCommand = parsed where+	string = P.try . P.string+	parsed = P.choice [file, include, define, colon, comment, endBlock]+	file = do+		string "file " <|> string "f "+		CommandFile <$> untilChar '\n'+	+	include = do+		string "include " <|> string "i "+		CommandInclude <$> untilChar '\n'+	+	define = do+		string "define " <|> string "d "+		-- TODO: verify no '|' in name+		CommandDefine <$> untilChar '\n'+	+	colon = do+		P.char ':'+		return $ CommandColon+	+	comment = do+		P.char '#'+		untilChar '\n'+		return $ CommandComment+	+	endBlock = do+		line <- untilChar '\n'+		if TL.all isSpace line+			then return $ CommandEndBlock+			else do+				pos <- getPosition+				let msg = TL.pack $ "unknown command: " ++ show (TL.append ":" line)+				E.throw $ ParseExc $ ParseError pos msg++-- TODO: more unicode support+isSpace :: Char -> Bool+isSpace ' ' = True+isSpace '\t' = True+isSpace _ = False++parseBlocks :: [Line] -> Maybe (Either ParseError Block, [Line])+parseBlocks [] = Nothing+parseBlocks (line:xs) = parsed where+	parsed = case line of+		LineText _ text -> Just (Right $ BlockText text, xs)+		LineCommand pos cmd -> case cmd of+			CommandFile path -> parseContent pos (BlockFile path) xs+			CommandDefine name -> parseContent pos (BlockDefine name) xs+			CommandColon -> Just (Right $ BlockText ":", xs)+			CommandEndBlock -> Just (Right $ BlockText "\n", xs)+			CommandComment -> Just (Right $ BlockText "", xs)+			CommandInclude _ -> let+				msg = "unexpected CommandInclude (internal error)"+				in Just (Left $ ParseError pos msg, [])++parseContent :: Position -> ([Content] -> Block) -> [Line] -> Maybe (Either ParseError Block, [Line])+parseContent start block = parse [] where+	parse acc [] = Just (Right $ block acc, [])+	parse acc (line:xs) = case line of+		LineText pos text -> case parse' pos text of+			Left err -> Just (Left err, [])+			Right parsed -> parse (acc ++ [parsed]) xs+		LineCommand _ CommandEndBlock -> Just (Right $ block acc, xs)+		LineCommand _ _ -> let+			msg = "Unterminated content block"+			in Just (Left $ ParseError start msg, [])+	+	parse' pos text = case P.parse (parser pos) "" (TL.unpack text) of+		Right content -> Right content+		Left err -> let+			msg = TL.pack $ "Invalid content line " ++ show text ++ ": " ++ show err+			in Left $ ParseError pos msg+	+	parser pos = do+		content <- contentMacro pos <|> contentText pos+		P.optional $ P.char '\n'+		P.eof+		return content+	+	contentMacro pos = do+		(indent, c) <- P.try $ do+			indent <- P.many $ P.satisfy isSpace+			P.char '|'+			c <- P.satisfy (not . isSpace)+			return (indent, c)+		name <- untilChar '|'+		return $ ContentMacro pos (TL.pack indent) (TL.strip (TL.cons c name))+	+	contentText pos = do+		text <- untilChar '\n'+		return . ContentText pos $ text++type FilePath = TL.Text+type FileMap = Map.Map FilePath [Line]++genLines :: Monad m => (FilePath -> m [Line]) -> FilePath -> S.StateT FileMap m [Line]+genLines getLines = genLines' where+	genLines' path = lift (getLines path) >>= concatMapM (resolveIncludes path)+	+	relative x y = TL.pack $ replaceFileName (TL.unpack x) (TL.unpack y)+	+	resolveIncludes root line = case line of+		LineCommand _ (CommandInclude path) -> genLines' $ relative root path+		_ -> return [line]++parseFile :: TL.Text -> IO (Either ParseError [Block])+parseFile root = io where+	io = E.handle onError $ do+		lines' <- S.evalStateT (genLines getLines root) Map.empty+		return . catEithers $ unfoldr parseBlocks lines'+	+	onError (ParseExc err) = return $ Left err+	+	getLines :: FilePath -> IO [Line]+	getLines path = do+		-- TODO: encode 'path' into UTF-8?+		let path' = TL.unpack path+		bytes <- B.readFile path'+		case P.parse parseLines path' (T.unpack $ TE.decodeUtf8 bytes) of+			Right x -> return x+			Left err -> let+				msg = TL.pack $ "getLines parse failed (internal error): " ++ show err+				in E.throw $ ParseExc $ ParseError (Position path 0) msg
+ lib/Anansi/Tangle.hs view
@@ -0,0 +1,103 @@+-- Copyright (C) 2010 John Millikin <jmillikin@gmail.com>+-- +-- This program is free software: you can redistribute it and/or modify+-- it under the terms of the GNU General Public License as published by+-- the Free Software Foundation, either version 3 of the License, or+-- any later version.+-- +-- This program is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the+-- GNU General Public License for more details.+-- +-- You should have received a copy of the GNU General Public License+-- along with this program.  If not, see <http://www.gnu.org/licenses/>.+-- +{-# LANGUAGE OverloadedStrings #-}+module Anansi.Tangle (tangle) where+import Control.Monad (when)+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 Anansi.Types++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++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++tangle :: Monad m+       => (TL.Text -> TL.Text -> m ())+       -> Bool -- ^ Enable writing #line declarations+       -> [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' path text++putContent :: Monad m => Bool -> Content -> TangleT m ()+putContent enableLine (ContentText pos t) = do+	TangleState _ indent _ <- S.get+	when enableLine $ putPosition 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+		m+		TangleState newPos _ _ <- S.get+		S.put $ TangleState newPos old macros+	putMacro = do+		when enableLine $ putPosition pos+		lookupMacro name >>= mapM_ (putContent enableLine)++putPosition :: Monad m => Position -> TangleT m ()+putPosition pos = do+	TangleState lastPos indent macros <- S.get+	let expectedPos = Position (positionFile lastPos) (positionLine lastPos + 1)+	let line = "\n#line " ++ show (positionLine pos) ++ " " ++ show (positionFile pos) ++ "\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
+ lib/Anansi/Types.hs view
@@ -0,0 +1,38 @@+-- Copyright (C) 2010 John Millikin <jmillikin@gmail.com>+-- +-- This program is free software: you can redistribute it and/or modify+-- it under the terms of the GNU General Public License as published by+-- the Free Software Foundation, either version 3 of the License, or+-- any later version.+-- +-- This program is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the+-- GNU General Public License for more details.+-- +-- You should have received a copy of the GNU General Public License+-- along with this program.  If not, see <http://www.gnu.org/licenses/>.+-- +module Anansi.Types+	( Block (..)+	, Content (..)+	, Position (..)+	) where+import Data.Text.Lazy (Text)++data Block+	= BlockText Text+	| BlockFile Text [Content]+	| BlockDefine Text [Content]+	deriving (Show)++data Content+	= ContentText Position Text+	| ContentMacro Position Text Text+	deriving (Show)++data Position = Position+	{ positionFile :: Text+	, positionLine :: Integer+	}+	deriving (Show, Eq)
+ lib/Anansi/Util.hs view
@@ -0,0 +1,36 @@+-- Copyright (C) 2010 John Millikin <jmillikin@gmail.com>+-- +-- This program is free software: you can redistribute it and/or modify+-- it under the terms of the GNU General Public License as published by+-- the Free Software Foundation, either version 3 of the License, or+-- any later version.+-- +-- This program is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the+-- GNU General Public License for more details.+-- +-- You should have received a copy of the GNU General Public License+-- along with this program.  If not, see <http://www.gnu.org/licenses/>.+-- +module Anansi.Util+	( concatMapM+	, replace+	, catEithers+	) where+import Control.Monad (liftM)++concatMapM :: Monad m => (a -> m [b]) -> [a] -> m [b]+concatMapM f xs = liftM concat $ mapM f xs++replace :: Eq a => a -> [a] -> [a] -> [a]+replace from to xs = flip concatMap xs $ \x -> if x == from+	then to+	else [x]++catEithers :: [Either e a] -> Either e [a]+catEithers = cat' [] where+	cat' acc [] = Right $ reverse acc+	cat' acc (e:es) = case e of+		Left err -> Left err+		Right x -> cat' (x : acc) es
+ src/Main.hs view
@@ -0,0 +1,171 @@+-- Copyright (C) 2010 John Millikin <jmillikin@gmail.com>+-- +-- This program is free software: you can redistribute it and/or modify+-- it under the terms of the GNU General Public License as published by+-- the Free Software Foundation, either version 3 of the License, or+-- any later version.+-- +-- This program is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the+-- GNU General Public License for more details.+-- +-- You should have received a copy of the GNU General Public License+-- along with this program.  If not, see <http://www.gnu.org/licenses/>.+-- +{-# LANGUAGE OverloadedStrings #-}+module Main (main) where++import Anansi++import Control.Monad.Writer+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.IO as TLIO+import Data.Text.Lazy.Encoding (encodeUtf8)+import qualified Data.ByteString.Lazy as BL++import System.Console.GetOpt+import System.Directory+import System.Environment+import System.Exit+import System.FilePath+import System.IO hiding (withFile)++data Output = Tangle | Weave++data Option+	= OptionOutput Output+	| OptionOutputPath TL.Text+	| OptionLoom TL.Text+	| OptionNoLines++optionInfo :: [OptDescr Option]+optionInfo =+	[ Option ['t'] ["tangle"] (NoArg (OptionOutput Tangle))+	  "Generate tangled source code (default)"+	, Option ['w'] ["weave"] (NoArg (OptionOutput Weave))+	  "Generate woven markup"+	, Option ['o'] ["out", "output"] (ReqArg (OptionOutputPath . TL.pack) "PATH")+	  "Output path (directory for tangle, file for weave)"+	, Option ['l'] ["loom"] (ReqArg (OptionLoom . TL.pack) "NAME")+	  "Which loom should be used to weave output"+	, Option [] ["noline"] (NoArg OptionNoLines)+	  "Disable generating #line declarations in tangled code"+	]++usage :: String -> String+usage name = "Usage: " ++ name ++ " [OPTION...]"++getOutput :: [Option] -> Output+getOutput [] = Tangle+getOutput (x:xs) = case x of+	OptionOutput o -> o+	_ -> getOutput xs++getPath :: [Option] -> TL.Text+getPath [] = ""+getPath (x:xs) = case x of+	OptionOutputPath p -> p+	_ -> getPath xs++withFile :: TL.Text -> (Handle -> IO a) -> IO a+withFile path io = case path of+	"" -> io stdout+	_ -> withBinaryFile (TL.unpack path) WriteMode io++loomMap :: [(TL.Text, Loom)]+loomMap = [(loomName l, l) | l <- looms]++getLoom :: [Option] -> Loom+getLoom [] = loomLaTeX+getLoom (x:xs) = case x of+	OptionLoom name -> case lookup name loomMap of+		Just loom -> loom+		Nothing -> error $ "Unknown loom: " ++ show name+	_ -> getLoom xs++getEnableLines :: [Option] -> Bool+getEnableLines [] = True+getEnableLines (x:xs) = case x of+	OptionNoLines -> False+	_ -> getEnableLines xs++main :: IO ()+main = do+	args <- getArgs+	let (options, inputs, errors) = getOpt Permute optionInfo args+	unless (null errors) $ do+		name <- getProgName+		hPutStrLn stderr $ concat errors+		hPutStrLn stderr $ usageInfo (usage name) optionInfo+		exitFailure+	+	let path = getPath options+	let loom = getLoom options+	let enableLines = getEnableLines options+	+	parsed <- parseInputs inputs+	case parsed of+		Left err -> do+			hPutStrLn stderr (formatError err)+			exitFailure+		Right blocks -> case getOutput options of+			Tangle -> case path of+				"" -> tangle debugTangle enableLines blocks+				_ -> tangle (realTangle path) enableLines blocks+			Weave -> let+				texts = execWriter $ loomWeave loom blocks+				in withFile path $ \h -> BL.hPut h $ encodeUtf8 texts++debugTangle :: TL.Text -> TL.Text -> IO ()+debugTangle path text = do+	putStr "\n"+	TLIO.putStrLn path+	putStrLn $ replicate (fromIntegral (TL.length path)) '='+	TLIO.putStr text++realTangle :: TL.Text -> TL.Text -> TL.Text -> IO ()+realTangle root path text = do+	let fullpath = combine (TL.unpack root) (TL.unpack path)+	createDirectoryIfMissing True $ takeDirectory fullpath+	let bytes = encodeUtf8 text+	withBinaryFile fullpath ReadWriteMode $ \h -> do+		equal <- fileContentsEqual h bytes+		unless equal $ do+			hSetFileSize h 0+			BL.hPut h bytes++fileContentsEqual :: Handle -> BL.ByteString -> IO Bool+fileContentsEqual h bytes = do+	hSeek h SeekFromEnd 0+	size <- hTell h+	hSeek h AbsoluteSeek 0+	+	if size /= toInteger (BL.length bytes)+		then return False+		else do+			-- FIXME: 'Int' overflow?+			contents <- BL.hGet h (fromInteger size)+			hSeek h AbsoluteSeek 0+			return $ bytes == contents++parseInputs :: [String] -> IO (Either ParseError [Block])+parseInputs inputs = do+	eithers <- mapM (parseFile . TL.pack) inputs+	return $ case catEithers eithers of+		Left err -> Left err+		Right bs -> Right $ concat bs++formatError :: ParseError -> String+formatError err = concat [filename, ":", line, ": error: ", message] where+	pos = parseErrorPosition err+	filename = TL.unpack $ positionFile pos+	line = show $ positionLine pos+	message = TL.unpack $ parseErrorMessage err++catEithers :: [Either e a] -> Either e [a]+catEithers = cat' [] where+	cat' acc [] = Right $ reverse acc+	cat' acc (e:es) = case e of+		Left err -> Left err+		Right x -> cat' (x : acc) es