33fd791 · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

Made F a newtype, moved definitions to Parser.

33fd791John MacFarlane14 years ago

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

compare with master

unifiedsplit

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

1+{-# LANGUAGE GeneralizedNewtypeDeriving #-}

1{-

2{-

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

85 macro,

86 macro,

86 applyMacros',

87 applyMacros',

87 Parser,

88 Parser,

89+ F(..),

90+ runF,

91+ askF,

92+ asksF,

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

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

89 runParser,

94 runParser,

90 parse,

95 parse,

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

154import Data.Default

159import Data.Default

155import qualified Data.Set as Set

160import qualified Data.Set as Set

156import Control.Monad.Reader

161import Control.Monad.Reader

162+import Data.Monoid

157

163

158type Parser t s = Parsec t s

164type Parser t s = Parsec t s

159

165

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+

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

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

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

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

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

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

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

767

789

768type NoteTable = [(String, String)]

790type NoteTable = [(String, String)]

769

791

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

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

771

793

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

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

773

795

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

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

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

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

2+{-# LANGUAGE FlexibleInstances, TypeSynonymInstances,

3+ GeneralizedNewtypeDeriving #-}

3{-

4{-

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

49import Data.Monoid

50import Data.Monoid

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

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

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

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

53+import Control.Monad

52import Text.HTML.TagSoup

54import Text.HTML.TagSoup

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

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

54−import Control.Monad.Reader

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

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

57readMarkdown :: ReaderOptions -- ^ Reader options

58readMarkdown :: ReaderOptions -- ^ Reader options

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

60readMarkdown opts s =

61readMarkdown opts s =

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

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

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−

70trimInlinesF :: F Inlines -> F Inlines

64trimInlinesF :: F Inlines -> F Inlines

71trimInlinesF = liftM trimInlines

65trimInlinesF = liftM trimInlines

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

100--

94--

101

102isNull :: F Inlines -> Bool

96isNull :: F Inlines -> Bool

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

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

104

105spnl :: Parser [Char] st ()

99spnl :: Parser [Char] st ()

106spnl = try $ do

100spnl = try $ do

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

143inlinesInBalancedBrackets = try $ do

137inlinesInBalancedBrackets = try $ do

144 char '['

138 char '['

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

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

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

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

147 bal <- inlinesInBalancedBrackets

141 bal <- inlinesInBalancedBrackets

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

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

149 <|> inline)

143 <|> inline)

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

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

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

199 blocks <- parseBlocks

193 blocks <- parseBlocks

200 st <- getState

194 st <- getState

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

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

202− $ B.setAuthors (runReader authors st)

196+ $ B.setAuthors (runF authors st)

203− $ B.setDate (runReader date st)

197+ $ B.setDate (runF date st)

204− $ B.doc $ runReader blocks st

198+ $ B.doc $ runF blocks st

205

199

206--

200--

207-- initial pass for references and notes

201-- initial pass for references and notes

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

1147 char '@'

1141 char '@'

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

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

1149 return $ do

1143 return $ do

1150− st <- ask

1144+ st <- askF

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

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

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

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

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

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

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

1402 let dropBrackets = reverse . dropRB . reverse . dropLB

1396 let dropBrackets = reverse . dropRB . reverse . dropLB

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

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

1404 return $ do

1398 return $ do

1405− keys <- asks stateKeys

1399+ keys <- asksF stateKeys

1406 case M.lookup key keys of

1400 case M.lookup key keys of

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

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

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

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

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

1427 guardEnabled Ext_footnotes

1421 guardEnabled Ext_footnotes

1428 ref <- noteMarker

1422 ref <- noteMarker

1429 return $ do

1423 return $ do

1430− notes <- asks stateNotes'

1424+ notes <- asksF stateNotes'

1431 case lookup ref notes of

1425 case lookup ref notes of

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

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

1433 Just contents -> do

1427 Just contents -> do

1434− st <- ask

1428+ st <- askF

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

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

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

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

1437 -- notes:

1431 -- notes:

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

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

1439 return $ B.note contents'

1433 return $ B.note contents'

1440

1434

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

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