diff options
| -rw-r--r-- | src/Text/Pandoc/Readers/Org/Meta.hs | 56 | ||||
| -rw-r--r-- | test/Tests/Readers/Org/Meta.hs | 22 |
2 files changed, 63 insertions, 15 deletions
diff --git a/src/Text/Pandoc/Readers/Org/Meta.hs b/src/Text/Pandoc/Readers/Org/Meta.hs index fcdcd418f..4694ec521 100644 --- a/src/Text/Pandoc/Readers/Org/Meta.hs +++ b/src/Text/Pandoc/Readers/Org/Meta.hs @@ -1,4 +1,5 @@ {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE OverloadedStrings #-} {- | @@ -26,10 +27,10 @@ import Text.Pandoc.Builder (Blocks, Inlines) import qualified Text.Pandoc.Builder as B import Text.Pandoc.Class.PandocMonad (PandocMonad) import Text.Pandoc.Definition -import Text.Pandoc.Shared (safeRead) +import Text.Pandoc.Shared (blocksToInlines, safeRead) import Control.Monad (mzero, void, when) -import Data.List (intersperse) +import Data.List (intercalate, intersperse) import Data.Maybe (fromMaybe) import qualified Data.Map as M import qualified Data.Set as Set @@ -80,6 +81,7 @@ metaValue key = "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,) <$> @@ -93,6 +95,8 @@ metaValue key = accumulatingList inclKey (metaExportSnippet "html") _ -> (key,) <$> metaString +-- TODO Cleanup this mess + metaInlines :: PandocMonad m => OrgParser m (F MetaValue) metaInlines = fmap (MetaInlines . B.toList) <$> inlinesTillNewline @@ -115,18 +119,50 @@ 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) + where + appendValue :: Meta -> [Inline] -> MetaValue + appendValue m v = MetaInlines $ curInlines m <> v + + curInlines m = case collectInlines <$> lookupMeta key m of + Nothing -> [] + Just [] -> [] + Just xs -> xs <> [B.SoftBreak] + + collectInlines :: MetaValue -> [Inline] + collectInlines = \case + MetaInlines inlns -> inlns + MetaList ml -> intercalate [B.SoftBreak] $ 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 = do - value <- p - meta' <- orgStateMeta <$> getState - return $ (\m v -> MetaList (curList m ++ [v])) <$> meta' <*> value - where curList m = case lookupMeta key m of - Just (MetaList ms) -> ms - Just x -> [x] - _ -> [] +accumulatingList key p = p >>= accumulating metaListAppend + 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 -- -- export options diff --git a/test/Tests/Readers/Org/Meta.hs b/test/Tests/Readers/Org/Meta.hs index c3ace78d4..27fd20744 100644 --- a/test/Tests/Readers/Org/Meta.hs +++ b/test/Tests/Readers/Org/Meta.hs @@ -65,11 +65,23 @@ tests = meta = setMeta "date" (MetaInlines date) nullMeta in Pandoc meta mempty - , "Description" =: - "#+DESCRIPTION: Explanatory text" =?> - let description = "Explanatory text" - meta = setMeta "description" (MetaString description) nullMeta - in Pandoc meta mempty + , testGroup "Description" + [ "Single line" =: + "#+DESCRIPTION: Explanatory text" =?> + let description = [Str "Explanatory", Space, Str "text"] + meta = setMeta "description" (MetaInlines description) nullMeta + in Pandoc meta mempty + + , "Multiline" =: + T.unlines [ "#+DESCRIPTION: /Short/ introduction" + , "#+DESCRIPTION: to Org-mode" + ] =?> + let description = [ Emph [Str "Short"], Space, Str "introduction", SoftBreak + , Str "to", Space, Str "Org-mode" + ] + meta = setMeta "description" (MetaInlines description) nullMeta + in Pandoc meta mempty + ] , "Properties drawer" =: T.unlines [ " :PROPERTIES:" |