diff --git a/src/Text/Pandoc/Readers/Djot.hs b/src/Text/Pandoc/Readers/Djot.hs index 1c3d216536d9a..0b908d9053814 100644 --- a/src/Text/Pandoc/Readers/Djot.hs +++ b/src/Text/Pandoc/Readers/Djot.hs @@ -2,8 +2,6 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedLists #-} {-# LANGUAGE ScopedTypeVariables #-} {- | @@ -27,6 +25,7 @@ import Text.Pandoc.Sources import Text.Parsec.Pos (sourceName) -- TODO export from T.P.Sources? import Text.Pandoc.Options import Text.Pandoc.Definition +import Text.Pandoc.Shared (addPandocAttributes) import qualified Text.Pandoc.UTF8 as UTF8 import Djot.Options (ParseOptions(..)) import Djot.Blocks (parseDoc) @@ -34,7 +33,11 @@ import qualified Djot.AST as D import Text.Pandoc.Error (PandocError(..)) import Control.Monad.Except (throwError) import qualified Data.Text as T - +import Text.Pandoc.Builder +import Text.Pandoc.Emoji (emojiToInline) +import Control.Monad.Reader +import qualified Data.Foldable as F +import qualified Data.Sequence as Seq -- import Debug.Trace -- | Read Djot from an input string and return a Pandoc document. @@ -47,5 +50,79 @@ readDjot _opts inp = do case parseDoc ParseOptions{ optSourcePositions = False } (UTF8.fromText $ sourcesToText sources) of Left e -> throwError $ PandocParseError $ T.pack $ show e - Right doc -> do - pure $ Pandoc mempty mempty -- TODO + Right d -> + runReaderT (doc <$> convertBlocks (D.docBlocks d)) + Env{ references = D.docReferences d + , footnotes = D.docFootnotes d } + +data Env = + Env{ references :: D.ReferenceMap + , footnotes :: D.NoteMap } + deriving (Show, Ord, Eq) + +convertBlocks :: PandocMonad m => D.Blocks -> ReaderT Env m Blocks +convertBlocks = fmap mconcat . mapM convertBlock . F.toList . D.unBlocks + +convertBlock :: PandocMonad m => D.Node D.Block -> ReaderT Env m Blocks +convertBlock (D.Node attr bl) = addAttrToBlock attr <$> + case bl of + D.Para ils -> para <$> convertInlines ils + D.Section bls -> divWith ("",["section"],[]) <$> convertBlocks bls + D.Heading lev ils -> header lev <$> convertInlines ils + D.BlockQuote bls -> blockQuote <$> convertBlocks bls + D.CodeBlock lang bs -> pure $ + codeBlockWith ("", [UTF8.toText lang], []) $ UTF8.toText bs + D.Div bls -> divWith nullAttr <$> convertBlocks bls + D.OrderedList listAttr listSpacing items -> pure mempty -- TODO + D.BulletList listSpacing items -> pure mempty -- TODO + D.TaskList listSpacing items -> pure mempty -- TODO -- [(TaskStatus, Blocks)] + D.DefinitionList listSpacing items -> pure mempty -- TODO -- [(Inlines, Blocks)] + D.ThematicBreak -> pure horizontalRule + D.Table mbCaption rows -> pure mempty -- TODO -- [[Cell]] + D.RawBlock (D.Format fmt) bs -> pure $ + rawBlock (UTF8.toText fmt) (UTF8.toText bs) + +addAttrToBlock :: D.Attr -> Blocks -> Blocks +addAttrToBlock attr = + case attr of + D.Attr [] -> id + D.Attr as -> addPandocAttributes + (map (\(k,v) -> (UTF8.toText k, UTF8.toText v)) as) + +convertInlines :: PandocMonad m => D.Inlines -> ReaderT Env m Inlines +convertInlines = fmap mconcat . mapM convertInline . F.toList . D.unInlines + +convertInline :: PandocMonad m => D.Node D.Inline -> ReaderT Env m Inlines +convertInline (D.Node attr il) = addAttrToInline attr <$> + case il of + D.Str bs -> pure $ str (UTF8.toText bs) + D.Emph ils -> emph <$> convertInlines ils + D.Strong ils -> strong <$> convertInlines ils + D.Highlight ils -> spanWith ("",["highlighted"],[]) <$> convertInlines ils + D.Insert ils -> spanWith ("",["inserted"],[]) <$> convertInlines ils + D.Delete ils -> spanWith ("",["deleted"],[]) <$> convertInlines ils + D.Subscript ils -> subscript <$> convertInlines ils + D.Superscript ils -> superscript <$> convertInlines ils + D.Span ils -> spanWith nullAttr <$> convertInlines ils + D.Verbatim bs -> pure $ code (UTF8.toText bs) + D.Symbol bs -> pure $ + let s = UTF8.toText bs + in maybe (spanWith ("",["symbol"],[]) (str s)) singleton $ emojiToInline s + D.Math sty bs -> pure mempty -- TODO + D.Link ils tgt -> pure mempty -- TODO + D.Image ils tgt -> pure mempty -- TODO + D.FootnoteReference bs -> pure mempty -- TODO + D.UrlLink bs -> pure mempty -- TODO + D.EmailLink bs -> pure mempty -- TODO + D.RawInline (D.Format fbs) bs -> pure $ + rawInline (UTF8.toText fbs) (UTF8.toText bs) + D.NonBreakingSpace -> pure $ str "\160" + D.SoftBreak -> pure softbreak + D.HardBreak -> pure linebreak + +addAttrToInline :: D.Attr -> Inlines -> Inlines +addAttrToInline attr = + case attr of + D.Attr [] -> id + D.Attr as -> addPandocAttributes + (map (\(k,v) -> (UTF8.toText k, UTF8.toText v)) as)