7a0729e · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

Org reader: move parser state into separate module

7a0729eAlbert Krewinkel10 years ago

pandoc.cabal+1

compare with master

unifiedsplit

@@ -393,6 +393,7 @@ Library

393 Text.Pandoc.Readers.Odt.Generic.XMLConverter,

394 Text.Pandoc.Readers.Odt.Arrows.State,

395 Text.Pandoc.Readers.Odt.Arrows.Utils,

396+ Text.Pandoc.Readers.Org.ParserState,

396 Text.Pandoc.Writers.Shared,

397 Text.Pandoc.Writers.Shared,

397 Text.Pandoc.Asciify,

398 Text.Pandoc.Asciify,

398 Text.Pandoc.MIME,

399 Text.Pandoc.MIME,

src/Text/Pandoc/Readers/Org.hs+57−158

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

1+{-# LANGUAGE FlexibleContexts #-}

1{-# LANGUAGE OverloadedStrings #-}

2{-# LANGUAGE OverloadedStrings #-}

2−{-# LANGUAGE GeneralizedNewtypeDeriving #-}

3−{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, FlexibleInstances #-}

4{-

3{-

@@ -31,8 +30,7 @@ Conversion of org-mode formatted plain text to 'Pandoc' document.

31module Text.Pandoc.Readers.Org ( readOrg ) where

30module Text.Pandoc.Readers.Org ( readOrg ) where

33import qualified Text.Pandoc.Builder as B

32import qualified Text.Pandoc.Builder as B

34−import Text.Pandoc.Builder ( Inlines, Blocks, HasMeta(..),

33+import Text.Pandoc.Builder ( Inlines, Blocks )

35− trimInlines )

36import Text.Pandoc.Definition

34import Text.Pandoc.Definition

37import Text.Pandoc.Compat.Monoid ((<>))

35import Text.Pandoc.Compat.Monoid ((<>))

38import Text.Pandoc.Error

36import Text.Pandoc.Error

@@ -43,153 +41,33 @@ import Text.Pandoc.Parsing hiding ( F, unF, askF, asksF, runF

43 , parseFromString, blanklines

41 , parseFromString, blanklines

44 )

42 )

45import Text.Pandoc.Readers.LaTeX (inlineCommand, rawLaTeXInline)

43import Text.Pandoc.Readers.LaTeX (inlineCommand, rawLaTeXInline)

44+import Text.Pandoc.Readers.Org.ParserState

46import Text.Pandoc.Shared (compactify', compactify'DL)

45import Text.Pandoc.Shared (compactify', compactify'DL)

47import Text.TeXMath (readTeX, writePandoc, DisplayType(..))

46import Text.TeXMath (readTeX, writePandoc, DisplayType(..))

48import qualified Text.TeXMath.Readers.MathML.EntityMap as MathMLEntityMap

47import qualified Text.TeXMath.Readers.MathML.EntityMap as MathMLEntityMap

50import Control.Arrow (first)

49import Control.Arrow (first)

51−import Control.Monad (foldM, guard, liftM, liftM2, mplus, mzero, when)

50+import Control.Monad (foldM, guard, mplus, mzero, when)

52−import Control.Monad.Reader (Reader, runReader, ask, asks, local)

51+import Control.Monad.Reader ( Reader, runReader )

53import Data.Char (isAlphaNum, isSpace, toLower)

52import Data.Char (isAlphaNum, isSpace, toLower)

54−import Data.Default

55import Data.List (intersperse, isPrefixOf, isSuffixOf)

53import Data.List (intersperse, isPrefixOf, isSuffixOf)

56import qualified Data.Map as M

54import qualified Data.Map as M

57−import qualified Data.Set as Set

58import Data.Maybe (fromMaybe, isJust)

55import Data.Maybe (fromMaybe, isJust)

59import Network.HTTP (urlEncode)

56import Network.HTTP (urlEncode)

58+

61-- | Parse org-mode string and return a Pandoc document.

59-- | Parse org-mode string and return a Pandoc document.

62readOrg :: ReaderOptions -- ^ Reader options

60readOrg :: ReaderOptions -- ^ Reader options

63 -> String -- ^ String to parse (assuming @'\n'@ line endings)

61 -> String -- ^ String to parse (assuming @'\n'@ line endings)

64 -> Either PandocError Pandoc

62 -> Either PandocError Pandoc

65readOrg opts s = flip runReader def $ readWithM parseOrg def{ orgStateOptions = opts } (s ++ "\n\n")

63readOrg opts s = flip runReader def $ readWithM parseOrg def{ orgStateOptions = opts } (s ++ "\n\n")

67−data OrgParserLocal = OrgParserLocal { orgLocalQuoteContext :: QuoteContext }

65+-- | The parser used to read org files.

68−

69type OrgParser = ParserT [Char] OrgParserState (Reader OrgParserLocal)

66type OrgParser = ParserT [Char] OrgParserState (Reader OrgParserLocal)

71−instance HasIdentifierList OrgParserState where

72− extractIdentifierList = orgStateIdentifiers

73− updateIdentifierList f s = s{ orgStateIdentifiers = f (orgStateIdentifiers s) }

74−

75−instance HasHeaderMap OrgParserState where

76− extractHeaderMap = orgStateHeaderMap

77− updateHeaderMap f s = s{ orgStateHeaderMap = f (orgStateHeaderMap s) }

78−

79−parseOrg :: OrgParser Pandoc

80−parseOrg = do

81− blocks' <- parseBlocks

82− st <- getState

83− let meta = runF (orgStateMeta' st) st

84− let removeUnwantedBlocks = dropCommentTrees . filter (/= Null)

85− return $ Pandoc meta $ removeUnwantedBlocks (B.toList $ runF blocks' st)

86−

87−-- | Drop COMMENT headers and the document tree below those headers.

88−dropCommentTrees :: [Block] -> [Block]

89−dropCommentTrees [] = []

90−dropCommentTrees (b:bs) =

91− maybe (b:dropCommentTrees bs)

92− (dropCommentTrees . flip dropUntilHeaderAboveLevel bs)

93− (commentHeaderLevel b)

94−

95−-- | Return the level of a header starting a comment or :noexport: tree and

96−-- Nothing otherwise.

97−commentHeaderLevel :: Block -> Maybe Int

98−commentHeaderLevel blk =

99− case blk of

100− (Header level _ ((Str "COMMENT"):_)) -> Just level

101− (Header level _ title) | hasNoExportTag title -> Just level

102− _ -> Nothing

103− where

104− hasNoExportTag :: [Inline] -> Bool

105− hasNoExportTag = any isNoExportTag

106−

107− isNoExportTag :: Inline -> Bool

108− isNoExportTag (Span ("", ["tag"], [("data-tag-name", "noexport")]) []) = True

109− isNoExportTag _ = False

110−

111−-- | Drop blocks until a header on or above the given level is seen

112−dropUntilHeaderAboveLevel :: Int -> [Block] -> [Block]

113−dropUntilHeaderAboveLevel n = dropWhile (not . isHeaderLevelLowerEq n)

114−

115−isHeaderLevelLowerEq :: Int -> Block -> Bool

116−isHeaderLevelLowerEq n blk =

117− case blk of

118− (Header level _ _) -> n >= level

119− _ -> False

120−

121--

68--

122−-- Parser State for Org

69+-- Functions acting on the parser state

123--

70--

124−

125−type OrgNoteRecord = (String, F Blocks)

126−type OrgNoteTable = [OrgNoteRecord]

127−

128−type OrgBlockAttributes = M.Map String String

129−

130−type OrgLinkFormatters = M.Map String (String -> String)

131−

132−-- | Org-mode parser state

133−data OrgParserState = OrgParserState

134− { orgStateOptions :: ReaderOptions

135− , orgStateAnchorIds :: [String]

136− , orgStateBlockAttributes :: OrgBlockAttributes

137− , orgStateEmphasisCharStack :: [Char]

138− , orgStateEmphasisNewlines :: Maybe Int

139− , orgStateLastForbiddenCharPos :: Maybe SourcePos

140− , orgStateLastPreCharPos :: Maybe SourcePos

141− , orgStateLastStrPos :: Maybe SourcePos

142− , orgStateLinkFormatters :: OrgLinkFormatters

143− , orgStateMeta :: Meta

144− , orgStateMeta' :: F Meta

145− , orgStateNotes' :: OrgNoteTable

146− , orgStateParserContext :: ParserContext

147− , orgStateIdentifiers :: Set.Set String

148− , orgStateHeaderMap :: M.Map Inlines String

149− }

150−

151−instance Default OrgParserLocal where

152− def = OrgParserLocal NoQuote

153−

154−instance HasReaderOptions OrgParserState where

155− extractReaderOptions = orgStateOptions

156−

157−instance HasMeta OrgParserState where

158− setMeta field val st =

159− st{ orgStateMeta = setMeta field val $ orgStateMeta st }

160− deleteMeta field st =

161− st{ orgStateMeta = deleteMeta field $ orgStateMeta st }

162−

163−instance HasLastStrPosition OrgParserState where

164− getLastStrPos = orgStateLastStrPos

165− setLastStrPos pos st = st{ orgStateLastStrPos = Just pos }

166−

167−instance HasQuoteContext st (Reader OrgParserLocal) where

168− getQuoteContext = asks orgLocalQuoteContext

169− withQuoteContext q = local (\s -> s{orgLocalQuoteContext = q})

170−

171−instance Default OrgParserState where

172− def = defaultOrgParserState

173−

174−defaultOrgParserState :: OrgParserState

175−defaultOrgParserState = OrgParserState

176− { orgStateOptions = def

177− , orgStateAnchorIds = []

178− , orgStateBlockAttributes = M.empty

179− , orgStateEmphasisCharStack = []

180− , orgStateEmphasisNewlines = Nothing

181− , orgStateLastForbiddenCharPos = Nothing

182− , orgStateLastPreCharPos = Nothing

183− , orgStateLastStrPos = Nothing

184− , orgStateLinkFormatters = M.empty

185− , orgStateMeta = nullMeta

186− , orgStateMeta' = return nullMeta

187− , orgStateNotes' = []

188− , orgStateParserContext = NullState

189− , orgStateIdentifiers = Set.empty

190− , orgStateHeaderMap = M.empty

191− }

192−

193recordAnchorId :: String -> OrgParser ()

71recordAnchorId :: String -> OrgParser ()

194recordAnchorId i = updateState $ \s ->

72recordAnchorId i = updateState $ \s ->

195 s{ orgStateAnchorIds = i : (orgStateAnchorIds s) }

73 s{ orgStateAnchorIds = i : (orgStateAnchorIds s) }

@@ -243,44 +121,65 @@ addToNotesTable note = do

243 oldnotes <- orgStateNotes' <$> getState

121 oldnotes <- orgStateNotes' <$> getState

244 updateState $ \s -> s{ orgStateNotes' = note:oldnotes }

122 updateState $ \s -> s{ orgStateNotes' = note:oldnotes }

245

123

246−-- The version Text.Pandoc.Parsing cannot be used, as we need additional parts

247−-- of the state saved and restored.

248−parseFromString :: OrgParser a -> String -> OrgParser a

249−parseFromString parser str' = do

250− oldLastPreCharPos <- orgStateLastPreCharPos <$> getState

251− updateState $ \s -> s{ orgStateLastPreCharPos = Nothing }

252− result <- P.parseFromString parser str'

253− updateState $ \s -> s{ orgStateLastPreCharPos = oldLastPreCharPos }

254− return result

255−

256−

257--

124--

258−-- Adaptions and specializations of parsing utilities

125+-- Parser

259--

126--

127+parseOrg :: OrgParser Pandoc

128+parseOrg = do

129+ blocks' <- parseBlocks

130+ st <- getState

131+ let meta = runF (orgStateMeta' st) st

132+ let removeUnwantedBlocks = dropCommentTrees . filter (/= Null)

133+ return $ Pandoc meta $ removeUnwantedBlocks (B.toList $ runF blocks' st)

260

134

261−newtype F a = F { unF :: Reader OrgParserState a

135+-- | Drop COMMENT headers and the document tree below those headers.

262− } deriving (Monad, Applicative, Functor)

136+dropCommentTrees :: [Block] -> [Block]

137+dropCommentTrees [] = []

138+dropCommentTrees (b:bs) =

139+ maybe (b:dropCommentTrees bs)

140+ (dropCommentTrees . flip dropUntilHeaderAboveLevel bs)

141+ (commentHeaderLevel b)

263

142

264−runF :: F a -> OrgParserState -> a

143+-- | Return the level of a header starting a comment or :noexport: tree and

265−runF = runReader . unF

144+-- Nothing otherwise.

145+commentHeaderLevel :: Block -> Maybe Int

146+commentHeaderLevel blk =

147+ case blk of

148+ (Header level _ ((Str "COMMENT"):_)) -> Just level

149+ (Header level _ title) | hasNoExportTag title -> Just level

150+ _ -> Nothing

151+ where

152+ hasNoExportTag :: [Inline] -> Bool

153+ hasNoExportTag = any isNoExportTag

266

154

267−askF :: F OrgParserState

155+ isNoExportTag :: Inline -> Bool

268−askF = F ask

156+ isNoExportTag (Span ("", ["tag"], [("data-tag-name", "noexport")]) []) = True

157+ isNoExportTag _ = False

269

158

270−asksF :: (OrgParserState -> a) -> F a

159+-- | Drop blocks until a header on or above the given level is seen

271−asksF f = F $ asks f

160+dropUntilHeaderAboveLevel :: Int -> [Block] -> [Block]

161+dropUntilHeaderAboveLevel n = dropWhile (not . isHeaderLevelLowerEq n)

272

162

273−instance Monoid a => Monoid (F a) where

163+isHeaderLevelLowerEq :: Int -> Block -> Bool

274− mempty = return mempty

164+isHeaderLevelLowerEq n blk =

275− mappend = liftM2 mappend

165+ case blk of

276− mconcat = fmap mconcat . sequence

166+ (Header level _ _) -> n >= level

167+ _ -> False

277

168

278−trimInlinesF :: F Inlines -> F Inlines

279−trimInlinesF = liftM trimInlines

280

169

281−returnF :: a -> OrgParser (F a)

170+--

282−returnF = return . return

171+-- Adaptions and specializations of parsing utilities

172+--

283

173

174+-- The version Text.Pandoc.Parsing cannot be used, as we need additional parts

175+-- of the state saved and restored.

176+parseFromString :: OrgParser a -> String -> OrgParser a

177+parseFromString parser str' = do

178+ oldLastPreCharPos <- orgStateLastPreCharPos <$> getState

179+ updateState $ \s -> s{ orgStateLastPreCharPos = Nothing }

180+ result <- P.parseFromString parser str'

181+ updateState $ \s -> s{ orgStateLastPreCharPos = oldLastPreCharPos }

182+ return result

284

183

285-- | Like @Text.Parsec.Char.newline@, but causes additional state changes.

184-- | Like @Text.Parsec.Char.newline@, but causes additional state changes.

286newline :: OrgParser Char

185newline :: OrgParser Char

src/Text/Pandoc/Readers/Org/ParserState.hsnew file+175

@@ -0,0 +1,175 @@

1+{-# LANGUAGE FlexibleInstances #-}

2+{-# LANGUAGE GeneralizedNewtypeDeriving #-}

3+{-# LANGUAGE MultiParamTypeClasses #-}

4+{-

7+This program is free software; you can redistribute it and/or modify

8+it under the terms of the GNU General Public License as published by

9+the Free Software Foundation; either version 2 of the License, or

10+(at your option) any later version.

11+

12+This program is distributed in the hope that it will be useful,

13+but WITHOUT ANY WARRANTY; without even the implied warranty of

14+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the

15+GNU General Public License for more details.

16+

17+You should have received a copy of the GNU General Public License

18+along with this program; if not, write to the Free Software

19+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA

20+-}

21+

22+{- |

23+ Module : Text.Pandoc.Readers.Org.Options

25+ License : GNU GPL, version 2 or above

26+

27+ Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>

28+

29+Define the Org-mode parser state.

30+-}

31+module Text.Pandoc.Readers.Org.ParserState

32+ ( OrgParserState(..)

33+ , OrgParserLocal(..)

34+ , OrgNoteRecord

35+ , F(..)

36+ , askF

37+ , asksF

38+ , trimInlinesF

39+ , runF

40+ , returnF

41+ ) where

42+

43+import Control.Monad (liftM, liftM2)

44+import Control.Monad.Reader (Reader, runReader, ask, asks, local)

45+

46+import Data.Default (Default(..))

47+import qualified Data.Map as M

48+import qualified Data.Set as Set

49+

50+import Text.Pandoc.Builder ( Inlines, Blocks, HasMeta(..),

51+ trimInlines )

52+import Text.Pandoc.Definition ( Meta(..), nullMeta )

53+import Text.Pandoc.Options ( ReaderOptions(..) )

54+import Text.Pandoc.Parsing ( HasHeaderMap(..)

55+ , HasIdentifierList(..)

56+ , HasLastStrPosition(..)

57+ , HasQuoteContext(..)

58+ , HasReaderOptions(..)

59+ , ParserContext(..)

60+ , QuoteContext(..)

61+ , SourcePos )

62+

63+-- | An inline note / footnote containing the note key and its (inline) value.

64+type OrgNoteRecord = (String, F Blocks)

65+-- | Table of footnotes

66+type OrgNoteTable = [OrgNoteRecord]

67+-- | Map of org block attributes (e.g. LABEL, CAPTION, NAME, etc)

68+type OrgBlockAttributes = M.Map String String

69+-- | Map of functions for link transformations. The map key is refers to the

70+-- link-type, the corresponding function transforms the given link string.

71+type OrgLinkFormatters = M.Map String (String -> String)

72+

73+-- | Org-mode parser state

74+data OrgParserState = OrgParserState

75+ { orgStateOptions :: ReaderOptions

76+ , orgStateAnchorIds :: [String]

77+ , orgStateBlockAttributes :: OrgBlockAttributes

78+ , orgStateEmphasisCharStack :: [Char]

79+ , orgStateEmphasisNewlines :: Maybe Int

80+ , orgStateLastForbiddenCharPos :: Maybe SourcePos

81+ , orgStateLastPreCharPos :: Maybe SourcePos

82+ , orgStateLastStrPos :: Maybe SourcePos

83+ , orgStateLinkFormatters :: OrgLinkFormatters

84+ , orgStateMeta :: Meta

85+ , orgStateMeta' :: F Meta

86+ , orgStateNotes' :: OrgNoteTable

87+ , orgStateParserContext :: ParserContext

88+ , orgStateIdentifiers :: Set.Set String

89+ , orgStateHeaderMap :: M.Map Inlines String

90+ }

91+

92+data OrgParserLocal = OrgParserLocal { orgLocalQuoteContext :: QuoteContext }

93+

94+instance Default OrgParserLocal where

95+ def = OrgParserLocal NoQuote

96+

97+instance HasReaderOptions OrgParserState where

98+ extractReaderOptions = orgStateOptions

99+

100+instance HasMeta OrgParserState where

101+ setMeta field val st =

102+ st{ orgStateMeta = setMeta field val $ orgStateMeta st }

103+ deleteMeta field st =

104+ st{ orgStateMeta = deleteMeta field $ orgStateMeta st }

105+

106+instance HasLastStrPosition OrgParserState where

107+ getLastStrPos = orgStateLastStrPos

108+ setLastStrPos pos st = st{ orgStateLastStrPos = Just pos }

109+

110+instance HasQuoteContext st (Reader OrgParserLocal) where

111+ getQuoteContext = asks orgLocalQuoteContext

112+ withQuoteContext q = local (\s -> s{orgLocalQuoteContext = q})

113+

114+instance HasIdentifierList OrgParserState where

115+ extractIdentifierList = orgStateIdentifiers

116+ updateIdentifierList f s = s{ orgStateIdentifiers = f (orgStateIdentifiers s) }

117+

118+instance HasHeaderMap OrgParserState where

119+ extractHeaderMap = orgStateHeaderMap

120+ updateHeaderMap f s = s{ orgStateHeaderMap = f (orgStateHeaderMap s) }

121+

122+

123+instance Default OrgParserState where

124+ def = defaultOrgParserState

125+

126+defaultOrgParserState :: OrgParserState

127+defaultOrgParserState = OrgParserState

128+ { orgStateOptions = def

129+ , orgStateAnchorIds = []

130+ , orgStateBlockAttributes = M.empty

131+ , orgStateEmphasisCharStack = []

132+ , orgStateEmphasisNewlines = Nothing

133+ , orgStateLastForbiddenCharPos = Nothing

134+ , orgStateLastPreCharPos = Nothing

135+ , orgStateLastStrPos = Nothing

136+ , orgStateLinkFormatters = M.empty

137+ , orgStateMeta = nullMeta

138+ , orgStateMeta' = return nullMeta

139+ , orgStateNotes' = []

140+ , orgStateParserContext = NullState

141+ , orgStateIdentifiers = Set.empty

142+ , orgStateHeaderMap = M.empty

143+ }

144+

145+

146+--

147+-- Parser state reader

148+--

149+

150+-- | Reader monad wrapping the parser state. This is used to delay evaluation

151+-- until all relevant information has been parsed and made available in the

152+-- parser state. See also the newtype of the same name in

153+-- Text.Pandoc.Parsing.

154+newtype F a = F { unF :: Reader OrgParserState a

155+ } deriving (Functor, Applicative, Monad)

156+

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

158+ mempty = return mempty

159+ mappend = liftM2 mappend

160+ mconcat = fmap mconcat . sequence

161+

162+runF :: F a -> OrgParserState -> a

163+runF = runReader . unF

164+

165+askF :: F OrgParserState

166+askF = F ask

167+

168+asksF :: (OrgParserState -> a) -> F a

169+asksF f = F $ asks f

170+

171+trimInlinesF :: F Inlines -> F Inlines

172+trimInlinesF = liftM trimInlines

173+

174+returnF :: Monad m => a -> m (F a)

175+returnF = return . return