From 54f6faa10f79a7e9172c67a9d860689269aa6cc3 Mon Sep 17 00:00:00 2001
From: Albert Krewinkel <albert@zeitkraut.de>
Date: Sun, 28 Jun 2020 15:30:45 +0200
Subject: Org reader: refactor export setting handling
---
src/Text/Pandoc/Readers/Org/Meta.hs | 146 +++++++++++++++++-------------------
1 file changed, 67 insertions(+), 79 deletions(-)
(limited to 'src')
diff --git a/src/Text/Pandoc/Readers/Org/Meta.hs b/src/Text/Pandoc/Readers/Org/Meta.hs
index 4694ec521..7ee64c2e5 100644
--- a/src/Text/Pandoc/Readers/Org/Meta.hs
+++ b/src/Text/Pandoc/Readers/Org/Meta.hs
@@ -1,6 +1,5 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE TupleSections #-}
{-# LANGUAGE OverloadedStrings #-}
{- |
Module : Text.Pandoc.Readers.Org.Meta
@@ -23,20 +22,21 @@ import Text.Pandoc.Readers.Org.Inlines
import Text.Pandoc.Readers.Org.ParserState
import Text.Pandoc.Readers.Org.Parsing
-import Text.Pandoc.Builder (Blocks, Inlines)
+import Text.Pandoc.Builder (Blocks, Inlines, ToMetaValue)
import qualified Text.Pandoc.Builder as B
import Text.Pandoc.Class.PandocMonad (PandocMonad)
import Text.Pandoc.Definition
import Text.Pandoc.Shared (blocksToInlines, safeRead)
-import Control.Monad (mzero, void, when)
+import Control.Monad (mzero, void)
import Data.List (intercalate, intersperse)
+import Data.Map (Map)
import Data.Maybe (fromMaybe)
-import qualified Data.Map as M
-import qualified Data.Set as Set
import Data.Text (Text)
-import qualified Data.Text as T
import Network.HTTP (urlEncode)
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+import qualified Data.Text as T
-- | Returns the current meta, respecting export options.
metaExport :: Monad m => OrgParser m (F Meta)
@@ -51,7 +51,7 @@ metaExport = do
removeMeta :: Text -> Meta -> Meta
removeMeta key meta' =
let metaMap = unMeta meta'
- in Meta $ M.delete key metaMap
+ in Meta $ Map.delete key metaMap
-- | Parse and handle a single line containing meta information
-- The order, in which blocks are tried, makes sure that we're not looking at
@@ -62,69 +62,49 @@ metaLine = mempty <$ metaLineStart <* (optionLine <|> declarationLine)
declarationLine :: PandocMonad m => OrgParser m ()
declarationLine = try $ do
key <- T.toLower <$> metaKey
- (key', value) <- metaValue key
- let addMetaValue st =
- st { orgStateMeta = B.setMeta key' <$> value <*> orgStateMeta st }
- when (key' /= "results") $ updateState addMetaValue
+ case Map.lookup key exportSettingHandlers of
+ Nothing -> () <$ anyLine
+ Just hd -> hd
metaKey :: Monad m => OrgParser m Text
metaKey = T.toLower <$> many1Char (noneOf ": \n\r")
<* char ':'
<* skipSpaces
-metaValue :: PandocMonad m => Text -> OrgParser m (Text, F MetaValue)
-metaValue key =
- let inclKey = "header-includes"
- in case key of
- "author" -> (key,) <$> metaInlinesCommaSeparated
- "keywords" -> (key,) <$> metaInlinesCommaSeparated
- "title" -> (key,) <$> metaInlines
- "subtitle" -> (key,) <$> metaInlines
- "date" -> (key,) <$> metaInlines
- "description" -> (key,) <$> accumulatingInlines key
- "nocite" -> (key,) <$> accumulatingList key metaInlines
- "header-includes" -> (key,) <$> accumulatingList key metaInlines
- "latex_header" -> (inclKey,) <$>
- accumulatingList inclKey (metaExportSnippet "latex")
- "latex_class" -> ("documentclass",) <$> metaString
- -- Org-mode expects class options to contain the surrounding brackets,
- -- pandoc does not.
- "latex_class_options" -> ("classoption",) <$>
- metaModifiedString (T.filter (`notElem` ("[]" :: String)))
- "html_head" -> (inclKey,) <$>
- accumulatingList inclKey (metaExportSnippet "html")
- _ -> (key,) <$> metaString
-
--- TODO Cleanup this mess
-
-metaInlines :: PandocMonad m => OrgParser m (F MetaValue)
-metaInlines = fmap (MetaInlines . B.toList) <$> inlinesTillNewline
-
-metaInlinesCommaSeparated :: PandocMonad m => OrgParser m (F MetaValue)
-metaInlinesCommaSeparated = do
- itemStrs <- many1Char (noneOf ",\n") `sepBy1` char ','
- newline
- items <- mapM (parseFromString inlinesTillNewline . (<> "\n")) itemStrs
- let toMetaInlines = MetaInlines . B.toList
- return $ MetaList . map toMetaInlines <$> sequence items
-
-metaString :: Monad m => OrgParser m (F MetaValue)
-metaString = metaModifiedString id
-
-metaModifiedString :: Monad m => (Text -> Text) -> OrgParser m (F MetaValue)
-metaModifiedString f = return . MetaString . f <$> anyLine
-
--- | Read an format specific meta definition
-metaExportSnippet :: Monad m => Text -> OrgParser m (F MetaValue)
-metaExportSnippet format =
- return . MetaInlines . B.toList . B.rawInline format <$> anyLine
-
-accumulatingInlines :: PandocMonad m
- => Text
- -> OrgParser m (F MetaValue)
-accumulatingInlines key = do
- value <- inlinesTillNewline
- accumulating appendValue (B.toList <$> value)
+exportSettingHandlers :: PandocMonad m => Map Text (OrgParser m ())
+exportSettingHandlers = Map.fromList
+ [ ("result" , fmap pure anyLine `parseThen` discard) -- RESULT is never an export setting
+ , ("author" , commaSepInlines `parseThen` setField "author")
+ , ("keywords" , commaSepInlines `parseThen` setField "keywords")
+ , ("date" , lineOfInlines `parseThen` setField "date")
+ , ("description", lineOfInlines `parseThen` collectSepBy B.SoftBreak "description")
+ , ("title" , lineOfInlines `parseThen` collectSepBy B.Space "title")
+ , ("nocite" , lineOfInlines `parseThen` collectAsList "nocite")
+ , ("latex_class", fmap pure anyLine `parseThen` setField "documentclass")
+ , ("latex_class_options", (pure . T.filter (`notElem` ("[]" :: String)) <$> anyLine)
+ `parseThen` setField "classoption")
+ , ("latex_header", metaExportSnippet "latex" `parseThen`
+ collectAsList "header-includes")
+ , ("html_head" , metaExportSnippet "html" `parseThen`
+ collectAsList "header-includes")
+ ]
+
+parseThen :: PandocMonad m
+ => OrgParser m (F a)
+ -> (a -> Meta -> Meta)
+ -> OrgParser m ()
+parseThen p modMeta = do
+ value <- p
+ meta <- orgStateMeta <$> getState
+ updateState (\st -> st { orgStateMeta = modMeta <$> value <*> meta })
+
+discard :: a -> Meta -> Meta
+discard = const id
+
+collectSepBy :: Inline -> Text -> Inlines -> Meta -> Meta
+collectSepBy sep key value meta =
+ let value' = appendValue meta (B.toList value)
+ in B.setMeta key value' meta
where
appendValue :: Meta -> [Inline] -> MetaValue
appendValue m v = MetaInlines $ curInlines m <> v
@@ -137,32 +117,40 @@ accumulatingInlines key = do
collectInlines :: MetaValue -> [Inline]
collectInlines = \case
MetaInlines inlns -> inlns
- MetaList ml -> intercalate [B.SoftBreak] $ map collectInlines ml
+ MetaList ml -> intercalate [sep] $ map collectInlines ml
MetaString s -> [B.Str s]
MetaBlocks blks -> blocksToInlines blks
MetaMap _map -> []
MetaBool _bool -> []
--- | Accumulate the result of the @parser@ in a list under @key@.
-accumulatingList :: Monad m => Text
- -> OrgParser m (F MetaValue)
- -> OrgParser m (F MetaValue)
-accumulatingList key p = p >>= accumulating metaListAppend
+-- | Accumulate the result as a MetaList under the given key.
+collectAsList :: Text -> Inlines -> Meta -> Meta
+collectAsList key value meta =
+ let value' = metaListAppend meta (B.toMetaValue value)
+ in B.setMeta key value' meta
where
metaListAppend m v = MetaList (curList m ++ [v])
-
curList m = case lookupMeta key m of
Just (MetaList ms) -> ms
Just x -> [x]
_ -> []
-accumulating :: Monad m
- => (Meta -> a -> MetaValue)
- -> F a
- -> OrgParser m (F MetaValue)
-accumulating acc value = do
- meta <- orgStateMeta <$> getState
- return $ acc <$> meta <*> value
+setField :: ToMetaValue a => Text -> a -> Meta -> Meta
+setField field value meta = B.setMeta field (B.toMetaValue value) meta
+
+lineOfInlines :: PandocMonad m => OrgParser m (F Inlines)
+lineOfInlines = inlinesTillNewline
+
+commaSepInlines :: PandocMonad m => OrgParser m (F [Inlines])
+commaSepInlines = do
+ itemStrs <- many1Char (noneOf ",\n") `sepBy1` char ','
+ newline
+ items <- mapM (parseFromString inlinesTillNewline . (<> "\n")) itemStrs
+ return $ sequence items
+
+-- | Read an format specific meta definition
+metaExportSnippet :: Monad m => Text -> OrgParser m (F Inlines)
+metaExportSnippet format = pure . B.rawInline format <$> anyLine
--
-- export options
@@ -188,7 +176,7 @@ addLinkFormat :: Monad m => Text
-> OrgParser m ()
addLinkFormat key formatter = updateState $ \s ->
let fs = orgStateLinkFormatters s
- in s{ orgStateLinkFormatters = M.insert key formatter fs }
+ in s{ orgStateLinkFormatters = Map.insert key formatter fs }
parseLinkFormat :: Monad m => OrgParser m (Text, Text -> Text)
parseLinkFormat = try $ do
--
cgit v1.2.3