Use a copy of the Pandoc AST

lib/Patat/Eval.hs

@@ -26,10 +26,10 @@ import qualified Data.Text.IO                   as T
 import           Patat.Eval.Internal
 import           Patat.Presentation.Instruction
 import           Patat.Presentation.Internal
+import           Patat.Presentation.Syntax
 import           System.Exit                    (ExitCode (..))
 import qualified System.IO                      as IO
 import qualified System.Process                 as Process
-import qualified Text.Pandoc.Definition         as Pandoc
 
 
 --------------------------------------------------------------------------------
@@ -70,8 +70,8 @@ evalSlide settings slide = case slideContent slide of
 
 --------------------------------------------------------------------------------
 evalInstruction
-    :: EvalSettingsMap -> Instruction Pandoc.Block
-    -> ExtractEvalM [Instruction Pandoc.Block]
+    :: EvalSettingsMap -> Instruction Block
+    -> ExtractEvalM [Instruction Block]
 evalInstruction settings instr = case instr of
     Pause         -> pure [Pause]
     ModifyLast i  -> map ModifyLast <$> evalInstruction settings i
@@ -85,9 +85,9 @@ evalInstruction settings instr = case instr of
 
 --------------------------------------------------------------------------------
 evalBlock
-    :: EvalSettingsMap -> Pandoc.Block
-    -> ExtractEvalM [Instruction Pandoc.Block]
-evalBlock settings orig@(Pandoc.CodeBlock attr@(_, classes, _) txt)
+    :: EvalSettingsMap -> Block
+    -> ExtractEvalM [Instruction Block]
+evalBlock settings orig@(CodeBlock attr@(_, classes, _) txt)
     | [s@EvalSettings {..}] <- lookupSettings classes settings = do
         var <- state freshVar
         tell $ HMS.singleton var $ EvalBlock s attr txt Nothing
@@ -103,7 +103,7 @@ evalBlock settings orig@(Pandoc.CodeBlock attr@(_, classes, _) txt)
     | _ : _ : _ <- lookupSettings classes settings =
         let msg = "patat eval matched multiple settings for " <>
                 T.intercalate "," classes in
-        pure [Append [Pandoc.CodeBlock attr msg]]
+        pure [Append [CodeBlock attr msg]]
 evalBlock _ block =
     pure [Append [block]]
 
@@ -117,7 +117,7 @@ newAccum f = do
 
 
 --------------------------------------------------------------------------------
-evalVar :: Var -> ([Pandoc.Block] -> IO ()) -> Presentation -> IO Presentation
+evalVar :: Var -> ([Block] -> IO ()) -> Presentation -> IO Presentation
 evalVar var writeOutput presentation = case HMS.lookup var evalBlocks of
     Nothing -> pure presentation
     Just EvalBlock {..} | Just _ <- ebAsync -> pure presentation
@@ -159,7 +159,7 @@ evalVar var writeOutput presentation = case HMS.lookup var evalBlocks of
 
 --------------------------------------------------------------------------------
 evalActiveVars
-    :: (Var -> [Pandoc.Block] -> IO ()) -> Presentation -> IO Presentation
+    :: (Var -> [Block] -> IO ()) -> Presentation -> IO Presentation
 evalActiveVars update presentation = foldM
     (\p var -> evalVar var (update var) p)
     presentation

lib/Patat/Eval/Internal.hs

@@ -13,6 +13,7 @@ import qualified Data.HashMap.Strict            as HMS
 import qualified Data.Text                      as T
 import           Patat.Presentation.Instruction
 import           Patat.Presentation.Settings
+import           Patat.Presentation.Syntax
 import qualified Text.Pandoc                    as Pandoc
 
 
@@ -31,10 +32,10 @@ data EvalBlock = EvalBlock
 
 
 --------------------------------------------------------------------------------
-renderEvalBlock :: EvalBlock -> T.Text -> [Pandoc.Block]
+renderEvalBlock :: EvalBlock -> T.Text -> [Block]
 renderEvalBlock EvalBlock {..} out = case evalContainer ebSettings of
-    EvalContainerCode   -> [Pandoc.CodeBlock ebAttr out]
-    EvalContainerNone   -> [Pandoc.RawBlock fmt out]
-    EvalContainerInline -> [Pandoc.Plain [Pandoc.RawInline fmt out]]
+    EvalContainerCode   -> [CodeBlock ebAttr out]
+    EvalContainerNone   -> [RawBlock fmt out]
+    EvalContainerInline -> [Plain [Pandoc.RawInline fmt out]]
   where
     fmt = "eval"

lib/Patat/Presentation/Comments.hs

@@ -35,9 +35,9 @@ import qualified Data.Yaml                   as Yaml
 import           Patat.EncodingFallback      (EncodingFallback)
 import qualified Patat.EncodingFallback      as EncodingFallback
 import           Patat.Presentation.Settings
+import           Patat.Presentation.Syntax
 import           System.Directory            (removeFile)
 import qualified System.IO                   as IO
-import qualified Text.Pandoc                 as Pandoc
 
 
 --------------------------------------------------------------------------------
@@ -65,8 +65,9 @@ instance Monoid Comment where
 
 
 --------------------------------------------------------------------------------
-parse :: Pandoc.Block -> Maybe Comment
-parse (Pandoc.RawBlock "html" t0) =
+-- TODO: move to 'fromPandoc'
+parse :: Block -> Maybe Comment
+parse (RawBlock "html" t0) =
     (do
         t1 <- T.stripPrefix "<!--config:" t0
         t2 <- T.stripSuffix "-->" t1
@@ -81,14 +82,14 @@ parse _ = Nothing
 
 
 --------------------------------------------------------------------------------
-remove :: [Pandoc.Block] -> [Pandoc.Block]
+remove :: [Block] -> [Block]
 remove = snd . partition
 
 
 --------------------------------------------------------------------------------
 -- | Take all comments from the front of the list.  Return those and the
 -- remaining blocks.
-split :: [Pandoc.Block] -> (Comment, [Pandoc.Block])
+split :: [Block] -> (Comment, [Block])
 split = go []
   where
     go sn []                           = (mconcat (reverse sn), [])
@@ -98,7 +99,7 @@ split = go []
 
 --------------------------------------------------------------------------------
 -- | Partition the list into speaker notes and other blocks.
-partition :: [Pandoc.Block] -> (Comment, [Pandoc.Block])
+partition :: [Block] -> (Comment, [Block])
 partition = go [] []
   where
     go sn bs []                           = (mconcat (reverse sn), reverse bs)

lib/Patat/Presentation/Display.hs

@@ -1,4 +1,5 @@
 --------------------------------------------------------------------------------
+{-# LANGUAGE LambdaCase        #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards   #-}
 module Patat.Presentation.Display
@@ -24,14 +25,14 @@ import           Patat.Presentation.Display.Internal
 import           Patat.Presentation.Display.Table
 import           Patat.Presentation.Internal
 import           Patat.Presentation.Settings
+import           Patat.Presentation.Syntax
 import           Patat.PrettyPrint                    ((<$$>), (<+>))
 import qualified Patat.PrettyPrint                    as PP
 import           Patat.Size
 import           Patat.Theme                          (Theme (..))
 import qualified Patat.Theme                          as Theme
 import           Prelude
 import qualified Text.Pandoc.Extended                 as Pandoc
-import qualified Text.Pandoc.Writers.Shared           as Pandoc
 
 
 --------------------------------------------------------------------------------
@@ -118,11 +119,11 @@ displayPresentation size pres@Presentation {..} =
   where
     -- Check if the fragment consists of "just a single image".  Discard
     -- headers.
-    onlyImage (Fragment (Pandoc.Header{} : bs)) = onlyImage (Fragment bs)
+    onlyImage (Fragment (Header{} : bs)) = onlyImage (Fragment bs)
     onlyImage (Fragment bs) = case bs of
-        [Pandoc.Figure _ _ bs']                      -> onlyImage (Fragment bs')
-        [Pandoc.Para [Pandoc.Image _ _ (target, _)]] -> Just target
-        _                                            -> Nothing
+        [Figure _ _ bs']                      -> onlyImage (Fragment bs')
+        [Para [Pandoc.Image _ _ (target, _)]] -> Just target
+        _                                     -> Nothing
 
 
 --------------------------------------------------------------------------------
@@ -219,21 +220,21 @@ prettyFragment ds (Fragment blocks) = vertical $
 
 
 --------------------------------------------------------------------------------
-prettyBlock :: DisplaySettings -> Pandoc.Block -> PP.Doc
+prettyBlock :: DisplaySettings -> Block -> PP.Doc
 
-prettyBlock ds (Pandoc.Plain inlines) = prettyInlines ds inlines
+prettyBlock ds (Plain inlines) = prettyInlines ds inlines
 
-prettyBlock ds (Pandoc.Para inlines) =
+prettyBlock ds (Para inlines) =
     prettyInlines ds inlines <> PP.hardline
 
-prettyBlock ds (Pandoc.Header i _ inlines) =
+prettyBlock ds (Header i _ inlines) =
     themed ds themeHeader (PP.string (replicate i '#') <+> prettyInlines ds inlines) <>
     PP.hardline
 
-prettyBlock ds (Pandoc.CodeBlock (_, classes, _) txt) =
+prettyBlock ds (CodeBlock (_, classes, _) txt) =
     prettyCodeBlock ds classes txt
 
-prettyBlock ds (Pandoc.BulletList bss) = PP.vcat
+prettyBlock ds (BulletList bss) = PP.vcat
     [ PP.indent
         (PP.Indentation 2 $ themed ds themeBulletList prefix)
         (PP.Indentation 4 mempty)
@@ -254,7 +255,7 @@ prettyBlock ds (Pandoc.BulletList bss) = PP.vcat
         }
     ds'    = ds {dsTheme = theme'}
 
-prettyBlock ds (Pandoc.OrderedList _ bss) = PP.vcat
+prettyBlock ds (OrderedList _ bss) = PP.vcat
     [ PP.indent
         (PP.Indentation 0 $ themed ds themeOrderedList $ PP.string prefix)
         (PP.Indentation 4 mempty)
@@ -268,15 +269,15 @@ prettyBlock ds (Pandoc.OrderedList _ bss) = PP.vcat
         | i <- [1 .. length bss]
         ]
 
-prettyBlock _ds (Pandoc.RawBlock _ t) = PP.text t <> PP.hardline
+prettyBlock _ds (RawBlock _ t) = PP.text t <> PP.hardline
 
-prettyBlock _ds Pandoc.HorizontalRule = "---"
+prettyBlock _ds HorizontalRule = "---"
 
-prettyBlock ds (Pandoc.BlockQuote bs) =
+prettyBlock ds (BlockQuote bs) =
     let quote = PP.Indentation 0 (themed ds themeBlockQuote "> ") in
     PP.indent quote quote (themed ds themeBlockQuote $ prettyBlocks ds bs)
 
-prettyBlock ds (Pandoc.DefinitionList terms) =
+prettyBlock ds (DefinitionList terms) =
     PP.vcat $ map prettyDefinition terms
   where
     prettyDefinition (term, definitions) =
@@ -285,42 +286,46 @@ prettyBlock ds (Pandoc.DefinitionList terms) =
         [ PP.indent
             (PP.Indentation 0 (themed ds themeDefinitionList ":   "))
             (PP.Indentation 4 mempty) $
-            prettyBlocks ds (Pandoc.plainToPara definition)
+            prettyBlocks ds (plainToPara definition)
         | definition <- definitions
         ]
 
-prettyBlock ds (Pandoc.Table _ caption specs thead tbodies tfoot) =
+    plainToPara :: [Block] -> [Block]
+    plainToPara = map $ \case
+        Plain inlines -> Para inlines
+        block         -> block
+
+
+prettyBlock ds (Table caption aligns headers rows) =
     PP.wrapAt Nothing $
-    prettyTable ds Table
-        { tCaption = prettyInlines ds caption'
-        , tAligns  = map align aligns
-        , tHeaders = map (prettyBlocks ds) headers
-        , tRows    = map (map (prettyBlocks ds)) rows
+    prettyTableDisplay ds TableDisplay
+        { tdCaption = prettyInlines ds caption
+        , tdAligns  = map align aligns
+        , tdHeaders = map (prettyBlocks ds) headers
+        , tdRows    = map (map (prettyBlocks ds)) rows
         }
   where
-    (caption', aligns, _, headers, rows) = Pandoc.toLegacyTable
-        caption specs thead tbodies tfoot
-
     align Pandoc.AlignLeft    = PP.AlignLeft
     align Pandoc.AlignCenter  = PP.AlignCenter
     align Pandoc.AlignDefault = PP.AlignLeft
     align Pandoc.AlignRight   = PP.AlignRight
 
-prettyBlock ds (Pandoc.Div _attrs blocks) = prettyBlocks ds blocks
+prettyBlock ds (Div _attrs blocks) = prettyBlocks ds blocks
 
-prettyBlock ds (Pandoc.LineBlock inliness) =
+prettyBlock ds (LineBlock inliness) =
     let ind = PP.Indentation 0 (themed ds themeLineBlock "| ") in
     PP.wrapAt Nothing $
     PP.indent ind ind $
     PP.vcat $
     map (prettyInlines ds) inliness
 
-prettyBlock ds (Pandoc.Figure _attr _caption blocks) =
+prettyBlock ds (Figure _attr _caption blocks) =
+    -- TODO: the fromPandoc conversion here is weird
     prettyBlocks ds blocks
 
 
 --------------------------------------------------------------------------------
-prettyBlocks :: DisplaySettings -> [Pandoc.Block] -> PP.Doc
+prettyBlocks :: DisplaySettings -> [Block] -> PP.Doc
 prettyBlocks ds = PP.vcat . map (prettyBlock ds)
 
 
@@ -377,7 +382,10 @@ prettyInline _ (Pandoc.RawInline _ t) = PP.text t
 -- These elements aren't really supported.
 prettyInline ds  (Pandoc.Cite      _ t) = prettyInlines ds t
 prettyInline ds  (Pandoc.Span      _ t) = prettyInlines ds t
-prettyInline ds  (Pandoc.Note        t) = prettyBlocks  ds t
+prettyInline _   (Pandoc.Note        _) =
+    -- TODO: this requires inlines to contain our blocks, rather than
+    -- pandoc blocks.
+    mempty
 prettyInline ds  (Pandoc.Superscript t) = prettyInlines ds t
 prettyInline ds  (Pandoc.Subscript   t) = prettyInlines ds t
 prettyInline ds  (Pandoc.SmallCaps   t) = prettyInlines ds t
@@ -390,11 +398,11 @@ prettyInlines ds = mconcat . map (prettyInline ds)
 
 
 --------------------------------------------------------------------------------
-prettyReferences :: DisplaySettings -> [Pandoc.Block] -> [PP.Doc]
+prettyReferences :: DisplaySettings -> [Block] -> [PP.Doc]
 prettyReferences ds =
     map prettyReference . getReferences
   where
-    getReferences :: [Pandoc.Block] -> [Pandoc.Inline]
+    getReferences :: [Block] -> [Pandoc.Inline]
     getReferences = filter isReferenceLink . grecQ
 
     prettyReference :: Pandoc.Inline -> PP.Doc

lib/Patat/Presentation/Display/Table.hs

@@ -2,8 +2,8 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards   #-}
 module Patat.Presentation.Display.Table
-    ( Table (..)
-    , prettyTable
+    ( TableDisplay (..)
+    , prettyTableDisplay
 
     , themed
     ) where
@@ -19,47 +19,47 @@ import           Prelude
 
 
 --------------------------------------------------------------------------------
-data Table = Table
-    { tCaption :: PP.Doc
-    , tAligns  :: [PP.Alignment]
-    , tHeaders :: [PP.Doc]
-    , tRows    :: [[PP.Doc]]
+data TableDisplay = TableDisplay
+    { tdCaption :: PP.Doc
+    , tdAligns  :: [PP.Alignment]
+    , tdHeaders :: [PP.Doc]
+    , tdRows    :: [[PP.Doc]]
     }
 
 
 --------------------------------------------------------------------------------
-prettyTable :: DisplaySettings -> Table -> PP.Doc
-prettyTable ds Table {..} =
+prettyTableDisplay :: DisplaySettings -> TableDisplay -> PP.Doc
+prettyTableDisplay ds TableDisplay {..} =
     PP.indent indentation indentation $
         lineIf (not isHeaderLess) (hcat2 headerHeight
             [ themed ds themeTableHeader $
                 PP.align w a (vpad headerHeight header)
-            | (w, a, header) <- zip3 columnWidths tAligns tHeaders
+            | (w, a, header) <- zip3 columnWidths tdAligns tdHeaders
             ]) <>
         dashedHeaderSeparator ds columnWidths <$$>
         joinRows
             [ hcat2 rowHeight
                 [ PP.align w a (vpad rowHeight cell)
-                | (w, a, cell) <- zip3 columnWidths tAligns row
+                | (w, a, cell) <- zip3 columnWidths tdAligns row
                 ]
-            | (rowHeight, row) <- zip rowHeights tRows
+            | (rowHeight, row) <- zip rowHeights tdRows
             ] <$$>
         lineIf isHeaderLess (dashedHeaderSeparator ds columnWidths) <>
         lineIf
-            (not $ PP.null tCaption) (PP.hardline <> "Table: " <> tCaption)
+            (not $ PP.null tdCaption) (PP.hardline <> "Table: " <> tdCaption)
   where
     indentation = PP.Indentation 2 mempty
 
     lineIf cond line = if cond then line <> PP.hardline else mempty
 
     joinRows
-        | all (all isSimpleCell) tRows = PP.vcat
+        | all (all isSimpleCell) tdRows = PP.vcat
         | otherwise                    = PP.vcat . intersperse ""
 
-    isHeaderLess = all PP.null tHeaders
+    isHeaderLess = all PP.null tdHeaders
 
-    headerDimensions = map PP.dimensions tHeaders :: [(Int, Int)]
-    rowDimensions    = map (map PP.dimensions) tRows :: [[(Int, Int)]]
+    headerDimensions = map PP.dimensions tdHeaders :: [(Int, Int)]
+    rowDimensions    = map (map PP.dimensions) tdRows :: [[(Int, Int)]]
 
     columnWidths :: [Int]
     columnWidths =