@@ -1,6 +1,5 @@
1+{-# LANGUAGE FlexibleContexts #-}
12{-# LANGUAGE OverloadedStrings #-}
2−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
3−{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, FlexibleInstances #-}
43{-
54Copyright (C) 2014-2016 Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
65
@@ -31,8 +30,7 @@ Conversion of org-mode formatted plain text to 'Pandoc' document.
3130module Text.Pandoc.Readers.Org ( readOrg ) where
3231
3332import qualified Text.Pandoc.Builder as B
34−import Text.Pandoc.Builder ( Inlines, Blocks, HasMeta(..),
35− trimInlines )
33+import Text.Pandoc.Builder ( Inlines, Blocks )
3634import Text.Pandoc.Definition
3735import Text.Pandoc.Compat.Monoid ((<>))
3836import Text.Pandoc.Error
@@ -43,153 +41,33 @@ import Text.Pandoc.Parsing hiding ( F, unF, askF, asksF, runF
4341 , parseFromString, blanklines
4442 )
4543import Text.Pandoc.Readers.LaTeX (inlineCommand, rawLaTeXInline)
44+import Text.Pandoc.Readers.Org.ParserState
4645import Text.Pandoc.Shared (compactify', compactify'DL)
4746import Text.TeXMath (readTeX, writePandoc, DisplayType(..))
4847import qualified Text.TeXMath.Readers.MathML.EntityMap as MathMLEntityMap
4948
5049import Control.Arrow (first)
51−import Control.Monad (foldM, guard, liftM, liftM2, mplus, mzero, when)
52−import Control.Monad.Reader (Reader, runReader, ask, asks, local)
50+import Control.Monad (foldM, guard, mplus, mzero, when)
51+import Control.Monad.Reader ( Reader, runReader )
5352import Data.Char (isAlphaNum, isSpace, toLower)
54−import Data.Default
5553import Data.List (intersperse, isPrefixOf, isSuffixOf)
5654import qualified Data.Map as M
57−import qualified Data.Set as Set
5855import Data.Maybe (fromMaybe, isJust)
5956import Network.HTTP (urlEncode)
6057
58+
6159-- | Parse org-mode string and return a Pandoc document.
6260readOrg :: ReaderOptions -- ^ Reader options
6361 -> String -- ^ String to parse (assuming @'\n'@ line endings)
6462 -> Either PandocError Pandoc
6563readOrg opts s = flip runReader def $ readWithM parseOrg def{ orgStateOptions = opts } (s ++ "\n\n")
6664
67−data OrgParserLocal = OrgParserLocal { orgLocalQuoteContext :: QuoteContext }
68−
65+-- | The parser used to read org files.
6966type OrgParser = ParserT [Char] OrgParserState (Reader OrgParserLocal)
7067
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−
12168--
122−-- Parser State for Org
69+-- Functions acting on the parser state
12370--
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−
19371recordAnchorId :: String -> OrgParser ()
19472recordAnchorId i = updateState $ \s ->
19573 s{ orgStateAnchorIds = i : (orgStateAnchorIds s) }
@@ -243,44 +121,65 @@ addToNotesTable note = do
243121 oldnotes <- orgStateNotes' <$> getState
244122 updateState $ \s -> s{ orgStateNotes' = note:oldnotes }
245123
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−
257124--
258−-- Adaptions and specializations of parsing utilities
125+-- Parser
259126--
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)
260134
261−newtype F a = F { unF :: Reader OrgParserState a
262− } deriving (Monad, Applicative, Functor)
135+-- | Drop COMMENT headers and the document tree below those headers.
136+dropCommentTrees :: [Block] -> [Block]
137+dropCommentTrees [] = []
138+dropCommentTrees (b:bs) =
139+ maybe (b:dropCommentTrees bs)
140+ (dropCommentTrees . flip dropUntilHeaderAboveLevel bs)
141+ (commentHeaderLevel b)
263142
264−runF :: F a -> OrgParserState -> a
265−runF = runReader . unF
143+-- | Return the level of a header starting a comment or :noexport: tree and
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
266154
267−askF :: F OrgParserState
268−askF = F ask
155+ isNoExportTag :: Inline -> Bool
156+ isNoExportTag (Span ("", ["tag"], [("data-tag-name", "noexport")]) []) = True
157+ isNoExportTag _ = False
269158
270−asksF :: (OrgParserState -> a) -> F a
271−asksF f = F $ asks f
159+-- | Drop blocks until a header on or above the given level is seen
160+dropUntilHeaderAboveLevel :: Int -> [Block] -> [Block]
161+dropUntilHeaderAboveLevel n = dropWhile (not . isHeaderLevelLowerEq n)
272162
273−instance Monoid a => Monoid (F a) where
274− mempty = return mempty
275− mappend = liftM2 mappend
276− mconcat = fmap mconcat . sequence
163+isHeaderLevelLowerEq :: Int -> Block -> Bool
164+isHeaderLevelLowerEq n blk =
165+ case blk of
166+ (Header level _ _) -> n >= level
167+ _ -> False
277168
278−trimInlinesF :: F Inlines -> F Inlines
279−trimInlinesF = liftM trimInlines
280169
281−returnF :: a -> OrgParser (F a)
282−returnF = return . return
170+--
171+-- Adaptions and specializations of parsing utilities
172+--
283173
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
284183
285184-- | Like @Text.Parsec.Char.newline@, but causes additional state changes.
286185newline :: OrgParser Char