anansi 0.3.3 → 0.4

raw patch · 13 files changed

+754/−563 lines, 13 filesdep +system-argv0PVP ok

version bump matches the API change (PVP)

Dependencies added: system-argv0

API changes (from Hackage documentation)

Files

• anansi.cabal +13/−12
• lib/Anansi.hs +64/−22
• lib/Anansi/Loom.hs +0/−26
• lib/Anansi/Loom/Debug.hs +18/−13
• lib/Anansi/Loom/HTML.hs +56/−32
• lib/Anansi/Loom/LaTeX.hs +31/−29
• lib/Anansi/Loom/NoWeb.hs +36/−34
• lib/Anansi/Main.hs +197/−0
• lib/Anansi/Parser.hs +168/−134
• lib/Anansi/Tangle.hs +51/−38
• lib/Anansi/Types.hs +113/−12
• lib/Anansi/Util.hs +0/−40
• src/Main.hs +7/−171

@@ -1,16 +1,15 @@ name: anansi-version: 0.3.3+version: 0.4 license: GPL-3 license-file: license.txt-author: John Millikin-maintainer: jmillikin@gmail.com+author: John Millikin <jmillikin@gmail.com>+maintainer: John Millikin <jmillikin@gmail.com> build-type: Simple-cabal-version: >=1.8+cabal-version: >= 1.6 category: Development stability: experimental-bug-reports: mailto:jmillikin@gmail.com homepage: https://john-millikin.com/software/anansi/-tested-with: GHC==6.12.1+bug-reports: mailto:jmillikin@gmail.com  synopsis: Simple literate programming preprocessor description:@@ -22,7 +21,7 @@   without having to enumerate each output.   .   This package is split into a library and an executable. The executable is-  suitable for simple cases, such as generating basic HTML or NoWeb. The+  suitable for simple cases, such as generating basic HTML or LaTeX. The   library is useful for users who would like to write their own output formats   (called &#x201C;looms&#x201D;). @@ -32,12 +31,12 @@  source-repository this   type: bazaar-  location: https://john-millikin.com/branches/anansi/0.3/-  tag: anansi_0.3.3+  location: https://john-millikin.com/branches/anansi/0.4/+  tag: anansi_0.4  library   hs-source-dirs: lib-  ghc-options: -Wall+  ghc-options: -Wall -O2    build-depends:       base >= 4.0 && < 5.0@@ -45,6 +44,7 @@     , containers >= 0.1 && < 0.5     , monads-tf >= 0.1 && < 0.2     , parsec >= 3.0 && < 3.2+    , system-argv0 >= 0.1 && < 0.2     , system-filepath >= 0.3.1 && < 0.5     , system-fileio >= 0.2.1 && < 0.4     , text >= 0.7 && < 0.12@@ -53,15 +53,15 @@     Anansi    other-modules:-    Anansi.Loom+    Paths_anansi     Anansi.Loom.Debug     Anansi.Loom.HTML     Anansi.Loom.LaTeX     Anansi.Loom.NoWeb+    Anansi.Main     Anansi.Parser     Anansi.Tangle     Anansi.Types-    Anansi.Util  executable anansi   main-is: Main.hs@@ -74,6 +74,7 @@     , containers >= 0.1 && < 0.5     , monads-tf >= 0.1 && < 0.2     , parsec >= 3.0 && < 3.2+    , system-argv0 >= 0.1 && < 0.2     , system-filepath >= 0.3.1 && < 0.5     , system-fileio >= 0.2.1 && < 0.4     , text >= 0.7 && < 0.12

@@ -1,43 +1,85 @@--- Copyright (C) 2010 John Millikin <jmillikin@gmail.com>--- +{-# LANGUAGE OverloadedStrings #-}++-- Copyright (C) 2010-2011 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 (..)+	(+	-- * Basic operations+	  defaultMain+	, parse+	, tangle+	, weave+	+	-- * Documents+	, Document+	, documentBlocks+	, documentOptions+	, documentLoomName+	, Block (..) 	, Content (..)-	, Position (..) 	-	, ParseError (..)-	, parseFile+	, Position+	, positionFile+	, positionLine 	-	, Loom (..)+	-- * Document parsing+	, ParseError+	, parseErrorPosition+	, parseErrorMessage+	+	-- * Looms+	, Loom+	, LoomM+	, LoomOptions+	, loomOptionTabSize+	+	-- ** Built-in looms 	, 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]+import           Data.Map (Map, fromList)+import           Data.Text (Text)++import           Anansi.Loom.Debug+import           Anansi.Loom.HTML+import           Anansi.Loom.LaTeX+import           Anansi.Loom.NoWeb+import           Anansi.Main+import           Anansi.Parser+import           Anansi.Tangle+import           Anansi.Types++-- |+--+-- @+-- looms = Data.Map.fromList+--     [ (\"anansi.debug\", 'loomDebug')+--     , (\"anansi.html\", 'loomHTML')+--     , (\"anansi.latex\", 'loomLaTeX')+--     , (\"anansi.noweb\", 'loomNoWeb')+--     ]+-- @+looms :: Map Text Loom+looms = fromList+	[ ("anansi.debug", loomDebug)+	, ("anansi.html", loomHTML)+	, ("anansi.latex", loomLaTeX)+	, ("anansi.noweb", loomNoWeb)+	]

@@ -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 ()-	}

@@ -1,28 +1,33 @@--- Copyright (C) 2010 John Millikin <jmillikin@gmail.com>--- +{-# LANGUAGE OverloadedStrings #-}++-- Copyright (C) 2010-2011 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 +import           Control.Monad (forM_)+import           Control.Monad.Writer (tell)+import           Data.ByteString.Char8 (pack)++import           Anansi.Types++-- | Just 'show' each block. This is useful for seeing exactly what your+-- document is being parsed to. loomDebug :: Loom-loomDebug = Loom "debug" $ \blocks -> do+loomDebug doc = do 	tell "\nweaving\n" 	tell "==========================\n"-	forM_ blocks $ \b -> do-		tell . pack $ show b ++ "\n"+	forM_ (documentBlocks doc) $ \b -> do+		tell (pack (show b ++ "\n"))

@@ -1,55 +1,79 @@--- Copyright (C) 2010 John Millikin <jmillikin@gmail.com>--- +{-# LANGUAGE OverloadedStrings #-}++-- Copyright (C) 2010-2011 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 +import           Control.Monad (forM_)+import           Control.Monad.Reader (asks)+import           Control.Monad.Writer (tell)+import           Data.ByteString (ByteString)+import           Data.Monoid (mconcat)+import qualified Data.Text+import           Data.Text (Text)+import           Data.Text.Encoding (encodeUtf8)++import           Anansi.Types++-- | Generate simple, @<pre>@-based HTML. Users who would like to weave+-- specialized HTML to fit with their existing templates are encouraged to+-- copy this loom and modify it as needed. loomHTML :: Loom-loomHTML = Loom "html" $ mapM_ putBlock where+loomHTML = mapM_ putBlock . documentBlocks 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-		BlockOption _ _ -> return ()+		BlockText text -> tell (encodeUtf8 text)+		BlockFile path content -> do+			epath <- escape path+			let label = mconcat ["<b>&#xBB; ", epath, "</b>"]+			putContent label content+		BlockDefine name content -> do+			ename <- escape name+			let label = mconcat ["<b>&#xAB;", ename, "&#xBB;</b>"]+			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+			ContentText _ text -> do+				tell =<< escape text+				tell "\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"]+formatMacro :: Text -> Text -> LoomM ByteString+formatMacro indent name = do+	ename <- escape name+	return $ mconcat+		[ encodeUtf8 indent+		, "<i>&#xAB;"+		, ename+		, "&#xBB;</i>\n"+		] -escape :: TL.Text -> TL.Text-escape = TL.concatMap $ \c -> case c of-	'&' -> "&amp;"-	'<' -> "&lt;"-	'>' -> "&gt;"-	'"' -> "&quot;"-	'\'' -> "&apos;"-	_ -> TL.singleton c+escape :: Text -> LoomM ByteString+escape txt = do+	tabSize <- asks loomOptionTabSize+	+	return $ encodeUtf8 $ Data.Text.concatMap (\c -> case c of+		'\t' -> Data.Text.replicate (fromInteger tabSize) " "+		'&' -> "&amp;"+		'<' -> "&lt;"+		'>' -> "&gt;"+		'"' -> "&quot;"+		'\'' -> "&apos;"+		_ -> Data.Text.singleton c) txt

@@ -1,37 +1,40 @@--- Copyright (C) 2010 John Millikin <jmillikin@gmail.com>--- +{-# LANGUAGE OverloadedStrings #-}++-- Copyright (C) 2010-2011 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 (Writer, tell)-import qualified Control.Monad.State as S-import Anansi.Types-import Anansi.Loom -data LoomState = LoomState { stateTabSize :: Integer }+import           Control.Monad (forM_)+import           Control.Monad.Reader (asks)+import           Control.Monad.Writer (tell)+import           Data.ByteString (ByteString)+import           Data.Monoid (mconcat)+import qualified Data.Text+import           Data.Text (Text)+import           Data.Text.Encoding (encodeUtf8) -type LoomM = S.StateT LoomState (Writer TL.Text)+import           Anansi.Types +-- | Generate simple, @alltt@-based LaTeX. Users who would like to weave+-- specialized LaTeX to fit with their existing templates are encouraged to+-- copy this loom and modify it as needed. loomLaTeX :: Loom-loomLaTeX = Loom "latex" (\bs -> S.evalStateT (mapM_ putBlock bs) initState) where-	initState = LoomState 8-	+loomLaTeX = mapM_ putBlock . documentBlocks where 	putBlock b = case b of-		BlockText text -> tell text+		BlockText text -> tell (encodeUtf8 text) 		BlockFile path content -> do 			tell "\\begin{alltt}\n" 			tell "{\\bf\\(\\gg\\) "@@ -47,27 +50,26 @@ 			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+		ContentText _ text -> do+			escape text >>= tell+			tell "\n"+		ContentMacro _ indent name -> formatMacro indent name >>= tell 	 	formatMacro indent name = do 		escIndent <- escape indent 		escName <- escape name-		return $ TL.concat [escIndent, "|\\emph{", escName, "}|\n"]+		return (mconcat [escIndent, "|\\emph{", escName, "}|\n"]) -escape ::  TL.Text -> LoomM TL.Text+escape ::  Text -> LoomM ByteString escape text = do-	tabSize <- S.gets stateTabSize+	tabSize <- asks loomOptionTabSize 	-	return $ TL.concatMap (\c -> case c of-		'\t' -> TL.replicate (fromInteger tabSize) (TL.singleton ' ')+	return $ encodeUtf8 $ Data.Text.concatMap (\c -> case c of+		'\t' -> Data.Text.replicate (fromInteger tabSize) " " 		'\\' -> "\\textbackslash{}" 		'{' -> "\\{" 		'}' -> "\\}" 		'_' -> "\\_"-		_ -> TL.singleton c) text+		_ -> Data.Text.singleton c) text

@@ -1,37 +1,40 @@--- Copyright (C) 2010 John Millikin <jmillikin@gmail.com>--- +{-# LANGUAGE OverloadedStrings #-}++-- Copyright (C) 2010-2011 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 (Writer, tell)-import qualified Control.Monad.State as S-import Anansi.Types-import Anansi.Loom -data LoomState = LoomState { stateTabSize :: Integer }+import           Control.Monad (forM_)+import           Control.Monad.Reader (asks)+import           Control.Monad.Writer (tell)+import           Data.ByteString (ByteString)+import           Data.Monoid (mconcat)+import qualified Data.Text+import           Data.Text (Text)+import           Data.Text.Encoding (encodeUtf8) -type LoomM = S.StateT LoomState (Writer TL.Text)+import           Anansi.Types +-- | Generate LaTeX markup, emulating the behavior of NoWeb. This is useful+-- for porting existing NoWeb-based projects to Anansi without having to+-- rewrite the styling. loomNoWeb :: Loom-loomNoWeb = Loom "latex-noweb" (\bs -> S.evalStateT (mapM_ putBlock bs) initState) where-	initState = LoomState 8-	+loomNoWeb = mapM_ putBlock . documentBlocks where 	putBlock b = case b of-		BlockText text -> tell text+		BlockText text -> tell (encodeUtf8 text) 		BlockFile path content -> do 			tell "\\nwbegincode{0}\\moddef{" 			tell =<< escapeText path@@ -45,37 +48,36 @@ 			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+		ContentText _ text -> do+			escapeCode text >>= tell+			tell "\n"+		ContentMacro _ indent name -> formatMacro indent name >>= tell 	 	formatMacro indent name = do 		escIndent <- escapeCode indent 		escName <- escapeText name-		return $ TL.concat [escIndent, "\\LA{}", escName, "\\RA{}\n"]+		return (mconcat [escIndent, "\\LA{}", escName, "\\RA{}\n"]) -escapeCode :: TL.Text -> LoomM TL.Text+escapeCode :: Text -> LoomM ByteString escapeCode text = do-	tabSize <- S.gets stateTabSize+	tabSize <- asks loomOptionTabSize 	-	return $ TL.concatMap (\c -> case c of-		'\t' -> TL.replicate (fromInteger tabSize) (TL.singleton ' ')+	return $ encodeUtf8 $ Data.Text.concatMap (\c -> case c of+		'\t' -> Data.Text.replicate (fromInteger tabSize) " " 		'\\' -> "\\\\" 		'{' -> "\\{" 		'}' -> "\\}" 		'_' -> "\\_"-		_ -> TL.singleton c) text+		_ -> Data.Text.singleton c) text -escapeText :: TL.Text -> LoomM TL.Text+escapeText :: Text -> LoomM ByteString escapeText text = do-	tabSize <- S.gets stateTabSize+	tabSize <- asks loomOptionTabSize 	-	return $ TL.concatMap (\c -> case c of-		'\t' -> TL.replicate (fromInteger tabSize) (TL.singleton ' ')+	return $ encodeUtf8 $ Data.Text.concatMap (\c -> case c of+		'\t' -> Data.Text.replicate (fromInteger tabSize) " " 		'\\' -> "\\\\" 		'{' -> "\\{" 		'}' -> "\\}"@@ -83,4 +85,4 @@ 		'<' -> "{$<$}" 		'>' -> "{$>$}" 		'$' -> "\\$"-		_ -> TL.singleton c) text+		_ -> Data.Text.singleton c) text

@@ -0,0 +1,197 @@+{-# LANGUAGE OverloadedStrings #-}++-- Copyright (C) 2010-2011 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.Main+	( defaultMain+	) where++import           Prelude hiding (FilePath)++import           Control.Monad.Writer+import           Data.ByteString (ByteString)+import qualified Data.ByteString+import qualified Data.Map+import           Data.String (fromString)+import           Data.Text (Text)+import qualified Data.Text+import           Data.Version (showVersion)+import qualified Filesystem+import           Filesystem.Path (FilePath)+import qualified Filesystem.Path.CurrentOS as FP+import           System.Argv0 (getArgv0)+import           System.Console.GetOpt+import           System.Environment (getArgs)+import           System.Exit (exitFailure, exitSuccess)+import           System.IO hiding (withFile, FilePath)++import           Anansi.Parser+import           Anansi.Tangle+import           Anansi.Types++import           Paths_anansi (version)++data Mode = Tangle | Weave+	deriving (Eq)++data Option+	= OptionHelp+	| OptionVersion+	| OptionNumericVersion+	| OptionOutputPath FilePath+	| OptionNoLines+	deriving (Eq)++optionInfo :: [OptDescr Option]+optionInfo =+	[ Option ['h'] ["help"] (NoArg OptionHelp)+	  "Display this help, then exit."+	, Option [] ["version"] (NoArg OptionVersion)+	  "Display information about this program, then exit"+	, Option [] ["numeric-version"] (NoArg OptionNumericVersion)+	  "Display the numeric version of Anansi, then exit."+	, Option ['o'] ["out", "output"] (ReqArg (OptionOutputPath . fromString) "PATH")+	  "Output path (a directory when tangling, a file when weaving)."+	, Option [] ["disable-line-pragmas"] (NoArg OptionNoLines)+	  "Disable generating #line pragmas in tangled code. This works\+	  \ around a bug in Haddock."+	]++showUsage :: [String] -> IO a+showUsage errors = do+	argv0 <- getArgv0+	let name = either Data.Text.unpack Data.Text.unpack (FP.toText argv0)+	let info = usageInfo+		("Usage: " ++ name ++ " [OPTION...] <tangle|weave> input-file\n")+		optionInfo+	if null errors+		then do+			putStrLn info+			exitSuccess+		else do+			hPutStrLn stderr (concat errors)+			hPutStrLn stderr info+			exitFailure++getPath :: [Option] -> FilePath+getPath opts = case reverse [p | OptionOutputPath p <- opts] of+	[] -> ""+	(path:_) -> path++withFile :: FilePath -> (Handle -> IO a) -> IO a+withFile path io = if FP.null path+	then io stdout+	else Filesystem.withFile path WriteMode io++-- | Run Anansi with the provided looms. Loom names are namespaced by their+-- package name, such as @\"anansi.noweb\"@ or @\"anansi-hscolour.html\"@.+-- If your looms aren't available on Hackage, a Java-style name such as+-- @\"com.mycompany.myformat\"@ is a good alternative.+defaultMain :: Data.Map.Map Text Loom -> IO ()+defaultMain looms = do+	args <- getArgs+	let (options, inputs, errors) = getOpt Permute optionInfo args+	unless (null errors) (showUsage errors)+	when (OptionHelp `elem` options) (showUsage [])+	when (OptionVersion `elem` options) $ do+		putStrLn ("anansi_" ++ showVersion version)+		exitSuccess+	when (OptionNumericVersion `elem` options) $ do+		putStrLn (showVersion version)+		exitSuccess+	+	(mode, input) <- case inputs of+		[] -> showUsage ["A mode (either 'tangle' or 'weave') is required.\n"]+		[_] -> showUsage ["An input file is required.\n"]+		[raw_mode, input] -> do+			mode <- case raw_mode of+				"tangle" -> return Tangle+				"weave" -> return Weave+				_ -> showUsage ["Unrecognized mode: " ++ show raw_mode ++ ".\n"]+			return (mode, fromString input)+		_ -> showUsage ["More than one input file provided.\n"]+	+	-- used for error messages+	let inputName = either id id (FP.toText input)+	+	let path = getPath options+	let enableLines = not (OptionNoLines `elem` options)+	+	parsedDoc <- parse Filesystem.readFile input+	doc <- case parsedDoc of+		Left err -> do+			hPutStrLn stderr ("Parse error while processing document " ++ show inputName)+			hPutStrLn stderr (formatError err)+			exitFailure+		Right x -> return x+	+	case mode of+		Tangle -> case path of+			"" -> tangle debugTangle enableLines doc+			_ -> tangle (realTangle path) enableLines doc+		Weave -> do+			loomName <- case documentLoomName doc of+				Just name -> return name+				Nothing -> do+					hPutStrLn stderr ("Document " ++ show inputName ++ " does't specify a loom (use :loom).")+					exitFailure+			+			loom <- case Data.Map.lookup loomName looms of+				Just loom -> return loom+				Nothing -> do+					hPutStrLn stderr ("Loom " ++ show loomName ++ " not recognized.")+					exitFailure+			+			withFile path (\h -> Data.ByteString.hPut h (weave loom doc))++debugTangle :: FilePath -> ByteString -> IO ()+debugTangle path bytes = do+	let strPath = either Data.Text.unpack Data.Text.unpack (FP.toText path)+	putStr "\n"+	putStrLn strPath+	putStrLn (replicate (fromIntegral (length strPath)) '=')+	Data.ByteString.putStr bytes++realTangle :: FilePath -> FilePath -> ByteString -> IO ()+realTangle root path bytes = do+	let fullpath = FP.append root path+	Filesystem.createTree (FP.parent fullpath)+	Filesystem.withFile fullpath ReadWriteMode $ \h -> do+		equal <- fileContentsEqual h bytes+		unless equal $ do+			hSetFileSize h 0+			Data.ByteString.hPut h bytes++fileContentsEqual :: Handle -> ByteString -> IO Bool+fileContentsEqual h bytes = do+	hSeek h SeekFromEnd 0+	size <- hTell h+	hSeek h AbsoluteSeek 0+	+	if size /= toInteger (Data.ByteString.length bytes)+		then return False+		else do+			-- FIXME: 'Int' overflow?+			contents <- Data.ByteString.hGet h (fromInteger size)+			hSeek h AbsoluteSeek 0+			return (bytes == contents)++formatError :: ParseError -> String+formatError err = concat [filename, ":", line, ": ", message] where+	pos = parseErrorPosition err+	filename = either Data.Text.unpack Data.Text.unpack (FP.toText (positionFile pos))+	line = show (positionLine pos)+	message = Data.Text.unpack (parseErrorMessage err)

@@ -1,85 +1,141 @@--- Copyright (C) 2010 John Millikin <jmillikin@gmail.com>--- +{-# LANGUAGE OverloadedStrings #-}++-- Copyright (C) 2010-2011 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+	, parse 	) 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 Data.String (fromString)-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 Filesystem.Path (FilePath)-import qualified Filesystem.Path.CurrentOS as FP-import qualified Filesystem-import Anansi.Types-import Anansi.Util -data ParseError = ParseError-	{ parseErrorPosition :: Position-	, parseErrorMessage :: TL.Text-	}-	deriving (Show)+import           Prelude hiding (FilePath, lines, readFile) --- too lazy to write proper error handling-data ParseExc = ParseExc ParseError-	deriving (Typeable, Show)+import           Control.Applicative ((<|>), (<$>))+import           Control.Monad (liftM)+import           Control.Monad.Error (ErrorT, Error, runErrorT, throwError)+import           Control.Monad.Trans (lift)+import           Data.ByteString (ByteString)+import           Data.Foldable (toList)+import qualified Data.Map as Map+import qualified Data.Sequence as Seq+import           Data.Sequence ((|>))+import           Data.Text (Text)+import qualified Data.Text+import           Data.Text.Encoding (decodeUtf8)+import           Filesystem.Path (FilePath)+import qualified Filesystem.Path.CurrentOS as Path+import qualified Text.Parsec as P -instance E.Exception ParseExc+import           Anansi.Types +data Line+	= LineCommand Position Command+	| LineText Position Text+	deriving (Show)+ data Command-	= CommandInclude TL.Text-	| CommandFile TL.Text-	| CommandDefine TL.Text-	| CommandOption TL.Text TL.Text+	= CommandInclude Text+	| CommandFile Text+	| CommandDefine Text+	| CommandOption Text Text+	| CommandLoom Text 	| CommandColon 	| CommandEndBlock 	| CommandComment 	deriving (Show) -data Line-	= LineCommand Position Command-	| LineText Position TL.Text-	deriving (Show)+-- | ignore me+instance Error ParseError -untilChar :: Char -> P.Parsec String u TL.Text-untilChar c = TL.pack <$> P.manyTill P.anyChar (P.try (P.char c))+-- | Parse a set of files into a 'Document'. If a parse failure occurs, a+-- 'ParseError' will be returned instead.+parse :: Monad m+      => (FilePath -> m ByteString) -- ^ File loader+      -> FilePath -- ^ Path to the root file+      -> m (Either ParseError Document)+parse readFile root = runErrorT (gen root >>= parseDocument) where+	gen path = do+		bytes <- lift (readFile path)+		lines <- getLines path bytes+		concatMapM (resolveIncludes path) lines+	+	relative x y = Path.append (Path.parent x) (Path.fromText y)+	+	resolveIncludes parent line = case line of+		LineCommand _ (CommandInclude path) -> gen (relative parent path)+		_ -> return [line] -getPosition :: Monad m => P.ParsecT s u m Position+getLines :: Monad m => FilePath -> ByteString -> ErrorT ParseError m [Line]+getLines path bytes = do+	let contents = Data.Text.unpack (decodeUtf8 bytes)+	parseResult <- P.runParserT parseLines () (Path.encodeString path) contents+	case parseResult of+		Right lines -> return lines+		Left err -> let+			msg = Data.Text.pack ("parseFile (internal error): " ++ show err)+			in throwError (ParseError (Position path 0) msg)++parseDocument :: Monad m => [Line] -> ErrorT ParseError m Document+parseDocument = loop (Seq.empty, Map.empty, Nothing) where+	loop (blocks, opts, loom) [] = return (Document (toList blocks) opts loom)+	loop acc (line:lines) = do+		(acc', lines') <- step acc line lines+		loop acc' lines'+	+	step (bs, opts, loom) line lines = case line of+		LineText _ text -> return ((bs |> BlockText text, opts, loom), lines)+		LineCommand pos cmd -> case cmd of+			CommandFile path -> do+				(block, lines') <- parseContent pos (BlockFile path) lines+				return ((bs |> block, opts, loom), lines')+			CommandDefine name -> do+				(block, lines') <- parseContent pos (BlockDefine name) lines+				return ((bs |> block, opts, loom), lines')+			CommandOption key value -> return ((bs, Map.insert key value opts, loom), lines)+			CommandColon -> return ((bs |> BlockText ":", opts, loom), lines)+			CommandComment -> return ((bs, opts, loom), lines)+			CommandLoom loomName -> return ((bs, opts, Just loomName), lines)+			CommandEndBlock -> let+				msg = "Unexpected block terminator"+				in throwError (ParseError pos msg)+			CommandInclude _ -> let+				msg = "Unexpected CommandInclude (internal error)"+				in throwError (ParseError pos msg)++type ParserM m = P.ParsecT String () (ErrorT ParseError m)++untilChar :: Monad m => Char -> ParserM m Text+untilChar c = Data.Text.pack <$> P.manyTill P.anyChar (P.try (P.char c))++parseError :: Monad m => Position -> Text -> ParserM m a+parseError pos msg = P.mkPT (\_ -> throwError (ParseError pos msg))++getPosition :: Monad m => ParserM m Position getPosition = do 	pos <- P.getPosition-	return $ Position (FP.decodeString (P.sourceName pos)) (toInteger (P.sourceLine pos))+	return (Position+		(Path.decodeString (P.sourceName pos))+		(toInteger (P.sourceLine pos))) -parseLines :: P.Parsec String u [Line]+parseLines :: Monad m => ParserM m [Line] parseLines = do 	lines' <- P.many parseLine 	P.eof 	return lines' -parseLine :: P.Parsec String u Line+parseLine :: Monad m => ParserM m Line parseLine = command <|> text where 	command = do 		void (P.char ':')@@ -89,12 +145,12 @@ 	text = do 		pos <- getPosition 		line <- untilChar '\n'-		return . LineText pos $ TL.append line "\n"+		return (LineText pos (Data.Text.append line "\n")) -parseCommand :: P.Parsec String u Command+parseCommand :: Monad m => ParserM m Command parseCommand = parsed where 	string = P.try . P.string-	parsed = P.choice [file, include, define, option, colon, comment, endBlock]+	parsed = P.choice [file, include, define, option, loom, colon, comment, endBlock] 	file = do 		void (string "file " <|> string "f ") 		CommandFile <$> untilChar '\n'@@ -105,19 +161,41 @@ 	 	define = do 		void (string "define " <|> string "d ")-		-- TODO: verify no '|' in name-		CommandDefine <$> untilChar '\n'+		name <- untilChar '\n'+		if Data.Text.any (== '|') name+			then do+				pos <- getPosition+				parseError+					(pos { positionLine = positionLine pos - 1})+					(Data.Text.pack ("Invalid macro name: " ++ show name))+			else return (CommandDefine name) 	 	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)+		void (string "option ")+		eitherOption <- let+			valid = P.try $ do+				key <- P.manyTill (P.satisfy (/= '\n')) (P.try (P.char '='))+				value <- untilChar '\n'+				return (Right (Data.Text.pack key, value))+			invalid = do+				line <- untilChar '\n'+				return (Left line)+			in valid P.<|> invalid+		case eitherOption of+			Left badLine -> do+				pos <- getPosition+				parseError+					(pos { positionLine = positionLine pos - 1})+					(Data.Text.pack ("Invalid option: " ++ show badLine))+			Right (key, value) -> return (CommandOption key value) 	+	loom = do+		void (string "loom ")+		CommandLoom <$> untilChar '\n'+	 	colon = do 		void (P.char ':')-		return $ CommandColon+		return CommandColon 	 	comment = do 		void (P.char '#')@@ -126,104 +204,60 @@ 	 	endBlock = do 		line <- untilChar '\n'-		if TL.all isSpace line+		if Data.Text.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+				let msg = Data.Text.pack ("unknown command: " ++ show (Data.Text.append ":" line))+				parseError (pos { positionLine = positionLine pos - 1 }) 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-			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)-			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, [])+parseContent :: Monad m => Position -> ([Content] -> Block) -> [Line] -> ErrorT ParseError m (Block, [Line])+parseContent start block = loop [] where+	loop _ [] = unterminated+	loop acc (line:xs) = case line of+		LineText pos text -> do+			parsed <- parse' pos text+			loop (parsed : acc) xs+		LineCommand _ CommandEndBlock -> return (block (reverse acc), xs)+		LineCommand _ _ -> unterminated 	-	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+	parse' pos text = do+		res <- P.runParserT (parser pos) () "" (Data.Text.unpack text)+		case res of+			Right content -> return content+			Left _ -> let+				trimmed = Data.Text.dropWhileEnd (== '\n') text+				msg = Data.Text.pack ("Invalid content line: " ++ show trimmed)+				in throwError (ParseError pos msg) 	+	unterminated = throwError (ParseError start "Unterminated content block")+	 	parser pos = do 		content <- contentMacro pos <|> contentText pos-		P.optional $ P.char '\n'+		P.optional (P.char '\n') 		P.eof 		return content 	 	contentMacro pos = do 		(indent, c) <- P.try $ do-			indent <- P.many $ P.satisfy isSpace+			indent <- P.many (P.satisfy isSpace) 			void (P.char '|') 			c <- P.satisfy (not . isSpace) 			return (indent, c) 		name <- untilChar '|'-		return $ ContentMacro pos (TL.pack indent) (TL.strip (TL.cons c name))+		return (ContentMacro pos (Data.Text.pack indent) (Data.Text.strip (Data.Text.cons c name))) 	 	contentText pos = do 		text <- untilChar '\n'-		return . ContentText pos $ text--type FileMap = Map.Map FilePath [Line]+		return (ContentText pos text) -genLines :: Monad m => (FilePath -> m [Line]) -> FilePath -> S.StateT FileMap m [Line]-genLines getLines = genLines' where-	genLines' path = lift (getLines path) >>= concatMapM (resolveIncludes path)-	-	textToPath :: TL.Text -> FilePath-	textToPath = fromString . TL.unpack-	-	relative :: FilePath -> TL.Text -> FilePath-	relative x y = FP.append (FP.parent x) (textToPath y)-	-	-- 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]+void :: Monad m => m a -> m ()+void m = m >> return () -parseFile :: FilePath -> 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-		bytes <- Filesystem.readFile path-		let contents = T.unpack (TE.decodeUtf8 bytes)-		case P.parse parseLines (FP.encodeString path) contents 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+concatMapM :: Monad m => (a -> m [b]) -> [a] -> m [b]+concatMapM f xs = liftM concat (mapM f xs)

@@ -1,40 +1,45 @@--- Copyright (C) 2010 John Millikin <jmillikin@gmail.com>--- +{-# LANGUAGE OverloadedStrings #-}++-- Copyright (C) 2010-2011 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 Prelude hiding (FilePath)-import Control.Monad.Trans (lift)+import           Prelude hiding (FilePath)+ import qualified Control.Monad.State as S+import           Control.Monad.Trans (lift) import qualified Control.Monad.Writer as W-import Data.String (fromString)-import qualified Data.Text.Lazy as TL-import qualified Data.Map as Map-import Filesystem.Path (FilePath)+import qualified Data.ByteString.Char8 as ByteString+import           Data.ByteString.Char8 (ByteString)+import qualified Data.Map+import           Data.Map (Map)+import           Data.Text (Text)+import           Data.Text.Encoding (encodeUtf8)+import           Filesystem.Path (FilePath) import qualified Filesystem.Path.CurrentOS as FP-import Anansi.Types-import Anansi.Util -type ContentMap = Map.Map TL.Text [Content]+import           Anansi.Types -data TangleState = TangleState Position TL.Text ContentMap-type TangleT m a = W.WriterT TL.Text (S.StateT TangleState m) a+type ContentMap = Map Text [Content] +data TangleState = TangleState Position ByteString ContentMap+type TangleT m a = W.WriterT ByteString (S.StateT TangleState m) a+ buildMacros :: [Block] -> ContentMap-buildMacros blocks = S.execState (mapM_ accumMacro blocks) Map.empty+buildMacros blocks = S.execState (mapM_ accumMacro blocks) Data.Map.empty  accumMacro :: Block -> S.State ContentMap () accumMacro b = case b of@@ -42,11 +47,10 @@ 	BlockFile _ _ -> return () 	BlockDefine name content -> do 		macros <- S.get-		S.put $ Map.insertWith (\new old -> old ++ new) name content macros-	BlockOption _ _ -> return ()+		S.put (Data.Map.insertWith (\new old -> old ++ new) name content macros)  buildFiles :: [Block] -> ContentMap-buildFiles blocks = S.execState (mapM_ accumFile blocks) Map.empty+buildFiles blocks = S.execState (mapM_ accumFile blocks) Data.Map.empty  accumFile :: Block -> S.State ContentMap () accumFile b = case b of@@ -55,39 +59,48 @@ 	BlockFile name content -> do 		let accum new old = old ++ new 		files <- S.get-		S.put $ Map.insertWith accum name content files-	BlockOption _ _ -> return ()+		S.put (Data.Map.insertWith accum name content files) +-- | Write a 'Document' to files. Paths passed to the file writer are pulled+-- directly from the document, so if you need to process them further, that+-- logic must be placed in the writer computation.+--+-- In most cases, users will want to write @#line@ pragmas to tangled source,+-- so error messages will refer back to the original input files. Haddock does+-- not handle these pragmas properly, so disable them when the tangled sources+-- will be processed into API documentation. tangle :: Monad m-       => (FilePath -> TL.Text -> m ())+       => (FilePath -> ByteString -> m ()) -- ^ File writer        -> Bool -- ^ Enable writing #line declarations-       -> [Block]+       -> Document        -> m ()-tangle writeFile' enableLine blocks = S.evalStateT (mapM_ putFile files) initState where+tangle writeFile' enableLine doc = S.evalStateT (mapM_ putFile files) initState where+	blocks = documentBlocks doc+	 	initState = (TangleState (Position "" 0) "" macros) 	fileMap = buildFiles blocks 	macros = buildMacros blocks-	files = Map.toAscList fileMap+	files = Data.Map.toAscList fileMap 	 	putFile (path, content) = do-		text <- W.execWriterT (mapM_ (putContent enableLine) content)-		lift $ writeFile' (fromString (TL.unpack path)) text+		bytes <- W.execWriterT (mapM_ (putContent enableLine) content)+		lift (writeFile' (FP.fromText path) bytes)  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 (encodeUtf8 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+		S.put (TangleState lastPos (ByteString.append old (encodeUtf8 indent)) macros)+		_ <- m 		TangleState newPos _ _ <- S.get-		S.put $ TangleState newPos old macros+		S.put (TangleState newPos old macros) 	putMacro = do 		putPosition enableLine pos 		lookupMacro name >>= mapM_ (putContent enableLine)@@ -100,14 +113,14 @@ 	let line = if enableLine 		then "\n#line " ++ show (positionLine pos) ++ " " ++ show filename ++ "\n" 		else "\n"-	S.put $ TangleState pos indent macros+	S.put (TangleState pos indent macros) 	if pos == expectedPos 		then return ()-		else W.tell $ TL.pack line+		else W.tell (ByteString.pack line) -lookupMacro :: Monad m => TL.Text -> TangleT m [Content]+lookupMacro :: Monad m => Text -> TangleT m [Content] lookupMacro name = do 	TangleState _ _ macros <- S.get-	case Map.lookup name macros of-		Nothing -> error $ "unknown macro: " ++ show name+	case Data.Map.lookup name macros of+		Nothing -> error ("unknown macro: " ++ show name) 		Just content -> return content

@@ -1,41 +1,142 @@--- Copyright (C) 2010 John Millikin <jmillikin@gmail.com>--- +{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeFamilies #-}++-- Copyright (C) 2010-2011 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 (..)+	, ParseError (..)+	+	, Document (..)+	+	, Loom+	, LoomM+	, LoomOptions (..)+	, parseLoomOptions+	, weave 	) where-import Prelude hiding (FilePath)-import Data.Text.Lazy (Text)-import Filesystem.Path.CurrentOS (FilePath) +import           Prelude hiding (FilePath)++import           Control.Monad (liftM)+import qualified Control.Monad.Reader as Reader+import           Control.Monad.Reader (ReaderT, runReaderT)+import qualified Control.Monad.Writer as Writer+import           Control.Monad.Writer (Writer, execWriter)+import           Data.ByteString (ByteString)+import qualified Data.Map+import           Data.Map (Map)+import qualified Data.Text+import           Data.Text (Text)+import           Filesystem.Path.CurrentOS (FilePath)+ data Block 	= BlockText Text 	| BlockFile Text [Content] 	| BlockDefine Text [Content]-	| BlockOption Text Text-	deriving (Show)+	deriving (Eq, Ord, Show)  data Content 	= ContentText Position Text+	+	-- | A macro reference within a content block. The first 'Text' is+	-- any indentation found before the first @\'|\'@, and the second is+	-- the name of the macro. 	| ContentMacro Position Text Text-	deriving (Show)+	deriving (Eq, Ord, Show)  data Position = Position 	{ positionFile :: FilePath 	, positionLine :: Integer 	}-	deriving (Show, Eq)+	deriving (Eq, Ord, Show)++data ParseError = ParseError+	{ parseErrorPosition :: Position+	, parseErrorMessage :: Text+	}+	deriving (Eq, Show)++data Document = Document+	{ documentBlocks :: [Block]+	+	-- | A map of @:option@ commands found in the document. If+	-- the same option is specified multiple times, the most recent will+	-- be used.+	, documentOptions :: Map Text Text+	+	-- | The last @:loom@ command given, if any. A document does not+	-- require a loom name if it's just going to be tangled, or will be+	-- woven by the user calling 'weave'. Documents woven by+	-- 'defaultMain' do require a loom name.+	, documentLoomName :: Maybe Text+	}+	deriving (Eq, Show)++-- | A loom contains all the logic required to convert a 'Document' into+-- markup suitable for processing with an external documentation tool.+--+-- Within a loom, use 'Reader.ask' to retrieve the 'LoomOptions', and+-- 'Writer.tell' to append data to the output.+type Loom = Document -> LoomM ()+newtype LoomM a = LoomM { unLoomM :: ReaderT LoomOptions (Writer ByteString) a }++instance Functor LoomM where+	fmap = liftM++instance Monad LoomM where+	return = LoomM . return+	(LoomM m) >>= f = LoomM $ do+		x <- m+		unLoomM (f x)++instance Reader.MonadReader LoomM where+	type Reader.EnvType LoomM = LoomOptions+	ask = LoomM Reader.ask+	local f (LoomM m) = LoomM (Reader.local f m)++instance Writer.MonadWriter LoomM where+	type Writer.WriterType LoomM = ByteString+	tell = LoomM . Writer.tell+	listen (LoomM m) = LoomM (Writer.listen m)+	pass m = LoomM (Writer.pass (unLoomM m))++-- | Write a document to some sort of document markup. This will typically be+-- rendered into documentation by external tools, such as LaTeX or a web+-- browser.+--+-- This writes a 'ByteString' rather than 'Text' so that looms have full+-- control over character encoding.+weave :: Loom -> Document -> ByteString+weave loom doc = execWriter (runReaderT+	(unLoomM (loom doc))+	(parseLoomOptions (documentOptions doc)))++-- | A set of processed @:option@ commands related to looms. Looms are always+-- free to check options manually, but this simplifies common cases.+data LoomOptions = LoomOptions+	{ loomOptionTabSize :: Integer+	}+	deriving (Eq, Show)++parseLoomOptions :: Map Text Text -> LoomOptions+parseLoomOptions opts = LoomOptions+	{ loomOptionTabSize = case Data.Map.lookup "tab-size" opts of+	  	Just x -> read (Data.Text.unpack x)+	  	Nothing -> 8+	}

@@ -1,40 +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-	, void-	) 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--void :: Monad m => m a -> m ()-void m = m >> return ()

@@ -1,185 +1,21 @@--- Copyright (C) 2010 John Millikin <jmillikin@gmail.com>--- +-- Copyright (C) 2010-2011 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 Paths_anansi (version) -import Prelude hiding (FilePath)-import Control.Monad.Writer-import Data.String (fromString)-import qualified Data.Text as T-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 Data.Version (showVersion)--import qualified Filesystem-import Filesystem.Path (FilePath)-import qualified Filesystem.Path.CurrentOS as FP-import System.Console.GetOpt-import System.Environment-import System.Exit-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 =-	[ 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 . fromString) "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"-	, Option [] ["version"] (NoArg OptionVersion) ""-	]--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] -> FilePath-getPath [] = ""-getPath (x:xs) = case x of-	OptionOutputPath p -> p-	_ -> getPath xs--withFile :: FilePath -> (Handle -> IO a) -> IO a-withFile path io = if FP.null path-	then io stdout-	else Filesystem.withFile 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+module Main (main) where -getEnableLines :: [Option] -> Bool-getEnableLines [] = True-getEnableLines (x:xs) = case x of-	OptionNoLines -> False-	_ -> getEnableLines xs+import           Anansi  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-	-	when (OptionVersion `elem` options) $ do-		putStrLn ("anansi_" ++ showVersion version)-		exitSuccess-	-	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 :: FilePath -> TL.Text -> IO ()-debugTangle path text = do-	let strPath = either T.unpack T.unpack (FP.toText path)-	putStr "\n"-	putStrLn strPath-	putStrLn $ replicate (fromIntegral (length strPath)) '='-	TLIO.putStr text--realTangle :: FilePath -> FilePath -> TL.Text -> IO ()-realTangle root path text = do-	let fullpath = FP.append root path-	Filesystem.createTree (FP.parent fullpath)-	let bytes = encodeUtf8 text-	Filesystem.withFile 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 . fromString) 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 = either T.unpack T.unpack (FP.toText (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+main = defaultMain looms