Remove Data instance for Block

lib/Patat/Presentation/Display.hs

@@ -14,7 +14,6 @@ module Patat.Presentation.Display
 import           Control.Monad                        (guard)
 import qualified Data.Aeson.Extended                  as A
 import           Data.Char.WCWidth.Extended           (wcstrwidth)
-import           Data.Data.Extended                   (grecQ)
 import qualified Data.List                            as L
 import           Data.Maybe                           (fromMaybe, maybeToList)
 import qualified Data.Sequence.Extended               as Seq
@@ -121,7 +120,7 @@ displayPresentation size pres@Presentation {..} =
     -- headers.
     onlyImage (Fragment (Header{} : bs)) = onlyImage (Fragment bs)
     onlyImage (Fragment bs) = case bs of
-        [Figure _ _ bs']                      -> onlyImage (Fragment bs')
+        [Figure _ bs']                        -> onlyImage (Fragment bs')
         [Para [Pandoc.Image _ _ (target, _)]] -> Just target
         _                                     -> Nothing
 
@@ -319,7 +318,7 @@ prettyBlock ds (LineBlock inliness) =
     PP.vcat $
     map (prettyInlines ds) inliness
 
-prettyBlock ds (Figure _attr _caption blocks) =
+prettyBlock ds (Figure _attr blocks) =
     -- TODO: the fromPandoc conversion here is weird
     prettyBlocks ds blocks
 
@@ -352,8 +351,8 @@ prettyInline ds (Pandoc.Code _ txt) =
     themed ds themeCode $
     PP.text (" " <> txt <> " ")
 
-prettyInline ds link@(Pandoc.Link _attrs text (target, _title))
-    | isReferenceLink link =
+prettyInline ds link@(Pandoc.Link _attrs _text (target, _title))
+    | Just (text, _, _) <- toReferenceLink link =
         "[" <> themed ds themeLinkText (prettyInlines ds text) <> "]"
     | otherwise =
         "<" <> themed ds themeLinkTarget (PP.text target) <> ">"
@@ -402,11 +401,12 @@ prettyReferences :: DisplaySettings -> [Block] -> [PP.Doc]
 prettyReferences ds =
     map prettyReference . getReferences
   where
-    getReferences :: [Block] -> [Pandoc.Inline]
-    getReferences = filter isReferenceLink . grecQ
+    getReferences :: [Block] -> [([Pandoc.Inline], T.Text, T.Text)]
+    getReferences = foldMap $
+        foldBlock (const mempty) (maybeToList . toReferenceLink)
 
-    prettyReference :: Pandoc.Inline -> PP.Doc
-    prettyReference (Pandoc.Link _attrs text (target, title)) =
+    prettyReference :: ([Pandoc.Inline], T.Text, T.Text) -> PP.Doc
+    prettyReference (text, target, title) =
         "[" <>
         themed ds themeLinkText
             (prettyInlines ds $ Pandoc.newlineToSpace text) <>
@@ -416,11 +416,10 @@ prettyReferences ds =
             then mempty
             else PP.space <> "\"" <> PP.text title <> "\"")
         <> ")"
-    prettyReference _ = mempty
 
 
 --------------------------------------------------------------------------------
-isReferenceLink :: Pandoc.Inline -> Bool
-isReferenceLink (Pandoc.Link _attrs text (target, _)) =
-    [Pandoc.Str target] /= text
-isReferenceLink _ = False
+toReferenceLink :: Pandoc.Inline -> Maybe ([Pandoc.Inline], T.Text, T.Text)
+toReferenceLink (Pandoc.Link _attrs text (target, title))
+    | [Pandoc.Str target] /= text = Just (text, target, title)
+toReferenceLink _ = Nothing

lib/Patat/Presentation/Syntax.hs

@@ -1,10 +1,11 @@
-{-# LANGUAGE DeriveDataTypeable #-}
 module Patat.Presentation.Syntax
     ( Block (..)
+    , foldBlock
+    , foldInline
+
     , fromPandoc
     ) where
 
-import           Data.Data                  (Data)
 import qualified Data.Text                  as T
 import qualified Text.Pandoc                as Pandoc
 import qualified Text.Pandoc.Writers.Shared as Pandoc
@@ -35,10 +36,68 @@ data Block
     | Header Int !Pandoc.Attr ![Pandoc.Inline]
     | HorizontalRule
     | Table ![Pandoc.Inline] ![Pandoc.Alignment] ![[Block]] ![[[Block]]]
-    | Figure !Pandoc.Attr !Pandoc.Caption ![Block]
+    | Figure !Pandoc.Attr ![Block]
     | Div !Pandoc.Attr ![Block]
-    -- TODO: remove Data instance
-    deriving (Eq, Data, Show)
+    deriving (Eq, Show)
+
+-- | Perform a deep fold over all inlines in a block.
+-- Currently only used to find reference links.
+foldBlock
+    :: Monoid m
+    => (Block -> m)
+    -> (Pandoc.Inline -> m)
+    -> Block -> m
+foldBlock fb fi block = fb block <> case block of
+    Plain is -> foldMap (foldInline fb fi) is
+    Para is -> foldMap (foldInline fb fi) is
+    LineBlock iss -> foldMap (foldMap (foldInline fb fi)) iss
+    CodeBlock _ _ -> mempty
+    RawBlock _ _ -> mempty
+    BlockQuote bs -> foldMap (foldBlock fb fi) bs
+    OrderedList _ bss -> foldMap (foldMap (foldBlock fb fi)) bss
+    BulletList bss -> foldMap (foldMap (foldBlock fb fi)) bss
+    DefinitionList items -> mconcat $ do
+        (is, bss) <- items
+        pure $ foldMap (foldInline fb fi) is <>
+            foldMap (foldMap (foldBlock fb fi)) bss
+    Header _ _ is -> foldMap (foldInline fb fi) is
+    HorizontalRule -> mempty
+    Table caption _ thead trows ->
+        foldMap (foldInline fb fi) caption <>
+        foldMap (foldMap (foldBlock fb fi)) thead <>
+        foldMap (foldMap (foldMap (foldBlock fb fi))) trows
+    Figure _ bs -> foldMap (foldBlock fb fi) bs
+    Div _ bs -> foldMap (foldBlock fb fi) bs
+
+foldInline
+    :: Monoid m
+    => (Block -> m)
+    -> (Pandoc.Inline -> m)
+    -> Pandoc.Inline -> m
+foldInline fb fi inline = fi inline <> case inline of
+    Pandoc.Str _ -> mempty
+    Pandoc.Emph is -> foldMap (foldInline fb fi) is
+    Pandoc.Underline is -> foldMap (foldInline fb fi) is
+    Pandoc.Strong is -> foldMap (foldInline fb fi) is
+    Pandoc.Strikeout is -> foldMap (foldInline fb fi) is
+    Pandoc.Superscript is -> foldMap (foldInline fb fi) is
+    Pandoc.Subscript is -> foldMap (foldInline fb fi) is
+    Pandoc.SmallCaps is -> foldMap (foldInline fb fi) is
+    Pandoc.Quoted _ is -> foldMap (foldInline fb fi) is
+    Pandoc.Cite _ is -> foldMap (foldInline fb fi) is
+    Pandoc.Code _ _ -> mempty
+    Pandoc.Space -> mempty
+    Pandoc.SoftBreak -> mempty
+    Pandoc.LineBreak -> mempty
+    Pandoc.Math _ _ -> mempty
+    Pandoc.RawInline _ _ -> mempty
+    Pandoc.Link _ is _ -> foldMap (foldInline fb fi) is
+    Pandoc.Image _ is _ -> foldMap (foldInline fb fi) is
+    Pandoc.Note bs ->
+        -- TODO: this should use our block type...
+        -- foldMap (foldBlock fb fi) bs
+        undefined
+    Pandoc.Span _ is -> foldMap (foldInline fb fi) is
 
 fromPandoc :: Pandoc.Block -> Block
 fromPandoc (Pandoc.Plain inlines) = Plain inlines
@@ -66,7 +125,7 @@ fromPandoc (Pandoc.Table _ caption specs thead tbodies tfoot) = Table
     (caption', aligns, _, headers, rows) = Pandoc.toLegacyTable
         caption specs thead tbodies tfoot
 
-fromPandoc (Pandoc.Figure attrs caption blocks) =
-    Figure attrs caption $ map fromPandoc blocks
+fromPandoc (Pandoc.Figure attrs _caption blocks) =
+    Figure attrs $ map fromPandoc blocks
 fromPandoc (Pandoc.Div attrs blocks) =
     Div attrs $ map fromPandoc blocks