diff --git a/src/Text/Pandoc/Readers/Djot.hs b/src/Text/Pandoc/Readers/Djot.hs index a28d1c92dac83..e4a9f902f2317 100644 --- a/src/Text/Pandoc/Readers/Djot.hs +++ b/src/Text/Pandoc/Readers/Djot.hs @@ -38,7 +38,6 @@ import Text.Pandoc.Logging 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. @@ -74,8 +73,11 @@ convertBlock (D.Node attr bl) = addAttrToBlock attr <$> D.CodeBlock lang bs -> pure $ codeBlockWith ("", [UTF8.toText lang], []) $ UTF8.toText bs D.Div bls -> divWith nullAttr <$> convertBlocks bls - D.OrderedList olattr listSpacing items -> -- TODO handle tight/loose listSpacing - orderedListWith olattr' <$> mapM convertBlocks items + D.OrderedList olattr listSpacing items -> + orderedListWith olattr' . + (case listSpacing of + D.Tight -> map toTight + D.Loose -> id) <$> mapM convertBlocks items where olattr' = ( D.orderedListStart olattr , case D.orderedListStyle olattr of @@ -89,11 +91,17 @@ convertBlock (D.Node attr bl) = addAttrToBlock attr <$> D.RightParen -> OneParen D.LeftRightParen -> TwoParens ) - D.BulletList listSpacing items -> -- TODO handle listSpacing - bulletList <$> mapM convertBlocks items + D.BulletList listSpacing items -> + bulletList . + (case listSpacing of + D.Tight -> map toTight + D.Loose -> id) <$> mapM convertBlocks items D.TaskList listSpacing items -> pure $ para $ str "TASKLIST TODO" -- TODO -- [(TaskStatus, Blocks)] - D.DefinitionList listSpacing items -> -- TODO handle listSpacing - definitionList <$> mapM toDlItem items + D.DefinitionList listSpacing items -> + definitionList . + (case listSpacing of + D.Tight -> map (\(t,d) -> (t, map toTight d)) + D.Loose -> id) <$> mapM toDlItem items where toDlItem (ils,bls) = (,) <$> convertInlines ils <*> ((:[]) <$> convertBlocks bls) D.ThematicBreak -> pure horizontalRule @@ -181,3 +189,9 @@ addAttrToInline attr = D.Attr [] -> id D.Attr as -> addPandocAttributes (map (\(k,v) -> (UTF8.toText k, UTF8.toText v)) as) + +toTight :: Blocks -> Blocks +toTight (Many bls) = Many $ paraToPlain <$> bls + where + paraToPlain (Para ils) = Plain ils + paraToPlain x = x