anansi 0.4.1 → 0.4.2
raw patch · 5 files changed
+203/−39 lines, 5 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Anansi: loomMarkdown :: Loom
Files
- anansi.cabal +5/−4
- lib/Anansi.hs +4/−0
- lib/Anansi/Loom/Markdown.hs +82/−0
- lib/Anansi/Tangle.hs +108/−33
- lib/Anansi/Types.hs +4/−2
anansi.cabal view
@@ -1,8 +1,8 @@ name: anansi-version: 0.4.1+version: 0.4.2 license: GPL-3 license-file: license.txt-author: John Millikin <jmillikin@gmail.com>+author: John Millikin <jmillikin@gmail.com>, Dirk Laurie <dirk.laurie@gmail.com> maintainer: John Millikin <jmillikin@gmail.com> build-type: Simple cabal-version: >= 1.6@@ -27,12 +27,12 @@ source-repository head type: bazaar- location: https://john-millikin.com/software/anansi/+ location: https://john-millikin.com/branches/anansi/0.4/ source-repository this type: bazaar location: https://john-millikin.com/branches/anansi/0.4/- tag: anansi_0.4.1+ tag: anansi_0.4.2 library hs-source-dirs: lib@@ -57,6 +57,7 @@ Anansi.Loom.Debug Anansi.Loom.HTML Anansi.Loom.LaTeX+ Anansi.Loom.Markdown Anansi.Loom.NoWeb Anansi.Main Anansi.Parser
lib/Anansi.hs view
@@ -51,6 +51,7 @@ , loomDebug , loomHTML , loomLaTeX+ , loomMarkdown , loomNoWeb ) where @@ -60,6 +61,7 @@ import Anansi.Loom.Debug import Anansi.Loom.HTML import Anansi.Loom.LaTeX+import Anansi.Loom.Markdown import Anansi.Loom.NoWeb import Anansi.Main import Anansi.Parser@@ -73,6 +75,7 @@ -- [ (\"anansi.debug\", 'loomDebug') -- , (\"anansi.html\", 'loomHTML') -- , (\"anansi.latex\", 'loomLaTeX')+-- , (\"anansi.markdown\", 'loomMarkdown') -- , (\"anansi.noweb\", 'loomNoWeb') -- ] -- @@@ -81,5 +84,6 @@ [ ("anansi.debug", loomDebug) , ("anansi.html", loomHTML) , ("anansi.latex", loomLaTeX)+ , ("anansi.markdown", loomMarkdown) , ("anansi.noweb", loomNoWeb) ]
+ lib/Anansi/Loom/Markdown.hs view
@@ -0,0 +1,82 @@+{-# LANGUAGE OverloadedStrings #-}++-- Copyright (C) 2010-2011 John Millikin <jmillikin@gmail.com>+-- 2011 Dirk Laurie <dirk.laurie@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.Markdown (loomMarkdown) where++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 Markdown. Modified from LaTeX.hs.+loomMarkdown :: Loom+loomMarkdown = mapM_ putBlock . documentBlocks where+ putBlock b = case b of+ BlockText text -> tell (encodeUtf8 text)+ BlockFile path content -> do+ tell "\n> **\xC2\xBB "+ tell =<< escapeText path+ tell "**\n\n"+ putContent content+ tell "\n"+ BlockDefine name content -> do+ tell "\n> **\xC2\xAB"+ tell =<< escapeText name+ tell "\xC2\xBB**\n\n"+ putContent content+ tell "\n"+ + putContent cs = forM_ cs $ \c -> case c of+ ContentText _ text -> do+ tell "> "+ escapeCode text >>= tell+ tell "\n"+ ContentMacro _ indent name -> formatMacro indent name >>= tell+ + formatMacro indent name = do+ escIndent <- escapeCode indent+ escName <- escapeCode name+ return (mconcat ["> ", escIndent, "\xC2\xAB", escName, "\xC2\xBB\n"])++escapeCode :: Text -> LoomM ByteString+escapeCode text = do+ tabSize <- asks loomOptionTabSize+ return $ encodeUtf8 $ Data.Text.concatMap (\c -> case c of+ '\t' -> Data.Text.replicate (fromInteger tabSize) " "+ _ -> Data.Text.singleton c) text++escapeText :: Text -> LoomM ByteString+escapeText text = do+ tabSize <- asks loomOptionTabSize+ + return $ encodeUtf8 $ Data.Text.concatMap (\c -> case c of+ '\t' -> Data.Text.replicate (fromInteger tabSize) " "+ '\\' -> "\\\\"+ '_' -> "\\_"+ '*' -> "\\*"+ '[' -> "\\["+ ']' -> "\\]"+ '`' -> "\\`"+ '&' -> "&"+ _ -> Data.Text.singleton c) text
lib/Anansi/Tangle.hs view
@@ -20,24 +20,29 @@ import Prelude hiding (FilePath) import qualified Control.Monad.State as S-import Control.Monad.Trans (lift)-import qualified Control.Monad.Writer as W+import qualified Control.Monad.RWS as RWS import qualified Data.ByteString.Char8 as ByteString import Data.ByteString.Char8 (ByteString) import qualified Data.Map import Data.Map (Map)+import qualified Data.Text import Data.Text (Text) import Data.Text.Encoding (encodeUtf8)+import qualified Text.Parsec as P import Filesystem.Path (FilePath) import qualified Filesystem.Path.CurrentOS as FP import Anansi.Types +-- macro definitions, #line pragma formatter type ContentMap = Map Text [Content]+data TangleEnv = TangleEnv ContentMap (Position -> Text) -data TangleState = TangleState Position ByteString ContentMap-type TangleT m a = W.WriterT ByteString (S.StateT TangleState m) a+-- current position, current indent+data TangleState = TangleState Position ByteString +type TangleT = RWS.RWST TangleEnv ByteString TangleState+ buildMacros :: [Block] -> ContentMap buildMacros blocks = S.execState (mapM_ accumMacro blocks) Data.Map.empty @@ -74,53 +79,123 @@ -> Bool -- ^ Enable writing #line declarations -> Document -> m ()-tangle writeFile' enableLine doc = S.evalStateT (mapM_ putFile files) initState where+tangle writeFile' enableLine doc = mapM_ putFile files where blocks = documentBlocks doc+ state = TangleState (Position "" 0) "" - initState = (TangleState (Position "" 0) "" macros) fileMap = buildFiles blocks macros = buildMacros blocks files = Data.Map.toAscList fileMap - putFile (path, content) = do- bytes <- W.execWriterT (mapM_ (putContent enableLine) content)- lift (writeFile' (FP.fromText path) bytes)+ putFile (pathT, content) = do+ let path = FP.fromText pathT+ let env = TangleEnv macros (if enableLine+ then formatPosition doc path+ else const "\n")+ (_, bytes) <- RWS.evalRWST (mapM_ putContent content) env state+ writeFile' 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 (encodeUtf8 t)- W.tell "\n"+formatPosition :: Document -> FilePath -> Position -> Text+formatPosition doc = checkPath where+ fmtC = "#line ${line} ${quoted-path}"+ fmtGo = "//line ${path}:${line}"+ defaultOptions = Data.Map.fromList+ [ ("anansi.line-pragma-hs", fmtC)+ , ("anansi.line-pragma-c", fmtC)+ , ("anansi.line-pragma-cxx", fmtC)+ , ("anansi.line-pragma-cpp", fmtC)+ , ("anansi.line-pragma-cs", fmtC)+ , ("anansi.line-pragma-pl", fmtC)+ , ("anansi.line-pragma-go", fmtGo)+ ]+ opts = fmap compileTemplate (Data.Map.union (documentOptions doc) defaultOptions)+ + checkPath path = case FP.extension path of+ Just ext -> case Data.Map.lookup ("anansi.line-pragma-" `Data.Text.append` ext) opts of+ Just tmpl -> checkPos tmpl+ Nothing -> const "\n"+ Nothing -> const "\n"+ + checkPos tmpl pos = formatTemplate tmpl (templateParams pos)+ + templateParams pos = Data.Map.fromList+ [ ("line", show (positionLine pos))+ , ("path", Data.Text.unpack (either id id (FP.toText (positionFile pos))))+ , ("quoted-path", show (either id id (FP.toText (positionFile pos))))+ ] -putContent enableLine (ContentMacro pos indent name) = addIndent putMacro where+data TemplateChunk+ = TemplateChunkConst Text+ | TemplateChunkVar Text++type Template = [TemplateChunk]++compileTemplate :: Text -> Template+compileTemplate "" = []+compileTemplate txt = check (P.parse parser "" (Data.Text.unpack txt)) where+ check (Left _) = error "Internal error: compileTemplate failed."+ check (Right tmpl) = tmpl+ + parser = do+ chunks <- P.many (P.choice [P.try twodollar, P.try var, dollar, text])+ P.eof+ return chunks+ twodollar = do+ _ <- P.string "$$"+ return (TemplateChunkConst "$")+ dollar = do+ _ <- P.char '$'+ return (TemplateChunkConst "$")+ var = do+ _ <- P.string "${"+ name <- P.many1 (P.satisfy (\c -> c == '-' || (c >= 'a' && c <= 'z')))+ _ <- P.char '}'+ return (TemplateChunkVar (Data.Text.pack name))+ text = do+ chars <- P.many1 (P.satisfy (/= '$'))+ return (TemplateChunkConst (Data.Text.pack chars))++formatTemplate :: Template -> Map Text String -> Text+formatTemplate [] _ = "\n"+formatTemplate chunks vars = Data.Text.concat ("\n" : map formatChunk chunks ++ ["\n"]) where+ formatChunk (TemplateChunkConst t) = t+ formatChunk (TemplateChunkVar name) = case Data.Map.lookup name vars of+ Just value -> Data.Text.pack value+ Nothing -> Data.Text.concat ["${", name, "}"]++putContent :: Monad m => Content -> TangleT m ()+putContent (ContentText pos t) = do+ TangleState _ indent <- RWS.get+ putPosition pos+ RWS.tell indent+ RWS.tell (encodeUtf8 t)+ RWS.tell "\n"++putContent (ContentMacro pos indent name) = addIndent putMacro where addIndent m = do- TangleState lastPos old macros <- S.get- S.put (TangleState lastPos (ByteString.append old (encodeUtf8 indent)) macros)+ TangleState lastPos old <- RWS.get+ RWS.put (TangleState lastPos (ByteString.append old (encodeUtf8 indent)) ) _ <- m- TangleState newPos _ _ <- S.get- S.put (TangleState newPos old macros)+ TangleState newPos _ <- S.get+ S.put (TangleState newPos old) putMacro = do- putPosition enableLine pos- lookupMacro name >>= mapM_ (putContent enableLine)+ putPosition pos+ lookupMacro name >>= mapM_ putContent -putPosition :: Monad m => Bool -> Position -> TangleT m ()-putPosition enableLine pos = do- TangleState lastPos indent macros <- S.get+putPosition :: Monad m => Position -> TangleT m ()+putPosition pos = do+ TangleState lastPos indent <- RWS.get let expectedPos = Position (positionFile lastPos) (positionLine lastPos + 1)- let filename = either id id (FP.toText (positionFile pos))- let line = if enableLine- then "\n#line " ++ show (positionLine pos) ++ " " ++ show filename ++ "\n"- else "\n"- S.put (TangleState pos indent macros)+ RWS.put (TangleState pos indent) if pos == expectedPos then return ()- else W.tell (ByteString.pack line)+ else do+ TangleEnv _ format <- RWS.ask+ RWS.tell (encodeUtf8 (format pos)) lookupMacro :: Monad m => Text -> TangleT m [Content] lookupMacro name = do- TangleState _ _ macros <- S.get+ TangleEnv macros _ <- RWS.ask case Data.Map.lookup name macros of Nothing -> error ("unknown macro: " ++ show name) Just content -> return content
lib/Anansi/Types.hs view
@@ -136,7 +136,9 @@ parseLoomOptions :: Map Text Text -> LoomOptions parseLoomOptions opts = LoomOptions- { loomOptionTabSize = case Data.Map.lookup "tab-size" opts of+ { loomOptionTabSize = case Data.Map.lookup "anansi.tab-size" opts of Just x -> read (Data.Text.unpack x)- Nothing -> 8+ Nothing -> case Data.Map.lookup "tab-size" opts of+ Just x -> read (Data.Text.unpack x)+ Nothing -> 8 }