Typst reader: handle document metadata and `#title`.

See jgm/typst-hs#80.

Note that previously, the typst reader never returned document
metadata.  Now it does, even if the typst document does not contain
a `#title` function that would result in actually printing the
title block.

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" ]
+            )
+          ]
+    }
+  []
+```