diff options
| -rw-r--r-- | cabal.project | 2 | ||||
| -rw-r--r-- | src/Text/Pandoc/Readers/Typst.hs | 72 | ||||
| -rw-r--r-- | src/Text/Pandoc/Readers/Typst/Parsing.hs | 9 | ||||
| -rw-r--r-- | stack.yaml | 2 | ||||
| -rw-r--r-- | test/command/typst-hs-80.md | 55 |
5 files changed, 101 insertions, 39 deletions
diff --git a/cabal.project b/cabal.project index 645e435ef..cde40b430 100644 --- a/cabal.project +++ b/cabal.project @@ -15,7 +15,7 @@ source-repository-package source-repository-package type: git location: https://github.com/jgm/typst-hs.git - tag: e6eb442bc0efbe3fcf8c1fe5f28be3f0fb278e8b + tag: 13751c5b3a6b395ba667682bc7a876c0b993e9d3 source-repository-package type: git diff --git a/src/Text/Pandoc/Readers/Typst.hs b/src/Text/Pandoc/Readers/Typst.hs index 535038c16..486a644b0 100644 --- a/src/Text/Pandoc/Readers/Typst.hs +++ b/src/Text/Pandoc/Readers/Typst.hs @@ -1,4 +1,5 @@ {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE OverloadedStrings #-} @@ -33,7 +34,7 @@ import Control.Monad.Except (throwError) import Control.Monad (MonadPlus (mplus), void, guard, foldM) import qualified Data.Foldable as F import qualified Data.Map as M -import Data.Maybe (catMaybes, fromMaybe) +import Data.Maybe (catMaybes, fromMaybe, isJust) import Data.Sequence (Seq) import qualified Data.Sequence as Seq import qualified Data.Set as Set @@ -158,39 +159,34 @@ pPandoc :: PandocMonad m => P m B.Pandoc pPandoc = do Elt "document" _ fields <- pTok isDocument bs <- getField "body" fields >>= pWithContents pBlocks - pure $ B.doc bs - -- The following alternative code would add metadata from the - -- fields on the document element. It is commented out because - -- the typst metadata doesn't print anything by default, in contrast - -- to pandoc with its usual templates. Hence, with this code, - -- converting a typst document might yield a double title, author, etc. - -- - -- title <- (getField "title" fields >>= pWithContents pInlines) <|> - -- pure mempty - -- authors <- (getField "author" fields >>= - -- mapM (pWithContents pInlines) . V.toList) <|> - -- ((:[]) <$> (getField "author" fields >>= - -- (\x -> guard (not (null x)) *> - -- pWithContents pInlines x))) <|> - -- pure [] - -- date <- (getField "date" fields >>= pWithContents pInlines) <|> - -- pure mempty - -- keywords <- (getField "keywords" fields >>= - -- mapM (pWithContents pInlines) . V.toList) - -- <|> pure [] - -- pure $ - -- (if title == mempty - -- then id - -- else B.setMeta "title" title) . - -- (if null authors - -- then id - -- else B.setMeta "author" authors) . - -- (if null date - -- then id - -- else B.setMeta "date" date) . - -- (if null keywords - -- then id - -- else B.setMeta "keywords" keywords) $ B.doc bs + title <- (getField "title" fields >>= pWithContents pInlines) <|> + pure mempty + authors <- (getField "author" fields >>= + mapM (pWithContents pInlines) . V.toList) <|> + ((:[]) <$> (getField "author" fields >>= + (\x -> guard (not (null x)) *> + pWithContents pInlines x))) <|> + pure [] + date <- (getField "date" fields >>= pWithContents pInlines) <|> + pure mempty + keywords <- (getField "keywords" fields >>= + mapM (pWithContents pInlines) . V.toList) + <|> pure [] + meta <- sMeta <$> getState + let meta' = + (if title == mempty || isJust (lookupMeta "title" meta) + then id + else B.setMeta "title" title) . + (if null authors + then id + else B.setMeta "author" authors) . + (if null date + then id + else B.setMeta "date" date) . + (if null keywords + then id + else B.setMeta "keywords" keywords) $ meta + pure $ Pandoc meta' (B.toList bs) pBlocks :: PandocMonad m => P m B.Blocks pBlocks = mconcat <$> many pBlock @@ -252,6 +248,14 @@ blockHandlers = M.fromList -- sometimes text elements include para breaks notFollowedBy $ void $ pWithContents pInlines body pWithContents pBlocks body) + ,("title", \_ _ fields -> do + body <- getField "body" fields + case body of + VContent cs -> do + ils <- pWithContents pInlines cs <|> pure mempty + updateState $ \s -> s{ sMeta = B.setMeta "title" ils (sMeta s) } + pure mempty + _ -> pure mempty) ,("box", \_ _ fields -> do body <- getField "body" fields B.divWith ("", ["box"], []) <$> pWithContents pBlocks body) diff --git a/src/Text/Pandoc/Readers/Typst/Parsing.hs b/src/Text/Pandoc/Readers/Typst/Parsing.hs index b7b725c6f..92a2be4ca 100644 --- a/src/Text/Pandoc/Readers/Typst/Parsing.hs +++ b/src/Text/Pandoc/Readers/Typst/Parsing.hs @@ -27,15 +27,18 @@ import Typst.Types ( Identifier, Content(Elt), FromVal(..), Val(VNone) ) import Text.Pandoc.Class.PandocMonad ( PandocMonad, report ) import Text.Pandoc.Logging (LogMessage(..)) +import Text.Pandoc.Definition -newtype PState = PState - { sLabels :: [Text]} +data PState = PState + { sLabels :: [Text] + , sMeta :: Meta } deriving (Show) defaultPState :: PState defaultPState = PState - { sLabels = [] } + { sLabels = [] + , sMeta = mempty } type P m a = ParsecT [Content] PState m a -- state tracks a list of labels in the document diff --git a/stack.yaml b/stack.yaml index 4e8692dbf..be94c236a 100644 --- a/stack.yaml +++ b/stack.yaml @@ -20,7 +20,7 @@ extra-deps: - git: https://github.com/jgm/citeproc.git commit: 1a82c13ac1d8e9e07cf69fbf89ba2b57474b8e0f - git: https://github.com/jgm/typst-hs.git - commit: e6eb442bc0efbe3fcf8c1fe5f28be3f0fb278e8b + commit: 13751c5b3a6b395ba667682bc7a876c0b993e9d3 - git: https://github.com/jgm/texmath.git commit: 110322589698df20abf3f3a06c070271802ea598 ghc-options: diff --git a/test/command/typst-hs-80.md b/test/command/typst-hs-80.md new file mode 100644 index 000000000..ed0e9228c --- /dev/null +++ b/test/command/typst-hs-80.md @@ -0,0 +1,55 @@ +``` +% pandoc -f typst -t native -s +#set document( + title: [My Title], +) + +#title() +^D +Pandoc + Meta + { unMeta = + fromList + [ ( "title" + , MetaInlines [ Str "My" , Space , Str "Title" ] + ) + ] + } + [] +``` + +``` +% pandoc -f typst -t native -s +#set document( + title: [ignored], +) + +#title[My Title] +^D +Pandoc + Meta + { unMeta = + fromList + [ ( "title" + , MetaInlines [ Str "My" , Space , Str "Title" ] + ) + ] + } + [] +``` + +``` +% pandoc -f typst -t native -s +#title[My Title] +^D +Pandoc + Meta + { unMeta = + fromList + [ ( "title" + , MetaInlines [ Str "My" , Space , Str "Title" ] + ) + ] + } + [] +``` |