anansi 0.2.1.3 → 0.3

raw patch · 9 files changed

+127/−70 lines, 9 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• anansi.cabal +1/−7
• lib/Anansi/Loom/HTML.hs +1/−0
• lib/Anansi/Loom/LaTeX.hs +32/−17
• lib/Anansi/Loom/NoWeb.hs +46/−28
• lib/Anansi/Parser.hs +20/−11
• lib/Anansi/Tangle.hs +12/−7
• lib/Anansi/Types.hs +1/−0
• lib/Anansi/Util.hs +4/−0
• src/Main.hs +10/−0

@@ -1,5 +1,5 @@ name: anansi-version: 0.2.1.3+version: 0.3 synopsis: Simple literate programming preprocessor license: GPL-3 license-file: license.txt@@ -23,9 +23,6 @@   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 && < 3.2@@ -55,9 +52,6 @@    if true     ghc-options: -Wall--  if impl(ghc >= 6.11)-    ghc-options: -fno-warn-unused-do-bind    build-depends:       base >=4.0 && < 5.0

@@ -31,6 +31,7 @@ 		BlockDefine name content -> let 			label = TL.concat ["<b>&#xAB;", escape name, "&#xBB;</b>"] 			in putContent label content+		BlockOption _ _ -> return () 	 	putContent label cs = do 		tell "<pre>"

@@ -17,18 +17,25 @@ module Anansi.Loom.LaTeX (loomLaTeX) where import qualified Data.Text.Lazy as TL import Control.Monad (forM_)-import Control.Monad.Writer (tell)+import Control.Monad.Writer (Writer, tell)+import qualified Control.Monad.State as S import Anansi.Types import Anansi.Loom +data LoomState = LoomState { stateTabSize :: Integer }++type LoomM = S.StateT LoomState (Writer TL.Text)+ loomLaTeX :: Loom-loomLaTeX = Loom "latex" $ mapM_ putBlock where+loomLaTeX = Loom "latex" (\bs -> S.evalStateT (mapM_ putBlock bs) initState) where+	initState = LoomState 8+	 	putBlock b = case b of 		BlockText text -> tell text 		BlockFile path content -> do 			tell "\\begin{alltt}\n" 			tell "{\\bf\\(\\gg\\) "-			tell $ escape path+			tell =<< escape path 			tell "}\n" 			putContent content 			tell "\\end{alltt}\n"@@ -36,23 +43,31 @@ 		BlockDefine name content -> do 			tell "\\begin{alltt}\n" 			tell "{\\bf\\(\\ll\\)"-			tell $ escape name+			tell =<< escape name 			tell "\\(\\gg\\)}\n" 			putContent content 			tell "\\end{alltt}\n"+		BlockOption key value -> if key == "tab-size"+			then S.put (LoomState (read (TL.unpack value)))+			else return () 	 	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"]+		ContentText _ text -> tell =<< escape (TL.append text "\n")+		ContentMacro _ indent name -> tell =<< formatMacro indent name+	+	formatMacro indent name = do+		escIndent <- escape indent+		escName <- escape name+		return $ TL.concat [escIndent, "|\\emph{", escName, "}|\n"] -escape :: TL.Text -> TL.Text-escape = TL.concatMap $ \c -> case c of-	'\t' -> "        "-	'\\' -> "\\textbackslash{}"-	'{' -> "\\{"-	'}' -> "\\}"-	'_' -> "\\_"-	_ -> TL.singleton c+escape ::  TL.Text -> LoomM TL.Text+escape text = do+	tabSize <- S.gets stateTabSize+	+	return $ TL.concatMap (\c -> case c of+		'\t' -> TL.replicate (fromInteger tabSize) (TL.singleton ' ')+		'\\' -> "\\textbackslash{}"+		'{' -> "\\{"+		'}' -> "\\}"+		'_' -> "\\_"+		_ -> TL.singleton c) text

@@ -17,52 +17,70 @@ module Anansi.Loom.NoWeb (loomNoWeb) where import qualified Data.Text.Lazy as TL import Control.Monad (forM_)-import Control.Monad.Writer (tell)+import Control.Monad.Writer (Writer, tell)+import qualified Control.Monad.State as S import Anansi.Types import Anansi.Loom +data LoomState = LoomState { stateTabSize :: Integer }++type LoomM = S.StateT LoomState (Writer TL.Text)+ loomNoWeb :: Loom-loomNoWeb = Loom "latex-noweb" $ mapM_ putBlock where+loomNoWeb = Loom "latex-noweb" (\bs -> S.evalStateT (mapM_ putBlock bs) initState) where+	initState = LoomState 8+	 	putBlock b = case b of 		BlockText text -> tell text 		BlockFile path content -> do 			tell "\\nwbegincode{0}\\moddef{"-			tell $ escapeText path+			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 =<< escapeText name 			tell "}\\endmoddef\\nwstartdeflinemarkup\\nwenddeflinemarkup\n" 			putContent content 			tell "\\nwendcode{}\n"+		BlockOption key value -> if key == "tab-size"+			then S.put (LoomState (read (TL.unpack value)))+			else return () 	 	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"]+		ContentText _ text -> tell =<< escapeCode (TL.append text "\n")+		ContentMacro _ indent name -> tell =<< formatMacro indent name+	+	formatMacro indent name = do+		escIndent <- escapeCode indent+		escName <- escapeText name+		return $ TL.concat [escIndent, "\\LA{}", escName, "\\RA{}\n"] -escapeCode :: TL.Text -> TL.Text-escapeCode = TL.concatMap $ \c -> case c of-	'\t' -> "        "-	'\\' -> "\\\\"-	'{' -> "\\{"-	'}' -> "\\}"-	'_' -> "\\_"-	_ -> TL.singleton c+escapeCode :: TL.Text -> LoomM TL.Text+escapeCode text = do+	tabSize <- S.gets stateTabSize+	+	return $ TL.concatMap (\c -> case c of+		'\t' -> TL.replicate (fromInteger tabSize) (TL.singleton ' ')+		'\\' -> "\\\\"+		'{' -> "\\{"+		'}' -> "\\}"+		'_' -> "\\_"+		_ -> TL.singleton c) text -escapeText :: TL.Text -> TL.Text-escapeText = TL.concatMap $ \c -> case c of-	'\t' -> "        "-	'\\' -> "\\\\"-	'{' -> "\\{"-	'}' -> "\\}"-	'_' -> "\\_"-	'<' -> "{$<$}"-	'>' -> "{$>$}"-	'$' -> "\\$"-	_ -> TL.singleton c+escapeText :: TL.Text -> LoomM TL.Text+escapeText text = do+	tabSize <- S.gets stateTabSize+	+	return $ TL.concatMap (\c -> case c of+		'\t' -> TL.replicate (fromInteger tabSize) (TL.singleton ' ')+		'\\' -> "\\\\"+		'{' -> "\\{"+		'}' -> "\\}"+		'_' -> "\\_"+		'<' -> "{$<$}"+		'>' -> "{$>$}"+		'$' -> "\\$"+		_ -> TL.singleton c) text

@@ -53,6 +53,7 @@ 	= CommandInclude TL.Text 	| CommandFile TL.Text 	| CommandDefine TL.Text+	| CommandOption TL.Text TL.Text 	| CommandColon 	| CommandEndBlock 	| CommandComment@@ -80,7 +81,7 @@ parseLine :: P.Parsec String u Line parseLine = command <|> text where 	command = do-		P.char ':'+		void (P.char ':') 		pos <- getPosition 		LineCommand pos <$> parseCommand 	@@ -92,33 +93,40 @@ parseCommand :: P.Parsec String u Command parseCommand = parsed where 	string = P.try . P.string-	parsed = P.choice [file, include, define, colon, comment, endBlock]+	parsed = P.choice [file, include, define, option, colon, comment, endBlock] 	file = do-		string "file " <|> string "f "+		void (string "file " <|> string "f ") 		CommandFile <$> untilChar '\n' 	 	include = do-		string "include " <|> string "i "+		void (string "include " <|> string "i ") 		CommandInclude <$> untilChar '\n' 	 	define = do-		string "define " <|> string "d "+		void (string "define " <|> string "d ") 		-- TODO: verify no '|' in name 		CommandDefine <$> untilChar '\n' 	+	option = do+		void (string "option " <|> string "o ")+		key <- P.manyTill P.anyChar (P.try (P.satisfy isSpace))+		P.skipMany (P.satisfy isSpace)+		value <- untilChar '\n'+		return (CommandOption (TL.pack key) value)+	 	colon = do-		P.char ':'+		void (P.char ':') 		return $ CommandColon 	 	comment = do-		P.char '#'-		untilChar '\n'-		return $ CommandComment+		void (P.char '#')+		void (untilChar '\n')+		return CommandComment 	 	endBlock = do 		line <- untilChar '\n' 		if TL.all isSpace line-			then return $ CommandEndBlock+			then return CommandEndBlock 			else do 				pos <- getPosition 				let msg = TL.pack $ "unknown command: " ++ show (TL.append ":" line)@@ -138,6 +146,7 @@ 		LineCommand pos cmd -> case cmd of 			CommandFile path -> parseContent pos (BlockFile path) xs 			CommandDefine name -> parseContent pos (BlockDefine name) xs+			CommandOption key value -> Just (Right (BlockOption key value), xs) 			CommandColon -> Just (Right $ BlockText ":", xs) 			CommandEndBlock -> Just (Right $ BlockText "\n", xs) 			CommandComment -> Just (Right $ BlockText "", xs)@@ -172,7 +181,7 @@ 	contentMacro pos = do 		(indent, c) <- P.try $ do 			indent <- P.many $ P.satisfy isSpace-			P.char '|'+			void (P.char '|') 			c <- P.satisfy (not . isSpace) 			return (indent, c) 		name <- untilChar '|'

@@ -17,7 +17,6 @@ module Anansi.Tangle (tangle) where  import Prelude hiding (FilePath)-import Control.Monad (when) import Control.Monad.Trans (lift) import qualified Control.Monad.State as S import qualified Control.Monad.Writer as W@@ -26,6 +25,7 @@ import System.FilePath (FilePath) import qualified System.FilePath.CurrentOS as FP import Anansi.Types+import Anansi.Util  type ContentMap = Map.Map TL.Text [Content] @@ -42,6 +42,7 @@ 	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@@ -54,6 +55,7 @@ 		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 ())@@ -73,7 +75,7 @@ putContent :: Monad m => Bool -> Content -> TangleT m () putContent enableLine (ContentText pos t) = do 	TangleState _ indent _ <- S.get-	when enableLine $ putPosition pos+	putPosition enableLine pos 	W.tell indent 	W.tell t 	W.tell "\n"@@ -82,18 +84,21 @@ 	addIndent m = do 		TangleState lastPos old macros <- S.get 		S.put $ TangleState lastPos (TL.append old indent) macros-		m+		void m 		TangleState newPos _ _ <- S.get 		S.put $ TangleState newPos old macros 	putMacro = do-		when enableLine $ putPosition pos+		putPosition enableLine pos 		lookupMacro name >>= mapM_ (putContent enableLine) -putPosition :: Monad m => Position -> TangleT m ()-putPosition pos = do+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 line = "\n#line " ++ show (positionLine pos) ++ " " ++ show (positionFile pos) ++ "\n"+	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 ()

@@ -26,6 +26,7 @@ 	= BlockText Text 	| BlockFile Text [Content] 	| BlockDefine Text [Content]+	| BlockOption Text Text 	deriving (Show)  data Content

@@ -17,6 +17,7 @@ 	( concatMapM 	, replace 	, catEithers+	, void 	) where import Control.Monad (liftM) @@ -34,3 +35,6 @@ 	cat' acc (e:es) = case e of 		Left err -> Left err 		Right x -> cat' (x : acc) es++void :: Monad m => m a -> m ()+void m = m >> return ()

@@ -16,6 +16,7 @@ {-# LANGUAGE OverloadedStrings #-} module Main (main) where import Anansi+import Paths_anansi (version)  import Prelude hiding (FilePath) import Control.Monad.Writer@@ -23,6 +24,7 @@ import qualified Data.Text.Lazy.IO as TLIO import Data.Text.Lazy.Encoding (encodeUtf8) import qualified Data.ByteString.Lazy as BL+import Data.Version (showVersion)  import System.Console.GetOpt import System.Directory@@ -33,12 +35,15 @@ import System.IO hiding (withFile, FilePath)  data Output = Tangle | Weave+	deriving (Eq)  data Option 	= OptionOutput Output 	| OptionOutputPath FilePath 	| OptionLoom TL.Text 	| OptionNoLines+	| OptionVersion+	deriving (Eq)  optionInfo :: [OptDescr Option] optionInfo =@@ -52,6 +57,7 @@ 	  "Which loom should be used to weave output" 	, Option [] ["noline"] (NoArg OptionNoLines) 	  "Disable generating #line declarations in tangled code"+	, Option [] ["version"] (NoArg OptionVersion) "" 	]  usage :: String -> String@@ -100,6 +106,10 @@ 		hPutStrLn stderr $ concat errors 		hPutStrLn stderr $ usageInfo (usage name) optionInfo 		exitFailure+	+	when (OptionVersion `elem` options) $ do+		putStrLn ("anansi_" ++ showVersion version)+		exitSuccess 	 	let path = getPath options 	let loom = getLoom options