33fd791 · typeable/pandoc

git.iko.soy/typeable/pandoc

Made F a newtype, moved definitions to Parser.

Parser now exports F(..), askF, asksF, runF.

commit33fd791ea10e6d2a2ef53a1be5c8d2459a37ba6e authorJohn MacFarlane <jgm@berkeley.edu> dateThu 2 Aug 2012, 17:12 (14 years ago) parentebd72e7

2 files changed+37−21

compare with master

unifiedsplit

src/Text/Pandoc/Parsing.hs+23−1 src/Text/Pandoc/Readers/Markdown.hs+14−20

src/Text/Pandoc/Parsing.hs+23−1

@@ -1,3 +1,4 @@

1+{-# LANGUAGE GeneralizedNewtypeDeriving #-}

12{-

@@ -85,6 +86,10 @@ module Text.Pandoc.Parsing ( (>>~),

8586 macro,

8687 applyMacros',

8788 Parser,

89+ F(..),

90+ runF,

91+ askF,

92+ asksF,

8893 -- * Re-exports from Text.Pandoc.Parsec

8994 runParser,

9095 parse,

@@ -154,9 +159,26 @@ import Text.HTML.TagSoup.Entity ( lookupEntity )

154159import Data.Default

155160import qualified Data.Set as Set

156161import Control.Monad.Reader

162+import Data.Monoid

157163

158164type Parser t s = Parsec t s

159165

166+newtype F a = F { unF :: Reader ParserState a } deriving (Monad, Functor)

167+

168+runF :: F a -> ParserState -> a

169+runF = runReader . unF

170+

171+askF :: F ParserState

172+askF = F ask

173+

174+asksF :: (ParserState -> a) -> F a

175+asksF f = F $ asks f

176+

177+instance Monoid a => Monoid (F a) where

178+ mempty = return mempty

179+ mappend = liftM2 mappend

180+ mconcat = liftM mconcat . sequence

181+

160182-- | Like >>, but returns the operation on the left.

161183-- (Suggested by Tillmann Rendel on Haskell-cafe list.)

162184(>>~) :: (Monad m) => m a -> m b -> m a

@@ -767,7 +789,7 @@ data QuoteContext

767789

768790type NoteTable = [(String, String)]

769791

770−type NoteTable' = [(String, Reader ParserState Blocks)] -- used in markdown reader

792+type NoteTable' = [(String, F Blocks)] -- used in markdown reader

771793

772794newtype Key = Key String deriving (Show, Read, Eq, Ord)

773795

src/Text/Pandoc/Readers/Markdown.hs+14−20

@@ -1,5 +1,6 @@

11{-# LANGUAGE RelaxedPolyRec #-} -- needed for inlinesBetween on GHC < 7

2−{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}

2+{-# LANGUAGE FlexibleInstances, TypeSynonymInstances,

3+ GeneralizedNewtypeDeriving #-}

34{-

@@ -49,9 +50,9 @@ import Text.Pandoc.XML ( fromEntities )

4950import Data.Monoid

5051import qualified Data.Sequence as Seq -- TODO leaky abstraction, need better isNull in Builder

5152import Control.Applicative ((<$>), (<*), (*>), (<$))

53+import Control.Monad

5254import Text.HTML.TagSoup

5355import Text.HTML.TagSoup.Match (tagOpen)

54−import Control.Monad.Reader

5556

5657-- | Read markdown from an input string and return a Pandoc document.

5758readMarkdown :: ReaderOptions -- ^ Reader options

@@ -60,13 +61,6 @@ readMarkdown :: ReaderOptions -- ^ Reader options

6061readMarkdown opts s =

6162 (readWith parseMarkdown) def{ stateOptions = opts } (s ++ "\n\n")

6263

63−type F a = Reader ParserState a

64−

65−instance Monoid a => Monoid (Reader ParserState a) where

66− mempty = return mempty

67− mappend = liftM2 mappend

68− mconcat = liftM mconcat . sequence

69−

7064trimInlinesF :: F Inlines -> F Inlines

7165trimInlinesF = liftM trimInlines

7266

@@ -100,7 +94,7 @@ isBlank _ = False

10094--

10195

10296isNull :: F Inlines -> Bool

103−isNull ils = Seq.null $ unInlines (runReader ils def)

97+isNull ils = Seq.null $ unInlines (runF ils def)

10498

10599spnl :: Parser [Char] st ()

106100spnl = try $ do

@@ -143,7 +137,7 @@ inlinesInBalancedBrackets :: Parser [Char] ParserState (F Inlines)

143137inlinesInBalancedBrackets = try $ do

144138 char '['

145139 result <- manyTill ( (do lookAhead $ try $ do x <- inline

146− guard (runReader x def == B.str "[")

140+ guard (runF x def == B.str "[")

147141 bal <- inlinesInBalancedBrackets

148142 return $ (\x -> B.str "[" <> x <> B.str "]") <$> bal)

149143 <|> inline)

@@ -198,10 +192,10 @@ parseMarkdown = do

198192 (title, authors, date) <- option (mempty,return [],mempty) titleBlock

199193 blocks <- parseBlocks

200194 st <- getState

201− return $ B.setTitle (runReader title st)

202− $ B.setAuthors (runReader authors st)

203− $ B.setDate (runReader date st)

204− $ B.doc $ runReader blocks st

195+ return $ B.setTitle (runF title st)

196+ $ B.setAuthors (runF authors st)

197+ $ B.setDate (runF date st)

198+ $ B.doc $ runF blocks st

205199

206200--

207201-- initial pass for references and notes

@@ -1147,7 +1141,7 @@ exampleRef = try $ do

11471141 char '@'

11481142 lab <- many1 (alphaNum <|> oneOf "-_")

11491143 return $ do

1150− st <- ask

1144+ st <- askF

11511145 return $ case M.lookup lab (stateExamples st) of

11521146 Just n -> B.str (show n)

11531147 Nothing -> B.str ('@':lab)

@@ -1402,7 +1396,7 @@ referenceLink constructor (lab, raw) = do

14021396 let dropBrackets = reverse . dropRB . reverse . dropLB

14031397 fallback <- parseFromString (mconcat <$> many inline) $ dropBrackets raw

14041398 return $ do

1405− keys <- asks stateKeys

1399+ keys <- asksF stateKeys

14061400 case M.lookup key keys of

14071401 Nothing -> (\x -> B.str "[" <> x <> B.str "]" <> B.str raw') <$> fallback

14081402 Just (src,tit) -> constructor src tit <$> lab

@@ -1427,15 +1421,15 @@ note = try $ do

14271421 guardEnabled Ext_footnotes

14281422 ref <- noteMarker

14291423 return $ do

1430− notes <- asks stateNotes'

1424+ notes <- asksF stateNotes'

14311425 case lookup ref notes of

14321426 Nothing -> return $ B.str $ "[^" ++ ref ++ "]"

14331427 Just contents -> do

1434− st <- ask

1428+ st <- askF

14351429 -- process the note in a context that doesn't resolve

14361430 -- notes, to avoid infinite looping with notes inside

14371431 -- notes:

1438− let contents' = runReader contents st{ stateNotes' = [] }

1432+ let contents' = runF contents st{ stateNotes' = [] }

14391433 return $ B.note contents'

14401434

14411435inlineNote :: Parser [Char] ParserState (F Inlines)