From cd152b5afb63213aa4264a7a0c9637b7450dd441 Mon Sep 17 00:00:00 2001
From: Brandon Chinn <brandonchinn178@gmail.com>
Date: Fri, 3 Feb 2023 10:43:42 -0800
Subject: [PATCH 1/2] Add Nodes type

---
 commonmark/commonmark.cabal        |   1 +
 commonmark/src/Commonmark/Nodes.hs | 208 +++++++++++++++++++++++++++++
 2 files changed, 209 insertions(+)
 create mode 100644 commonmark/src/Commonmark/Nodes.hs

diff --git a/commonmark/commonmark.cabal b/commonmark/commonmark.cabal
index 95a0df8..f011eb5 100644
--- a/commonmark/commonmark.cabal
+++ b/commonmark/commonmark.cabal
@@ -67,6 +67,7 @@ library
       Commonmark.Parser
       Commonmark.Types
       Commonmark.Html
+      Commonmark.Nodes
       Commonmark.Syntax
       Commonmark.ReferenceMap
       Commonmark.Tokens
diff --git a/commonmark/src/Commonmark/Nodes.hs b/commonmark/src/Commonmark/Nodes.hs
new file mode 100644
index 0000000..b0920b6
--- /dev/null
+++ b/commonmark/src/Commonmark/Nodes.hs
@@ -0,0 +1,208 @@
+{-# LANGUAGE ExistentialQuantification  #-}
+{-# LANGUAGE FlexibleInstances          #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE LambdaCase                 #-}
+{-# LANGUAGE MultiParamTypeClasses      #-}
+{-# LANGUAGE OverloadedStrings          #-}
+{-# LANGUAGE RecordWildCards            #-}
+{-# LANGUAGE ScopedTypeVariables        #-}
+{-# LANGUAGE TypeFamilies               #-}
+{-# LANGUAGE UndecidableInstances       #-}
+module Commonmark.Nodes
+  ( Nodes (..)
+  , singleNode
+  , fromNodes
+  , Node (..)
+  , getNodeType
+  , SomeNodeType (..)
+  , NodeType (..)
+  , NodeTypeBlock (..)
+  , NodeTypeInline (..)
+  , -- * Helpers
+    mapNodes
+  , traverseNodes
+  , concatMapNodes
+  )
+where
+
+import           Commonmark.Types
+import           Data.Kind (Constraint)
+import           Data.Text (Text)
+import qualified Data.Text as T
+import           Data.Typeable        (Typeable, cast)
+
+-- | Nodes parsed from a markdown document, that can later be rendered
+-- to a value of type @a@ with 'fromNodes'.
+--
+-- An example filtering out all raw HTML content:
+--
+-- > let isRawHTML node
+-- >       | Just NodeRawInline{} <- getNodeType node = True
+-- >       | Just NodeRawBlock{} <- getNodeType node = True
+-- >       | otherwise = False
+-- > in Nodes . filter (not . isRawHTML) . unNodes
+newtype Nodes a = Nodes { unNodes :: [Node a] }
+  deriving (Show, Semigroup, Monoid)
+
+instance HasAttributes (Nodes a) where
+  addAttributes attrs = Nodes . map (\node -> node{nodeAttributes = nodeAttributes node <> attrs}) . unNodes
+
+instance ToPlainText (Nodes a) where
+  toPlainText = foldMap toPlainText . unNodes
+
+instance Rangeable (Nodes a) where
+  ranged sr = Nodes . map (\node -> node{nodeRange = Just sr}) . unNodes
+
+singleNode :: (NodeType node a, FromNodeType node a) => node a -> Nodes a
+singleNode nodeType = Nodes [Node (SomeNodeType nodeType) [] Nothing]
+
+fromNodes :: forall a. (Monoid a, HasAttributes a, Rangeable a) => Nodes a -> a
+fromNodes = foldMap fromNode . unNodes
+  where
+    fromNode :: Node a -> a
+    fromNode Node{nodeType = SomeNodeType nodeType, ..} =
+      maybe id ranged nodeRange
+        . addAttributes nodeAttributes
+        $ fromNodeType nodeType
+
+mapNodes :: (Node a -> Node a) -> Nodes a -> Nodes a
+mapNodes f = Nodes . map f . unNodes
+
+traverseNodes :: Applicative f => (Node a -> f (Node a)) -> Nodes a -> f (Nodes a)
+traverseNodes f = fmap Nodes . traverse f . unNodes
+
+concatMapNodes :: (Node a -> [Node a]) -> Nodes a -> Nodes a
+concatMapNodes f = Nodes . concatMap f . unNodes
+
+data Node a = Node
+  { nodeType :: SomeNodeType a
+  , nodeAttributes :: Attributes
+  , nodeRange :: Maybe SourceRange
+  }
+  deriving (Show)
+
+instance ToPlainText (Node a) where
+  toPlainText Node{nodeType = SomeNodeType nodeType, ..} =
+    case toPlainText nodeType of
+      "" | Just alt <- lookup "alt" nodeAttributes -> alt
+      t -> t
+
+getNodeType :: NodeType node a => Node a -> Maybe (node a)
+getNodeType = fromSomeNodeType . nodeType
+
+data SomeNodeType a = forall node. (NodeType node a, FromNodeType node a) => SomeNodeType (node a)
+
+instance Show (SomeNodeType a) where
+  show (SomeNodeType a) = show a
+
+class (Typeable (node a), Show (node a), ToPlainText (node a)) => NodeType node a where
+  type FromNodeType node a :: Constraint
+
+  fromSomeNodeType :: SomeNodeType a -> Maybe (node a)
+  fromSomeNodeType (SomeNodeType node) = cast node
+
+  fromNodeType :: FromNodeType node a => node a -> a
+
+data (NodeTypeInline a)
+  = NodeLineBreak
+  | NodeSoftBreak
+  | NodeStr Text
+  | NodeEntity Text
+  | NodeEscapedChar Char
+  | NodeEmph (Nodes a)
+  | NodeStrong (Nodes a)
+  | NodeLink Text Text (Nodes a)
+  | NodeImage Text Text (Nodes a)
+  | NodeCode Text
+  | NodeRawInline Format Text
+  deriving (Show)
+
+instance Typeable a => NodeType NodeTypeInline a where
+  type FromNodeType NodeTypeInline a = IsInline a
+  fromNodeType = \case
+    NodeLineBreak -> lineBreak
+    NodeSoftBreak -> softBreak
+    NodeStr t -> str t
+    NodeEntity t -> entity t
+    NodeEscapedChar c -> escapedChar c
+    NodeEmph nodes -> emph (fromNodes nodes)
+    NodeStrong nodes -> strong (fromNodes nodes)
+    NodeLink target title nodes -> link target title (fromNodes nodes)
+    NodeImage target title nodes -> image target title (fromNodes nodes)
+    NodeCode t -> code t
+    NodeRawInline fmt t -> rawInline fmt t
+
+instance ToPlainText (NodeTypeInline a) where
+  toPlainText = \case
+    NodeLineBreak -> T.singleton '\n'
+    NodeSoftBreak -> T.singleton '\n'
+    NodeStr t -> t
+    NodeEntity t -> t
+    NodeEscapedChar c -> T.singleton c
+    NodeEmph nodes -> toPlainText nodes
+    NodeStrong nodes -> toPlainText nodes
+    NodeLink _ _ nodes -> toPlainText nodes
+    NodeImage _ _ nodes -> toPlainText nodes
+    NodeCode t -> t
+    NodeRawInline _ _ -> mempty
+
+instance (Typeable a, IsInline a) => IsInline (Nodes a) where
+  lineBreak = singleNode NodeLineBreak
+  softBreak = singleNode NodeSoftBreak
+  str t = singleNode $ NodeStr t
+  entity t = singleNode $ NodeEntity t
+  escapedChar c = singleNode $ NodeEscapedChar c
+  emph nodes = singleNode $ NodeEmph nodes
+  strong nodes = singleNode $ NodeStrong nodes
+  link target title nodes = singleNode $ NodeLink target title nodes
+  image target title nodes = singleNode $ NodeImage target title nodes
+  code t = singleNode $ NodeCode t
+  rawInline f t = singleNode $ NodeRawInline f t
+
+data NodeTypeBlock a
+  = NodeParagraph (Nodes a)
+  | NodePlain (Nodes a)
+  | NodeThematicBreak
+  | NodeBlockQuote (Nodes a)
+  | NodeCodeBlock Text Text
+  | NodeHeading Int (Nodes a)
+  | NodeRawBlock Format Text
+  | NodeReferenceLinkDefinition Text (Text, Text)
+  | NodeList ListType ListSpacing [Nodes a]
+  deriving (Show)
+
+instance Typeable a => NodeType NodeTypeBlock a where
+  type FromNodeType NodeTypeBlock a = IsBlock a a
+  fromNodeType = \case
+    NodeParagraph nodes -> paragraph (fromNodes nodes)
+    NodePlain nodes -> plain (fromNodes nodes)
+    NodeThematicBreak -> thematicBreak
+    NodeBlockQuote nodes -> blockQuote (fromNodes nodes)
+    NodeCodeBlock info t -> codeBlock info t
+    NodeHeading num nodes -> heading num (fromNodes nodes)
+    NodeRawBlock fmt t -> rawBlock fmt t
+    NodeReferenceLinkDefinition lab dest -> referenceLinkDefinition lab dest
+    NodeList lType lSpacing nodesList -> list lType lSpacing (map fromNodes nodesList)
+
+instance ToPlainText (NodeTypeBlock a) where
+  toPlainText = \case
+    NodeParagraph nodes -> toPlainText nodes
+    NodePlain nodes -> toPlainText nodes
+    NodeThematicBreak -> mempty
+    NodeBlockQuote nodes -> toPlainText nodes
+    NodeCodeBlock _ t -> t
+    NodeHeading _ nodes -> toPlainText nodes
+    NodeRawBlock _ _ -> mempty
+    NodeReferenceLinkDefinition _ _ -> mempty
+    NodeList _ _ nodesList -> T.unlines $ map toPlainText nodesList
+
+instance (Typeable a, IsBlock a a) => IsBlock (Nodes a) (Nodes a) where
+  paragraph nodes = singleNode $ NodeParagraph nodes
+  plain nodes = singleNode $ NodePlain nodes
+  thematicBreak = singleNode $ NodeThematicBreak
+  blockQuote nodes = singleNode $ NodeBlockQuote nodes
+  codeBlock info t = singleNode $ NodeCodeBlock info t
+  heading level nodes = singleNode $ NodeHeading level nodes
+  rawBlock f t = singleNode $ NodeRawBlock f t
+  referenceLinkDefinition target dest = singleNode $ NodeReferenceLinkDefinition target dest
+  list lType lSpacing nodesList = singleNode $ NodeList lType lSpacing nodesList

From 9baac3989c10d83fe741d3755f25842e508f9668 Mon Sep 17 00:00:00 2001
From: Brandon Chinn <brandonchinn178@gmail.com>
Date: Sat, 4 Feb 2023 10:47:29 -0800
Subject: [PATCH 2/2] Add nodes for extensions

---
 .../src/Commonmark/Extensions/Attributes.hs   | 35 +++++++++++++++++++
 .../Commonmark/Extensions/DefinitionList.hs   | 30 ++++++++++++++++
 .../src/Commonmark/Extensions/Emoji.hs        | 21 +++++++++++
 .../src/Commonmark/Extensions/Footnote.hs     | 27 ++++++++++++++
 .../src/Commonmark/Extensions/Math.hs         | 25 +++++++++++++
 .../src/Commonmark/Extensions/PipeTable.hs    | 27 ++++++++++++++
 .../src/Commonmark/Extensions/Smart.hs        | 25 +++++++++++++
 .../Commonmark/Extensions/Strikethrough.hs    | 21 +++++++++++
 .../src/Commonmark/Extensions/Subscript.hs    | 21 +++++++++++
 .../src/Commonmark/Extensions/Superscript.hs  | 21 +++++++++++
 .../src/Commonmark/Extensions/TaskList.hs     | 21 +++++++++++
 .../src/Commonmark/Extensions/Wikilinks.hs    | 21 +++++++++++
 12 files changed, 295 insertions(+)

diff --git a/commonmark-extensions/src/Commonmark/Extensions/Attributes.hs b/commonmark-extensions/src/Commonmark/Extensions/Attributes.hs
index 45568b7..9593fd7 100644
--- a/commonmark-extensions/src/Commonmark/Extensions/Attributes.hs
+++ b/commonmark-extensions/src/Commonmark/Extensions/Attributes.hs
@@ -5,6 +5,8 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
 module Commonmark.Extensions.Attributes
   ( attributesSpec
   , HasDiv(..)
@@ -25,6 +27,7 @@ import Commonmark.SourceMap
 import Commonmark.Blocks
 import Commonmark.Entity (unEntity)
 import Commonmark.Html
+import Commonmark.Nodes hiding (Node (..))
 import Data.Dynamic
 import Data.Tree
 import Control.Monad (mzero, guard, void)
@@ -285,3 +288,35 @@ pKeyValue = do
                Tok (Symbol '\'') _ _:_:_ -> mzero
                _ -> val
   return $! (untokenize name, unEntity val')
+
+data NodeTypeDiv a
+  = NodeDiv_ (Nodes a)
+  deriving (Show)
+
+instance (Typeable a, Monoid a, HasAttributes a, Rangeable a) => NodeType NodeTypeDiv a where
+  type FromNodeType NodeTypeDiv a = HasDiv a
+  fromNodeType = \case
+    NodeDiv_ x -> div_ (fromNodes x)
+
+instance ToPlainText (NodeTypeDiv a) where
+  toPlainText = \case
+    NodeDiv_ x -> toPlainText x
+
+instance (Typeable a, HasDiv a, Monoid a, HasAttributes a, Rangeable a) => HasDiv (Nodes a) where
+  div_ x = singleNode $ NodeDiv_ x
+
+data NodeTypeSpan a
+  = NodeSpanWith Attributes (Nodes a)
+  deriving (Show)
+
+instance Typeable a => NodeType NodeTypeSpan a where
+  type FromNodeType NodeTypeSpan a = HasSpan a
+  fromNodeType = \case
+    NodeSpanWith attrs x -> spanWith attrs (fromNodes x)
+
+instance ToPlainText (NodeTypeSpan a) where
+  toPlainText = \case
+    NodeSpanWith _ x -> toPlainText x
+
+instance (Typeable a, HasSpan a) => HasSpan (Nodes a) where
+  spanWith attrs x = singleNode $ NodeSpanWith attrs x
diff --git a/commonmark-extensions/src/Commonmark/Extensions/DefinitionList.hs b/commonmark-extensions/src/Commonmark/Extensions/DefinitionList.hs
index 20dd990..e4900a5 100644
--- a/commonmark-extensions/src/Commonmark/Extensions/DefinitionList.hs
+++ b/commonmark-extensions/src/Commonmark/Extensions/DefinitionList.hs
@@ -4,6 +4,9 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
 module Commonmark.Extensions.DefinitionList
   ( definitionListSpec
   , HasDefinitionList(..)
@@ -15,9 +18,11 @@ import Commonmark.Blocks
 import Commonmark.SourceMap
 import Commonmark.TokParsers
 import Commonmark.Html
+import Commonmark.Nodes hiding (Node (..))
 import Control.Monad (mzero)
 import Data.Dynamic
 import Data.Tree
+import qualified Data.Text as T
 import Text.Parsec
 
 definitionListSpec :: (Monad m, IsBlock il bl, IsInline il,
@@ -194,3 +199,28 @@ instance (HasDefinitionList il bl, Semigroup bl, Semigroup il)
     let res = definitionList spacing (zip terms' defs')
     addName "definitionList"
     return res
+
+data NodeTypeDefinitionList a
+  = NodeDefinitionList ListSpacing [(Nodes a, [Nodes a])]
+  deriving (Show)
+
+instance Typeable a => NodeType NodeTypeDefinitionList a where
+  type FromNodeType NodeTypeDefinitionList a = HasDefinitionList a a
+  fromNodeType = \case
+    NodeDefinitionList spacing items ->
+      definitionList
+        spacing
+        [ (fromNodes term, map fromNodes defs)
+        | (term, defs) <- items
+        ]
+
+instance ToPlainText (NodeTypeDefinitionList a) where
+  toPlainText = \case
+    NodeDefinitionList _ items ->
+      T.unlines . concat $
+        [ (toPlainText term <> ":") : map toPlainText defs
+        | (term, defs) <- items
+        ]
+
+instance (Typeable a, HasDefinitionList a a) => HasDefinitionList (Nodes a) (Nodes a) where
+  definitionList spacing items = singleNode $ NodeDefinitionList spacing items
diff --git a/commonmark-extensions/src/Commonmark/Extensions/Emoji.hs b/commonmark-extensions/src/Commonmark/Extensions/Emoji.hs
index 00c9080..439d4ee 100644
--- a/commonmark-extensions/src/Commonmark/Extensions/Emoji.hs
+++ b/commonmark-extensions/src/Commonmark/Extensions/Emoji.hs
@@ -1,5 +1,8 @@
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeFamilies #-}
 module Commonmark.Extensions.Emoji
   ( HasEmoji(..)
   , emojiSpec )
@@ -11,9 +14,11 @@ import Commonmark.Inlines
 import Commonmark.SourceMap
 import Commonmark.TokParsers
 import Commonmark.Html
+import Commonmark.Nodes
 import Text.Emoji (emojiFromAlias)
 import Text.Parsec
 import Data.Text (Text)
+import Data.Typeable (Typeable)
 
 emojiSpec :: (Monad m, IsBlock il bl, IsInline il, HasEmoji il)
           => SyntaxSpec m il bl
@@ -46,3 +51,19 @@ parseEmoji = try $ do
   case emojiFromAlias kw of
     Nothing -> fail "emoji not found"
     Just t  -> return $! emoji kw t
+
+data NodeTypeEmoji a
+  = NodeEmoji Text Text
+  deriving (Show)
+
+instance Typeable a => NodeType NodeTypeEmoji a where
+  type FromNodeType NodeTypeEmoji a = HasEmoji a
+  fromNodeType = \case
+    NodeEmoji kw t -> emoji kw t
+
+instance ToPlainText (NodeTypeEmoji a) where
+  toPlainText = \case
+    NodeEmoji kw _ -> ":" <> kw <> ":"
+
+instance (Typeable a, HasEmoji a) => HasEmoji (Nodes a) where
+  emoji kw t = singleNode $ NodeEmoji kw t
diff --git a/commonmark-extensions/src/Commonmark/Extensions/Footnote.hs b/commonmark-extensions/src/Commonmark/Extensions/Footnote.hs
index da35c7e..9d539aa 100644
--- a/commonmark-extensions/src/Commonmark/Extensions/Footnote.hs
+++ b/commonmark-extensions/src/Commonmark/Extensions/Footnote.hs
@@ -1,9 +1,11 @@
 {-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeFamilies #-}
 module Commonmark.Extensions.Footnote
   ( footnoteSpec
   , HasFootnote(..)
@@ -18,6 +20,7 @@ import Commonmark.Inlines
 import Commonmark.SourceMap
 import Commonmark.TokParsers
 import Commonmark.ReferenceMap
+import Commonmark.Nodes hiding (Node (..))
 import Control.Monad.Trans.Class (lift)
 import Control.Monad (mzero)
 import Data.List
@@ -169,3 +172,27 @@ instance (HasFootnote il bl, Semigroup bl, Semigroup il)
   footnote num lab' x = (footnote num lab' <$> x) <* addName "footnote"
   footnoteList items = footnoteList <$> sequence items
   footnoteRef x y z = (footnoteRef x y <$> z) <* addName "footnoteRef"
+
+data NodeTypeFootnote a
+  = NodeFootnote Int Text (Nodes a)
+  | NodeFootnoteList [Nodes a]
+  | NodeFootnoteRef Text Text (Nodes a)
+  deriving (Show)
+
+instance Typeable a => NodeType NodeTypeFootnote a where
+  type FromNodeType NodeTypeFootnote a = HasFootnote a a
+  fromNodeType = \case
+    NodeFootnote num lab x -> footnote num lab (fromNodes x)
+    NodeFootnoteList items -> footnoteList (map fromNodes items)
+    NodeFootnoteRef x lab nodes -> footnoteRef x lab (fromNodes nodes)
+
+instance ToPlainText (NodeTypeFootnote a) where
+  toPlainText = \case
+    NodeFootnote num _ x -> T.pack (show num) <> ": " <> toPlainText x
+    NodeFootnoteList items -> T.unlines $ map toPlainText items
+    NodeFootnoteRef x _ _ -> "[" <> x <> "]"
+
+instance (Typeable a, HasFootnote a a) => HasFootnote (Nodes a) (Nodes a) where
+  footnote num lab x = singleNode $ NodeFootnote num lab x
+  footnoteList items = singleNode $ NodeFootnoteList items
+  footnoteRef x lab nodes = singleNode $ NodeFootnoteRef x lab nodes
diff --git a/commonmark-extensions/src/Commonmark/Extensions/Math.hs b/commonmark-extensions/src/Commonmark/Extensions/Math.hs
index cf6c89e..094300a 100644
--- a/commonmark-extensions/src/Commonmark/Extensions/Math.hs
+++ b/commonmark-extensions/src/Commonmark/Extensions/Math.hs
@@ -1,5 +1,8 @@
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeFamilies #-}
 module Commonmark.Extensions.Math
   ( HasMath(..)
   , mathSpec )
@@ -12,9 +15,11 @@ import Commonmark.Inlines
 import Commonmark.SourceMap
 import Commonmark.TokParsers
 import Commonmark.Html
+import Commonmark.Nodes
 import Text.Parsec
 import Data.Text (Text)
 import qualified Data.Text as T
+import Data.Typeable (Typeable)
 
 mathSpec :: (Monad m, IsBlock il bl, IsInline il, HasMath il)
          => SyntaxSpec m il bl
@@ -62,3 +67,23 @@ pDollarsMath n = do
        Symbol '}' | n > 0 -> (tk :) <$> pDollarsMath (n-1)
                   | otherwise -> mzero
        _ -> (tk :) <$> pDollarsMath n
+
+data NodeTypeMath a
+  = NodeInlineMath Text
+  | NodeDisplayMath Text
+  deriving (Show)
+
+instance Typeable a => NodeType NodeTypeMath a where
+  type FromNodeType NodeTypeMath a = HasMath a
+  fromNodeType = \case
+    NodeInlineMath t -> inlineMath t
+    NodeDisplayMath t -> displayMath t
+
+instance ToPlainText (NodeTypeMath a) where
+  toPlainText = \case
+    NodeInlineMath t -> t
+    NodeDisplayMath t -> t
+
+instance (Typeable a, HasMath a) => HasMath (Nodes a) where
+  inlineMath t = singleNode $ NodeInlineMath t
+  displayMath t = singleNode $ NodeDisplayMath t
diff --git a/commonmark-extensions/src/Commonmark/Extensions/PipeTable.hs b/commonmark-extensions/src/Commonmark/Extensions/PipeTable.hs
index d9cae8d..43fb0bf 100644
--- a/commonmark-extensions/src/Commonmark/Extensions/PipeTable.hs
+++ b/commonmark-extensions/src/Commonmark/Extensions/PipeTable.hs
@@ -4,6 +4,8 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings     #-}
 {-# LANGUAGE DeriveDataTypeable    #-}
+{-# LANGUAGE LambdaCase            #-}
+{-# LANGUAGE TypeFamilies          #-}
 
 module Commonmark.Extensions.PipeTable
  ( HasPipeTable(..)
@@ -20,10 +22,12 @@ import Commonmark.TokParsers
 import Commonmark.Blocks
 import Commonmark.SourceMap
 import Commonmark.Html
+import Commonmark.Nodes hiding (Node (..))
 import Text.Parsec
 import Data.Dynamic
 import Data.Tree
 import Data.Data
+import qualified Data.Text as T
 
 data ColAlignment = LeftAlignedCol
                   | CenterAlignedCol
@@ -211,3 +215,26 @@ pipeTableBlockSpec = BlockSpec
                then Node ndata children
                else Node ndata{ blockSpec = paraSpec } children) parent
      }
+
+data NodeTypePipeTable a
+  = NodePipeTable [ColAlignment] [Nodes a] [[Nodes a]]
+  deriving (Show)
+
+instance (Typeable a, Monoid a, HasAttributes a, Rangeable a) => NodeType NodeTypePipeTable a where
+  type FromNodeType NodeTypePipeTable a = HasPipeTable a a
+  fromNodeType = \case
+    NodePipeTable aligns headers rows -> pipeTable aligns (map fromNodes headers) (map (map fromNodes) rows)
+
+instance ToPlainText (NodeTypePipeTable a) where
+  toPlainText = \case
+    NodePipeTable _ headers rows ->
+      T.unlines $
+        fromRow (map toPlainText headers) :
+          [ fromRow (map toPlainText row)
+          | row <- rows
+          ]
+    where
+      fromRow = T.unwords
+
+instance (Typeable a, HasPipeTable a a, Monoid a, HasAttributes a, Rangeable a) => HasPipeTable (Nodes a) (Nodes a) where
+  pipeTable aligns headers rows = singleNode $ NodePipeTable aligns headers rows
diff --git a/commonmark-extensions/src/Commonmark/Extensions/Smart.hs b/commonmark-extensions/src/Commonmark/Extensions/Smart.hs
index 912bf90..93000f9 100644
--- a/commonmark-extensions/src/Commonmark/Extensions/Smart.hs
+++ b/commonmark-extensions/src/Commonmark/Extensions/Smart.hs
@@ -1,7 +1,10 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE FlexibleInstances    #-}
 {-# LANGUAGE FlexibleContexts     #-}
+{-# LANGUAGE LambdaCase           #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE TypeFamilies         #-}
 module Commonmark.Extensions.Smart
   ( HasQuoted(..)
   , smartPunctuationSpec )
@@ -11,8 +14,10 @@ import Commonmark.Types
 import Commonmark.Syntax
 import Commonmark.Inlines
 import Commonmark.Html
+import Commonmark.Nodes
 import Commonmark.SourceMap
 import Commonmark.TokParsers (symbol)
+import Data.Typeable (Typeable)
 import Text.Parsec
 
 class IsInline il => HasQuoted il where
@@ -59,3 +64,23 @@ pDash = try $ do
   return $! mconcat $
     replicate emcount (str "—") <>
     replicate encount (str "–")
+
+data NodeTypeQuoted a
+  = NodeSingleQuoted (Nodes a)
+  | NodeDoubleQuoted (Nodes a)
+  deriving (Show)
+
+instance Typeable a => NodeType NodeTypeQuoted a where
+  type FromNodeType NodeTypeQuoted a = HasQuoted a
+  fromNodeType = \case
+    NodeSingleQuoted x -> singleQuoted (fromNodes x)
+    NodeDoubleQuoted x -> doubleQuoted (fromNodes x)
+
+instance ToPlainText (NodeTypeQuoted a) where
+  toPlainText = \case
+    NodeSingleQuoted x -> "‘" <> toPlainText x <> "’"
+    NodeDoubleQuoted x -> "“" <> toPlainText x <> "”"
+
+instance (Typeable a, HasQuoted a) => HasQuoted (Nodes a) where
+  singleQuoted x = singleNode $ NodeSingleQuoted x
+  doubleQuoted x = singleNode $ NodeDoubleQuoted x
diff --git a/commonmark-extensions/src/Commonmark/Extensions/Strikethrough.hs b/commonmark-extensions/src/Commonmark/Extensions/Strikethrough.hs
index b9e7484..128affe 100644
--- a/commonmark-extensions/src/Commonmark/Extensions/Strikethrough.hs
+++ b/commonmark-extensions/src/Commonmark/Extensions/Strikethrough.hs
@@ -1,5 +1,8 @@
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE LambdaCase         #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeFamilies #-}
 module Commonmark.Extensions.Strikethrough
   ( HasStrikethrough(..)
   , strikethroughSpec )
@@ -9,6 +12,8 @@ import Commonmark.Syntax
 import Commonmark.Inlines
 import Commonmark.SourceMap
 import Commonmark.Html
+import Commonmark.Nodes
+import Data.Typeable (Typeable)
 
 strikethroughSpec :: (Monad m, IsBlock il bl, IsInline il, HasStrikethrough il)
               => SyntaxSpec m il bl
@@ -27,3 +32,19 @@ instance HasStrikethrough (Html a) where
 instance (HasStrikethrough i, Monoid i)
         => HasStrikethrough (WithSourceMap i) where
   strikethrough x = (strikethrough <$> x) <* addName "strikethrough"
+
+data NodeTypeStrikethrough a
+  = NodeStrikethrough (Nodes a)
+  deriving (Show)
+
+instance (Typeable a, Monoid a, HasAttributes a, Rangeable a) => NodeType NodeTypeStrikethrough a where
+  type FromNodeType NodeTypeStrikethrough a = HasStrikethrough a
+  fromNodeType = \case
+    NodeStrikethrough x -> strikethrough (fromNodes x)
+
+instance ToPlainText (NodeTypeStrikethrough a) where
+  toPlainText = \case
+    NodeStrikethrough x -> toPlainText x
+
+instance (Typeable a, HasStrikethrough a, Monoid a, HasAttributes a, Rangeable a) => HasStrikethrough (Nodes a) where
+  strikethrough x = singleNode $ NodeStrikethrough x
diff --git a/commonmark-extensions/src/Commonmark/Extensions/Subscript.hs b/commonmark-extensions/src/Commonmark/Extensions/Subscript.hs
index c7e42d5..0bf8d82 100644
--- a/commonmark-extensions/src/Commonmark/Extensions/Subscript.hs
+++ b/commonmark-extensions/src/Commonmark/Extensions/Subscript.hs
@@ -1,5 +1,8 @@
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE LambdaCase        #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeFamilies      #-}
 module Commonmark.Extensions.Subscript
   ( HasSubscript(..)
   , subscriptSpec )
@@ -9,6 +12,8 @@ import Commonmark.Syntax
 import Commonmark.Inlines
 import Commonmark.SourceMap
 import Commonmark.Html
+import Commonmark.Nodes
+import Data.Typeable (Typeable)
 
 subscriptSpec :: (Monad m, IsBlock il bl, IsInline il, HasSubscript il)
               => SyntaxSpec m il bl
@@ -27,3 +32,19 @@ instance HasSubscript (Html a) where
 instance (HasSubscript i, Monoid i)
         => HasSubscript (WithSourceMap i) where
   subscript x = (subscript <$> x) <* addName "subscript"
+
+data NodeTypeSubscript a
+  = NodeSubscript (Nodes a)
+  deriving (Show)
+
+instance (Typeable a, Monoid a, HasAttributes a, Rangeable a) => NodeType NodeTypeSubscript a where
+  type FromNodeType NodeTypeSubscript a = HasSubscript a
+  fromNodeType = \case
+    NodeSubscript x -> subscript (fromNodes x)
+
+instance ToPlainText (NodeTypeSubscript a) where
+  toPlainText = \case
+    NodeSubscript x -> toPlainText x
+
+instance (Typeable a, HasSubscript a, Monoid a, HasAttributes a, Rangeable a) => HasSubscript (Nodes a) where
+  subscript x = singleNode $ NodeSubscript x
diff --git a/commonmark-extensions/src/Commonmark/Extensions/Superscript.hs b/commonmark-extensions/src/Commonmark/Extensions/Superscript.hs
index f1d3b91..9d77f12 100644
--- a/commonmark-extensions/src/Commonmark/Extensions/Superscript.hs
+++ b/commonmark-extensions/src/Commonmark/Extensions/Superscript.hs
@@ -1,5 +1,8 @@
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE LambdaCase        #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeFamilies      #-}
 module Commonmark.Extensions.Superscript
   ( HasSuperscript(..)
   , superscriptSpec )
@@ -9,6 +12,8 @@ import Commonmark.Syntax
 import Commonmark.Inlines
 import Commonmark.SourceMap
 import Commonmark.Html
+import Commonmark.Nodes
+import Data.Typeable (Typeable)
 
 superscriptSpec :: (Monad m, IsBlock il bl, IsInline il, HasSuperscript il)
               => SyntaxSpec m il bl
@@ -27,3 +32,19 @@ instance HasSuperscript (Html a) where
 instance (HasSuperscript i, Monoid i)
         => HasSuperscript (WithSourceMap i) where
   superscript x = (superscript <$> x) <* addName "superscript"
+
+data NodeTypeSuperscript a
+  = NodeSuperscript (Nodes a)
+  deriving (Show)
+
+instance (Typeable a, Monoid a, HasAttributes a, Rangeable a) => NodeType NodeTypeSuperscript a where
+  type FromNodeType NodeTypeSuperscript a = HasSuperscript a
+  fromNodeType = \case
+    NodeSuperscript x -> superscript (fromNodes x)
+
+instance ToPlainText (NodeTypeSuperscript a) where
+  toPlainText = \case
+    NodeSuperscript x -> toPlainText x
+
+instance (Typeable a, HasSuperscript a, Monoid a, HasAttributes a, Rangeable a) => HasSuperscript (Nodes a) where
+  superscript x = singleNode $ NodeSuperscript x
diff --git a/commonmark-extensions/src/Commonmark/Extensions/TaskList.hs b/commonmark-extensions/src/Commonmark/Extensions/TaskList.hs
index c011cee..194ef67 100644
--- a/commonmark-extensions/src/Commonmark/Extensions/TaskList.hs
+++ b/commonmark-extensions/src/Commonmark/Extensions/TaskList.hs
@@ -5,6 +5,8 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE TypeFamilies #-}
 module Commonmark.Extensions.TaskList
   ( taskListSpec
   , HasTaskList (..)
@@ -17,11 +19,13 @@ import Commonmark.Blocks
 import Commonmark.SourceMap
 import Commonmark.TokParsers
 import Commonmark.Html
+import Commonmark.Nodes hiding (Node (..))
 import Control.Monad (mzero)
 import Control.Monad (when, guard)
 import Data.List (sort)
 import Data.Dynamic
 import Data.Tree
+import qualified Data.Text as T
 import Text.Parsec
 
 
@@ -228,3 +232,20 @@ instance (HasTaskList il bl, Semigroup bl, Semigroup il)
      (do let (checks, xs) = unzip items
          taskList lt spacing . zip checks <$> sequence xs
       ) <* addName "taskList"
+
+data NodeTypeTaskList a
+  = NodeTaskList ListType ListSpacing [(Bool, Nodes a)]
+  deriving (Show)
+
+instance Typeable a => NodeType NodeTypeTaskList a where
+  type FromNodeType NodeTypeTaskList a = HasTaskList a a
+  fromNodeType = \case
+    NodeTaskList lt spacing items -> taskList lt spacing (map (fmap fromNodes) items)
+
+instance ToPlainText (NodeTypeTaskList a) where
+  toPlainText = \case
+    NodeTaskList _ _ nodesList -> T.unlines $ map (toPlainText . snd) nodesList
+
+instance (Typeable a, HasTaskList a a) => HasTaskList (Nodes a) (Nodes a) where
+  taskList lt spacing items = singleNode $ NodeTaskList lt spacing items
+
diff --git a/commonmark-extensions/src/Commonmark/Extensions/Wikilinks.hs b/commonmark-extensions/src/Commonmark/Extensions/Wikilinks.hs
index 3a67eff..9cf46f4 100644
--- a/commonmark-extensions/src/Commonmark/Extensions/Wikilinks.hs
+++ b/commonmark-extensions/src/Commonmark/Extensions/Wikilinks.hs
@@ -1,8 +1,11 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
 module Commonmark.Extensions.Wikilinks
   ( wikilinksSpec
   , TitlePosition(..)
@@ -15,8 +18,10 @@ import Commonmark.Syntax
 import Commonmark.SourceMap
 import Commonmark.TokParsers
 import Commonmark.Html
+import Commonmark.Nodes
 import Text.Parsec
 import Data.Text (Text, strip)
+import Data.Typeable (Typeable)
 
 class HasWikilinks il where
   wikilink :: Text -> il -> il
@@ -59,3 +64,19 @@ wikilinksSpec titlepos = mempty
      symbol ']'
      symbol ']'
      return $ wikilink (strip url) (str (strip title))
+
+data NodeTypeWikilinks a
+  = NodeWikilink Text (Nodes a)
+  deriving (Show)
+
+instance (Typeable a, Monoid a, HasAttributes a, Rangeable a) => NodeType NodeTypeWikilinks a where
+  type FromNodeType NodeTypeWikilinks a = HasWikilinks a
+  fromNodeType = \case
+    NodeWikilink url x -> wikilink url (fromNodes x)
+
+instance ToPlainText (NodeTypeWikilinks a) where
+  toPlainText = \case
+    NodeWikilink _ x -> toPlainText x
+
+instance (Typeable a, HasWikilinks a, Monoid a, HasAttributes a, Rangeable a) => HasWikilinks (Nodes a) where
+  wikilink url x = singleNode $ NodeWikilink url x