@@ -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,117 @@ 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
124+--
125+-- Export Settings
126+--
127+exportSetting :: OrgParser ()
128+exportSetting = choice
129+ [ booleanSetting "^" setExportSubSuperscripts
130+ , ignoredSetting "'"
131+ , ignoredSetting "*"
132+ , ignoredSetting "-"
133+ , ignoredSetting ":"
134+ , ignoredSetting "<"
135+ , ignoredSetting "\\n"
136+ , ignoredSetting "arch"
137+ , ignoredSetting "author"
138+ , ignoredSetting "c"
139+ , ignoredSetting "creator"
140+ , ignoredSetting "d"
141+ , ignoredSetting "date"
142+ , ignoredSetting "e"
143+ , ignoredSetting "email"
144+ , ignoredSetting "f"
145+ , ignoredSetting "H"
146+ , ignoredSetting "inline"
147+ , ignoredSetting "num"
148+ , ignoredSetting "p"
149+ , ignoredSetting "pri"
150+ , ignoredSetting "prop"
151+ , ignoredSetting "stat"
152+ , ignoredSetting "tags"
153+ , ignoredSetting "tasks"
154+ , ignoredSetting "tex"
155+ , ignoredSetting "timestamp"
156+ , ignoredSetting "title"
157+ , ignoredSetting "toc"
158+ , ignoredSetting "todo"
159+ , ignoredSetting "|"
160+ ] <?> "export setting"
161+
162+booleanSetting :: String -> ExportSettingSetter Bool -> OrgParser ()
163+booleanSetting settingIdentifier setter = try $ do
164+ string settingIdentifier
165+ char ':'
166+ value <- many nonspaceChar
167+ let boolValue = case value of
168+ "nil" -> False
169+ "{}" -> False
170+ _ -> True
171+ updateState $ modifyExportSettings setter boolValue
255172
173+ignoredSetting :: String -> OrgParser ()
174+ignoredSetting s = try (() <$ string s <* char ':' <* many nonspaceChar)
256175
257176--
258−-- Adaptions and specializations of parsing utilities
177+-- Parser
259178--
179+parseOrg :: OrgParser Pandoc
180+parseOrg = do
181+ blocks' <- parseBlocks
182+ st <- getState
183+ let meta = runF (orgStateMeta' st) st
184+ let removeUnwantedBlocks = dropCommentTrees . filter (/= Null)
185+ return $ Pandoc meta $ removeUnwantedBlocks (B.toList $ runF blocks' st)
260186
261−newtype F a = F { unF :: Reader OrgParserState a
262− } deriving (Monad, Applicative, Functor)
187+-- | Drop COMMENT headers and the document tree below those headers.
188+dropCommentTrees :: [Block] -> [Block]
189+dropCommentTrees [] = []
190+dropCommentTrees (b:bs) =
191+ maybe (b:dropCommentTrees bs)
192+ (dropCommentTrees . flip dropUntilHeaderAboveLevel bs)
193+ (commentHeaderLevel b)
263194
264−runF :: F a -> OrgParserState -> a
265−runF = runReader . unF
195+-- | Return the level of a header starting a comment or :noexport: tree and
196+-- Nothing otherwise.
197+commentHeaderLevel :: Block -> Maybe Int
198+commentHeaderLevel blk =
199+ case blk of
200+ (Header level _ ((Str "COMMENT"):_)) -> Just level
201+ (Header level _ title) | hasNoExportTag title -> Just level
202+ _ -> Nothing
203+ where
204+ hasNoExportTag :: [Inline] -> Bool
205+ hasNoExportTag = any isNoExportTag
266206
267−askF :: F OrgParserState
268−askF = F ask
207+ isNoExportTag :: Inline -> Bool
208+ isNoExportTag (Span ("", ["tag"], [("data-tag-name", "noexport")]) []) = True
209+ isNoExportTag _ = False
269210
270−asksF :: (OrgParserState -> a) -> F a
271−asksF f = F $ asks f
211+-- | Drop blocks until a header on or above the given level is seen
212+dropUntilHeaderAboveLevel :: Int -> [Block] -> [Block]
213+dropUntilHeaderAboveLevel n = dropWhile (not . isHeaderLevelLowerEq n)
272214
273−instance Monoid a => Monoid (F a) where
274− mempty = return mempty
275− mappend = liftM2 mappend
276− mconcat = fmap mconcat . sequence
215+isHeaderLevelLowerEq :: Int -> Block -> Bool
216+isHeaderLevelLowerEq n blk =
217+ case blk of
218+ (Header level _ _) -> n >= level
219+ _ -> False
277220
278−trimInlinesF :: F Inlines -> F Inlines
279−trimInlinesF = liftM trimInlines
280221
281−returnF :: a -> OrgParser (F a)
282−returnF = return . return
222+--
223+-- Adaptions and specializations of parsing utilities
224+--
283225
226+-- The version Text.Pandoc.Parsing cannot be used, as we need additional parts
227+-- of the state saved and restored.
228+parseFromString :: OrgParser a -> String -> OrgParser a
229+parseFromString parser str' = do
230+ oldLastPreCharPos <- orgStateLastPreCharPos <$> getState
231+ updateState $ \s -> s{ orgStateLastPreCharPos = Nothing }
232+ result <- P.parseFromString parser str'
233+ updateState $ \s -> s{ orgStateLastPreCharPos = oldLastPreCharPos }
234+ return result
284235
285236-- | Like @Text.Parsec.Char.newline@, but causes additional state changes.
286237newline :: OrgParser Char
@@ -691,8 +642,9 @@ optionLine :: OrgParser ()
691642optionLine = try $ do
692643 key <- metaKey
693644 case key of
694− "link" -> parseLinkFormat >>= uncurry addLinkFormat
695− _ -> mzero
645+ "link" -> parseLinkFormat >>= uncurry addLinkFormat
646+ "options" -> () <$ sepBy spaces exportSetting
647+ _ -> mzero
696648
697649parseLinkFormat :: OrgParser ((String, String -> String))
698650parseLinkFormat = try $ do
@@ -1561,7 +1513,9 @@ subOrSuperExpr = try $
15611513 where enclosing (left, right) s = left : s ++ [right]
15621514
15631515simpleSubOrSuperString :: OrgParser String
1564−simpleSubOrSuperString = try $
1516+simpleSubOrSuperString = try $ do
1517+ state <- getState
1518+ guard . exportSubSuperscripts . orgStateExportSettings $ state
15651519 choice [ string "*"
15661520 , mappend <$> option [] ((:[]) <$> oneOf "+-")
15671521 <*> many1 alphaNum