From 2e097f3dc350d767bc2db67a01dc00ee8e1a34a1 Mon Sep 17 00:00:00 2001
From: Yuki Izumi <ashe@kivikakk.ee>
Date: Fri, 4 Aug 2017 18:08:08 +1000
Subject: [PATCH 01/11] Add Strikethrough to Data.Syntax.Markup

---
 src/Data/Syntax/Markup.hs       | 6 ++++++
 src/Language/Markdown/Syntax.hs | 6 +++++-
 2 files changed, 11 insertions(+), 1 deletion(-)

diff --git a/src/Data/Syntax/Markup.hs b/src/Data/Syntax/Markup.hs
index e72b027b4..32e524b00 100644
--- a/src/Data/Syntax/Markup.hs
+++ b/src/Data/Syntax/Markup.hs
@@ -110,3 +110,9 @@ data LineBreak a = LineBreak
 
 instance Eq1 LineBreak where liftEq = genericLiftEq
 instance Show1 LineBreak where liftShowsPrec = genericLiftShowsPrec
+
+newtype Strikethrough a = Strikethrough [a]
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+
+instance Eq1 Strikethrough where liftEq = genericLiftEq
+instance Show1 Strikethrough where liftShowsPrec = genericLiftShowsPrec
diff --git a/src/Language/Markdown/Syntax.hs b/src/Language/Markdown/Syntax.hs
index b8fcdd355..ea0dfaea2 100644
--- a/src/Language/Markdown/Syntax.hs
+++ b/src/Language/Markdown/Syntax.hs
@@ -41,6 +41,7 @@ type Syntax =
    , Markup.Link
    , Markup.Strong
    , Markup.Text
+   , Markup.Strikethrough
    -- Assignment errors; cmark does not provide parse errors.
    , Syntax.Error
    , []
@@ -94,7 +95,7 @@ htmlBlock = makeTerm <$> symbol HTMLBlock <*> (Markup.HTMLBlock <$> source)
 -- Inline elements
 
 inlineElement :: Assignment
-inlineElement = strong <|> emphasis <|> text <|> link <|> htmlInline <|> image <|> code <|> lineBreak <|> softBreak
+inlineElement = strong <|> emphasis <|> strikethrough <|> text <|> link <|> htmlInline <|> image <|> code <|> lineBreak <|> softBreak
 
 strong :: Assignment
 strong = makeTerm <$> symbol Strong <*> children (Markup.Strong <$> many inlineElement)
@@ -102,6 +103,9 @@ strong = makeTerm <$> symbol Strong <*> children (Markup.Strong <$> many inlineE
 emphasis :: Assignment
 emphasis = makeTerm <$> symbol Emphasis <*> children (Markup.Emphasis <$> many inlineElement)
 
+strikethrough :: Assignment
+strikethrough = makeTerm <$> symbol Strikethrough <*> children (Markup.Strikethrough <$> many inlineElement)
+
 text :: Assignment
 text = makeTerm <$> symbol Text <*> (Markup.Text <$> source)
 

From 9d4ab1a878484c8a09d1dabfdd2bc68504ce1ca8 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Sun, 6 Aug 2017 16:21:58 -0400
Subject: [PATCH 02/11] Bump effects for faster compilation.

https://github.com/joshvera/effects/pull/10
---
 vendor/effects | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/vendor/effects b/vendor/effects
index 4ed36cb52..1322c6657 160000
--- a/vendor/effects
+++ b/vendor/effects
@@ -1 +1 @@
-Subproject commit 4ed36cb52f60e4d6b692515aa05c493ffcb320bc
+Subproject commit 1322c6657bb589458ed33f526b83c83eb53b0ec0

From 1fa09cebe31283e993f6d10682dbca8a4c368437 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 4 Aug 2017 17:04:38 -0400
Subject: [PATCH 03/11] Constrain the types in the union instead of
 constraining the Union.

---
 src/Data/Syntax/Algebra.hs | 4 ++--
 src/Renderer/TOC.hs        | 4 ++--
 2 files changed, 4 insertions(+), 4 deletions(-)

diff --git a/src/Data/Syntax/Algebra.hs b/src/Data/Syntax/Algebra.hs
index 275e176b2..1613348a5 100644
--- a/src/Data/Syntax/Algebra.hs
+++ b/src/Data/Syntax/Algebra.hs
@@ -43,7 +43,7 @@ newtype Identifier = Identifier ByteString
 -- | Produce the identifier for a given term, if any.
 --
 --   Identifier syntax is labelled, as well as declaration syntax identified by these, but other uses of these identifiers are not, e.g. the declaration of a class or method or binding of a variable will be labelled, but a function call will not.
-identifierAlgebra :: (Syntax.Identifier :< fs, Declaration.Method :< fs, Declaration.Class :< fs, Traversable (Union fs)) => FAlgebra (Base (Term (Union fs) a)) (Maybe Identifier)
+identifierAlgebra :: (Syntax.Identifier :< fs, Declaration.Method :< fs, Declaration.Class :< fs, Apply1 Foldable fs, Apply1 Functor fs) => FAlgebra (Base (Term (Union fs) a)) (Maybe Identifier)
 identifierAlgebra (_ :< union) = case union of
   _ | Just (Syntax.Identifier s) <- prj union -> Just (Identifier s)
   _ | Just Declaration.Class{..} <- prj union -> classIdentifier
@@ -59,7 +59,7 @@ newtype CyclomaticComplexity = CyclomaticComplexity Int
 --   TODO: Explicit returns at the end of methods should only count once.
 --   TODO: Anonymous functions should not increase parent scope’s complexity.
 --   TODO: Inner functions should not increase parent scope’s complexity.
-cyclomaticComplexityAlgebra :: (Declaration.Method :< fs, Statement.Return :< fs, Statement.Yield :< fs, Traversable (Union fs)) => FAlgebra (Base (Term (Union fs) a)) CyclomaticComplexity
+cyclomaticComplexityAlgebra :: (Declaration.Method :< fs, Statement.Return :< fs, Statement.Yield :< fs, Apply1 Foldable fs, Apply1 Functor fs) => FAlgebra (Base (Term (Union fs) a)) CyclomaticComplexity
 cyclomaticComplexityAlgebra (_ :< union) = case union of
   _ | Just Declaration.Method{} <- prj union -> succ (sum union)
   _ | Just Statement.Return{} <- prj union -> succ (sum union)
diff --git a/src/Renderer/TOC.hs b/src/Renderer/TOC.hs
index e52b5cafa..053541b74 100644
--- a/src/Renderer/TOC.hs
+++ b/src/Renderer/TOC.hs
@@ -118,7 +118,7 @@ syntaxDeclarationAlgebra Blob{..} (a :< r) = case r of
   where getSource = toText . flip Source.slice blobSource . byteRange . extract
 
 -- | Compute 'Declaration's for methods and functions.
-declarationAlgebra :: (Declaration.Function :< fs, Declaration.Method :< fs, Syntax.Error :< fs, Functor (Union fs), HasField fields Range)
+declarationAlgebra :: (Declaration.Function :< fs, Declaration.Method :< fs, Syntax.Error :< fs, Apply1 Functor fs, HasField fields Range)
                    => Blob
                    -> RAlgebra (TermF (Union fs) (Record fields)) (Term (Union fs) (Record fields)) (Maybe Declaration)
 declarationAlgebra Blob{..} (a :< r)
@@ -129,7 +129,7 @@ declarationAlgebra Blob{..} (a :< r)
   where getSource = toText . flip Source.slice blobSource . byteRange
 
 -- | Compute 'Declaration's with the headings of 'Markup.Section's.
-markupSectionAlgebra :: (Markup.Section :< fs, Syntax.Error :< fs, HasField fields Range, Functor (Union fs), Foldable (Union fs))
+markupSectionAlgebra :: (Markup.Section :< fs, Syntax.Error :< fs, HasField fields Range, Apply1 Functor fs, Apply1 Foldable fs)
                      => Blob
                      -> RAlgebra (TermF (Union fs) (Record fields)) (Term (Union fs) (Record fields)) (Maybe Declaration)
 markupSectionAlgebra Blob{..} (a :< r)

From 07c81f114fd0dbfe82f956aa7148ecac1b796f13 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 4 Aug 2017 17:31:52 -0400
Subject: [PATCH 04/11] Move the ConstructorName instance over sums up.

---
 src/Decorators.hs | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/src/Decorators.hs b/src/Decorators.hs
index b8920d418..83c886647 100644
--- a/src/Decorators.hs
+++ b/src/Decorators.hs
@@ -49,11 +49,11 @@ instance ConstructorName (Union '[]) where
 instance ConstructorName f => ConstructorName (M1 D c f) where
   constructorName = constructorName . unM1
 
+instance (ConstructorName f, ConstructorName g) => ConstructorName (f :+: g) where
+  constructorName (L1 l) = constructorName l
+  constructorName (R1 r) = constructorName r
+
 instance Constructor c => ConstructorName (M1 C c f) where
   constructorName x = case conName x of
                         ":" -> ""
                         n -> n
-
-instance (ConstructorName f, ConstructorName g) => ConstructorName (f :+: g) where
-  constructorName (L1 l) = constructorName l
-  constructorName (R1 r) = constructorName r

From 0e19a8ed7ba5c1e07755977dbb03522edfd4268a Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 4 Aug 2017 17:37:14 -0400
Subject: [PATCH 05/11] Define ConstructorName without reference to union
 decomposition.

---
 src/Decorators.hs | 32 ++++++++++++++++----------------
 1 file changed, 16 insertions(+), 16 deletions(-)

diff --git a/src/Decorators.hs b/src/Decorators.hs
index 83c886647..7b646e893 100644
--- a/src/Decorators.hs
+++ b/src/Decorators.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE DataKinds, TypeOperators #-}
+{-# LANGUAGE DataKinds, TypeOperators, UndecidableInstances #-}
 module Decorators
 ( ConstructorLabel(..)
 , constructorNameAndConstantFields
@@ -8,6 +8,7 @@ module Decorators
 import Data.Aeson
 import Data.ByteString.Char8 (ByteString, pack, unpack)
 import Data.Functor.Classes (Show1 (liftShowsPrec))
+import Data.Proxy
 import Data.Text.Encoding (decodeUtf8)
 import Data.Union
 import GHC.Generics
@@ -22,8 +23,8 @@ constructorNameAndConstantFields :: Show1 f => TermF f a b -> ByteString
 constructorNameAndConstantFields (_ :< f) = pack (liftShowsPrec (const (const id)) (const id) 0 f "")
 
 -- | Compute a 'ConstructorLabel' label for a 'Union' of syntax 'Term's.
-constructorLabel :: ConstructorName f => TermF f a b -> ConstructorLabel
-constructorLabel (_ :< f) = ConstructorLabel $ pack (constructorName f)
+constructorLabel :: Apply1 ConstructorName fs => TermF (Union fs) a b -> ConstructorLabel
+constructorLabel (_ :< u) = ConstructorLabel $ pack (apply1 (Proxy :: Proxy ConstructorName) constructorName u)
 
 
 newtype ConstructorLabel = ConstructorLabel ByteString
@@ -38,22 +39,21 @@ instance ToJSONFields ConstructorLabel where
 class ConstructorName f where
   constructorName :: f a -> String
 
-instance (Generic1 f, ConstructorName (Rep1 f), ConstructorName (Union fs)) => ConstructorName (Union (f ': fs)) where
-  constructorName union = case decompose union of
-    Left rest -> constructorName rest
-    Right f -> constructorName (from1 f)
+instance (Generic1 f, GConstructorName (Rep1 f)) => ConstructorName f where
+  constructorName = gconstructorName . from1
 
-instance ConstructorName (Union '[]) where
-  constructorName _ = ""
 
-instance ConstructorName f => ConstructorName (M1 D c f) where
-  constructorName = constructorName . unM1
+class GConstructorName f where
+  gconstructorName :: f a -> String
 
-instance (ConstructorName f, ConstructorName g) => ConstructorName (f :+: g) where
-  constructorName (L1 l) = constructorName l
-  constructorName (R1 r) = constructorName r
+instance GConstructorName f => GConstructorName (M1 D c f) where
+  gconstructorName = gconstructorName . unM1
 
-instance Constructor c => ConstructorName (M1 C c f) where
-  constructorName x = case conName x of
+instance (GConstructorName f, GConstructorName g) => GConstructorName (f :+: g) where
+  gconstructorName (L1 l) = gconstructorName l
+  gconstructorName (R1 r) = gconstructorName r
+
+instance Constructor c => GConstructorName (M1 C c f) where
+  gconstructorName x = case conName x of
                         ":" -> ""
                         n -> n

From eed5934a21e7cd5f74e5aae4d8d4b2977391f5aa Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 4 Aug 2017 18:49:21 -0400
Subject: [PATCH 06/11] Define the Diffable instance for Unions without
 induction.

---
 src/Algorithm.hs | 15 ++++-----------
 1 file changed, 4 insertions(+), 11 deletions(-)

diff --git a/src/Algorithm.hs b/src/Algorithm.hs
index bb0d463cb..36566364e 100644
--- a/src/Algorithm.hs
+++ b/src/Algorithm.hs
@@ -2,12 +2,13 @@
 module Algorithm where
 
 import Control.Applicative (liftA2)
-import Control.Monad (guard)
+import Control.Monad (guard, join)
 import Control.Monad.Free.Freer
 import Data.Function (on)
 import Data.Functor.Both
 import Data.Functor.Classes
 import Data.Maybe
+import Data.Proxy
 import Data.These
 import Data.Union
 import Diff
@@ -100,21 +101,13 @@ class Diffable f where
 -- Right is the "head" of the Union. 'weaken' relaxes the Union to allow the possible
 -- diff terms from the "rest" of the Union, and 'inj' adds the diff terms into the Union.
 -- NB: If Left or Right Syntax terms in our Union don't match, we fail fast by returning Nothing.
-instance (Diffable f, Diffable (Union fs)) => Diffable (Union (f ': fs)) where
-  algorithmFor u1 u2 = case (decompose u1, decompose u2) of
-    (Left l1, Left l2) -> fmap weaken <$> algorithmFor l1 l2
-    (Right r1, Right r2) -> fmap inj <$> algorithmFor r1 r2
-    _ -> Nothing
+instance Apply1 Diffable fs => Diffable (Union fs) where
+  algorithmFor u1 u2 = join (apply1_2' (Proxy :: Proxy Diffable) (\ reinj f1 f2 -> fmap reinj <$> algorithmFor f1 f2) u1 u2)
 
 -- | Diff two list parameters using RWS.
 instance Diffable [] where
   algorithmFor a b = Just (byRWS a b)
 
--- | Diffing an empty Union is technically impossible because Union '[] uninhabited.
--- This instance is included because GHC cannot prove that.
-instance Diffable (Union '[]) where
-  algorithmFor _ _ = Nothing
-
 -- | A generic type class for diffing two terms defined by the Generic1 interface.
 class Diffable' f where
   algorithmFor' :: f term -> f term -> Maybe (Algorithm term diff (f diff))

From ba895fec3f92cd0f0426f525f3ba816d50074004 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Sun, 6 Aug 2017 16:32:17 -0400
Subject: [PATCH 07/11] Define ToJSONFields over Union non-inductively.

---
 src/Renderer/JSON.hs | 7 +++----
 1 file changed, 3 insertions(+), 4 deletions(-)

diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs
index eee91e62d..6c9dbd5e3 100644
--- a/src/Renderer/JSON.hs
+++ b/src/Renderer/JSON.hs
@@ -19,6 +19,7 @@ import Data.Foldable (toList)
 import Data.Functor.Both (Both)
 import qualified Data.Map as Map
 import Data.Output
+import Data.Proxy
 import Data.Record
 import Data.Semigroup ((<>))
 import Data.Text (pack, Text)
@@ -110,10 +111,8 @@ instance ToJSON a => ToJSONFields [a] where
 instance ToJSON recur => ToJSONFields (Syntax recur) where
   toJSONFields syntax = [ "children" .= toList syntax ]
 
-instance (Foldable f, ToJSON a, ToJSONFields (Union fs a)) => ToJSONFields (Union (f ': fs) a) where
-  toJSONFields u = case decompose u of
-    Left u' -> toJSONFields u'
-    Right r -> [ "children" .= toList r ]
+instance (Apply1 Foldable fs, ToJSON a) => ToJSONFields (Union fs a) where
+  toJSONFields = apply1 (Proxy :: Proxy Foldable) (\ r -> [ "children" .= toList r ])
 
 instance ToJSONFields (Union '[] a) where
   toJSONFields _ = []

From 711dcdb2031de32edf3a6f9bc61010c44c2c46a7 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Sun, 6 Aug 2017 16:35:53 -0400
Subject: [PATCH 08/11] Define GAlign over Union non-inductively.

---
 src/Data/Align/Generic.hs | 8 +++-----
 1 file changed, 3 insertions(+), 5 deletions(-)

diff --git a/src/Data/Align/Generic.hs b/src/Data/Align/Generic.hs
index 67dd2b582..ec484714e 100644
--- a/src/Data/Align/Generic.hs
+++ b/src/Data/Align/Generic.hs
@@ -4,6 +4,7 @@ module Data.Align.Generic where
 import Control.Monad
 import Data.Align
 import Data.Functor.Identity
+import Data.Proxy
 import Data.These
 import Data.Union
 import GHC.Generics
@@ -27,11 +28,8 @@ instance GAlign Maybe where
 instance GAlign Identity where
   galignWith f (Identity a) (Identity b) = Just (Identity (f (These a b)))
 
-instance (GAlign f, GAlign (Union fs)) => GAlign (Union (f ': fs)) where
-  galignWith f u1 u2 = case (decompose u1, decompose u2) of
-    (Left u1', Left u2') -> weaken <$> galignWith f u1' u2'
-    (Right r1, Right r2) -> inj <$> galignWith f r1 r2
-    _ -> Nothing
+instance (Apply1 GAlign fs) => GAlign (Union fs) where
+  galignWith f = (join .) . apply1_2' (Proxy :: Proxy GAlign) (\ inj -> (fmap inj .) . galignWith f)
 
 instance GAlign (Union '[]) where
   galignWith _ _ _ = Nothing

From 882c35649ec6bfb459df192c46c2334ae999d666 Mon Sep 17 00:00:00 2001
From: Yuki Izumi <ashe@kivikakk.ee>
Date: Mon, 7 Aug 2017 13:49:21 +1000
Subject: [PATCH 09/11] Add table syntax elements

---
 src/Data/Syntax/Markup.hs       | 18 ++++++++++++++++++
 src/Language/Markdown/Syntax.hs | 13 ++++++++++++-
 2 files changed, 30 insertions(+), 1 deletion(-)

diff --git a/src/Data/Syntax/Markup.hs b/src/Data/Syntax/Markup.hs
index 32e524b00..953e5b61d 100644
--- a/src/Data/Syntax/Markup.hs
+++ b/src/Data/Syntax/Markup.hs
@@ -66,6 +66,24 @@ data HTMLBlock a = HTMLBlock ByteString
 instance Eq1 HTMLBlock where liftEq = genericLiftEq
 instance Show1 HTMLBlock where liftShowsPrec = genericLiftShowsPrec
 
+newtype Table a = Table [a]
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+
+instance Eq1 Table where liftEq = genericLiftEq
+instance Show1 Table where liftShowsPrec = genericLiftShowsPrec
+
+newtype TableRow a = TableRow [a]
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+
+instance Eq1 TableRow where liftEq = genericLiftEq
+instance Show1 TableRow where liftShowsPrec = genericLiftShowsPrec
+
+newtype TableCell a = TableCell [a]
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+
+instance Eq1 TableCell where liftEq = genericLiftEq
+instance Show1 TableCell where liftShowsPrec = genericLiftShowsPrec
+
 
 -- Inline elements
 
diff --git a/src/Language/Markdown/Syntax.hs b/src/Language/Markdown/Syntax.hs
index ea0dfaea2..403029feb 100644
--- a/src/Language/Markdown/Syntax.hs
+++ b/src/Language/Markdown/Syntax.hs
@@ -33,6 +33,9 @@ type Syntax =
    , Markup.Section
    , Markup.ThematicBreak
    , Markup.UnorderedList
+   , Markup.Table
+   , Markup.TableRow
+   , Markup.TableCell
    -- Inline elements
    , Markup.Code
    , Markup.Emphasis
@@ -58,7 +61,7 @@ assignment = makeTerm <$> symbol Document <*> children (Markup.Document <$> many
 -- Block elements
 
 blockElement :: Assignment
-blockElement = paragraph <|> list <|> blockQuote <|> codeBlock <|> thematicBreak <|> htmlBlock <|> section
+blockElement = paragraph <|> list <|> blockQuote <|> codeBlock <|> thematicBreak <|> htmlBlock <|> section <|> table
 
 paragraph :: Assignment
 paragraph = makeTerm <$> symbol Paragraph <*> children (Markup.Paragraph <$> many inlineElement)
@@ -91,6 +94,14 @@ thematicBreak = makeTerm <$> symbol ThematicBreak <*> pure Markup.ThematicBreak
 htmlBlock :: Assignment
 htmlBlock = makeTerm <$> symbol HTMLBlock <*> (Markup.HTMLBlock <$> source)
 
+table :: Assignment
+table = makeTerm <$> symbol Table <*> children (Markup.Table <$> many tableRow)
+
+tableRow :: Assignment
+tableRow = makeTerm <$> symbol TableRow <*> children (Markup.TableRow <$> many tableCell)
+
+tableCell :: Assignment
+tableCell = makeTerm <$> symbol TableCell <*> children (Markup.TableCell <$> many inlineElement)
 
 -- Inline elements
 

From 6405e401775514446e15fd28d67646f3e6a028c4 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 7 Aug 2017 11:16:53 -0400
Subject: [PATCH 10/11] Bump effects to `master`.

https://github.com/joshvera/effects/pull/10 has been merged.
---
 vendor/effects | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/vendor/effects b/vendor/effects
index 1322c6657..90c6c9b2a 160000
--- a/vendor/effects
+++ b/vendor/effects
@@ -1 +1 @@
-Subproject commit 1322c6657bb589458ed33f526b83c83eb53b0ec0
+Subproject commit 90c6c9b2aa7ac3b5bcc0a5e5df730692b105b69c

From 87abdf2556bedb8a4e9db0d3fc0f77a2374d5678 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 7 Aug 2017 11:21:22 -0400
Subject: [PATCH 11/11] Constrain the types in the Union rather than the Union
 itself.

---
 src/Parser.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Parser.hs b/src/Parser.hs
index 8476d9804..e9ebd2223 100644
--- a/src/Parser.hs
+++ b/src/Parser.hs
@@ -42,7 +42,7 @@ data Parser term where
   -- | A parser producing 'AST' using a 'TS.Language'.
   ASTParser :: (Bounded grammar, Enum grammar) => Ptr TS.Language -> Parser (AST grammar)
   -- | A parser producing an à la carte term given an 'AST'-producing parser and an 'Assignment' onto 'Term's in some syntax type. Assignment errors will result in a top-level 'Syntax.Error' node.
-  AssignmentParser :: (Enum grammar, Eq grammar, Show grammar, Symbol grammar, Syntax.Error :< fs, Foldable (Union fs), Functor (Union fs), Recursive ast, Foldable (Base ast))
+  AssignmentParser :: (Enum grammar, Eq grammar, Show grammar, Symbol grammar, Syntax.Error :< fs, Apply1 Foldable fs, Apply1 Functor fs, Recursive ast, Foldable (Base ast))
                    => Parser ast                                                 -- ^ A parser producing AST.
                    -> (forall x. Base ast x -> Node grammar)                     -- ^ A function extracting the symbol and location.
                    -> Assignment ast grammar (Term (Union fs) (Record Location)) -- ^ An assignment from AST onto 'Term's.