Tidy up Eq/Ord constraints, add some missing Eq1/Ord1

Author: garyb

src/Text/Markdown/SlamDown/Syntax.purs

@@ -9,33 +9,33 @@ module Text.Markdown.SlamDown.Syntax
 
 import Prelude
 
+import Data.Eq (class Eq1)
 import Data.List as L
+import Data.Ord (class Ord1)
 import Test.StrongCheck.Arbitrary as SCA
 import Test.StrongCheck.Gen as Gen
-
 import Text.Markdown.SlamDown.Syntax.Block (Block(..), CodeBlockType(..), ListType(..)) as SDB
 import Text.Markdown.SlamDown.Syntax.FormField (class Value, Expr(..), FormField, FormFieldP(..), TextBox(..), TimePrecision(..), getLiteral, getUnevaluated, renderValue, stringValue, transFormField, transTextBox, traverseFormField, traverseTextBox) as SDF
 import Text.Markdown.SlamDown.Syntax.Inline (Inline(..), LinkTarget(..)) as SDI
 
 -- | `SlamDownP` is the type of SlamDown abstract syntax trees which take values in `a`.
-data SlamDownP a = SlamDown (L.List (SDB.Block a))
+newtype SlamDownP a = SlamDown (L.List (SDB.Block a))
 
 type SlamDown = SlamDownP String
 
-instance functorSlamDownP ∷ Functor SlamDownP where
-  map f (SlamDown bs) = SlamDown (map f <$> bs)
+derive instance functorSlamDownP ∷ Functor SlamDownP
 
 instance showSlamDownP ∷ (Show a) ⇒ Show (SlamDownP a) where
   show (SlamDown bs) = "(SlamDown " <> show bs <> ")"
 
-derive instance eqSlamDownP ∷ (Eq a, Ord a) ⇒ Eq (SlamDownP a)
-derive instance ordSlamDownP ∷ (Eq a, Ord a) ⇒ Ord (SlamDownP a)
+derive newtype instance eqSlamDownP ∷ Eq a ⇒ Eq (SlamDownP a)
+derive instance eq1SlamDownP ∷ Eq1 SlamDownP
 
-instance semigroupSlamDownP ∷ Semigroup (SlamDownP a) where
-  append (SlamDown bs1) (SlamDown bs2) = SlamDown (bs1 <> bs2)
+derive newtype instance ordSlamDownP ∷ Ord a ⇒ Ord (SlamDownP a)
+derive instance ord1SlamDownP ∷ Ord1 SlamDownP
 
-instance monoidSlamDownP ∷ Monoid (SlamDownP a) where
-  mempty = SlamDown mempty
+derive newtype instance semigroupSlamDownP ∷ Semigroup (SlamDownP a)
+derive newtype instance monoidSlamDownP ∷ Monoid (SlamDownP a)
 
 instance arbitrarySlamDownP ∷ (SCA.Arbitrary a, Eq a) ⇒ SCA.Arbitrary (SlamDownP a) where
   arbitrary = SlamDown <<< L.fromFoldable <$> Gen.arrayOf SCA.arbitrary

src/Text/Markdown/SlamDown/Syntax/Block.purs

@@ -6,11 +6,11 @@ module Text.Markdown.SlamDown.Syntax.Block
 
 import Prelude
 
+import Data.Eq (class Eq1)
 import Data.List as L
-
+import Data.Ord (class Ord1)
 import Test.StrongCheck.Arbitrary as SCA
 import Test.StrongCheck.Gen as Gen
-
 import Text.Markdown.SlamDown.Syntax.Inline (Inline)
 
 data Block a
@@ -22,18 +22,9 @@ data Block a
   | LinkReference String String
   | Rule
 
-instance functorBlock ∷ Functor Block where
-  map f x =
-    case x of
-      Paragraph is → Paragraph (map f <$> is)
-      Header n is → Header n (map f <$> is)
-      Blockquote bs → Blockquote (map f <$> bs)
-      Lst ty bss → Lst ty (map (map f) <$> bss)
-      CodeBlock ty ss → CodeBlock ty ss
-      LinkReference l uri → LinkReference l uri
-      Rule → Rule
-
-instance showBlock ∷ (Show a) ⇒ Show (Block a) where
+derive instance functorBlock ∷ Functor Block
+
+instance showBlock ∷ Show a ⇒ Show (Block a) where
   show (Paragraph is) = "(Paragraph " <> show is <> ")"
   show (Header n is) = "(Header " <> show n <> " " <> show is <> ")"
   show (Blockquote bs) = "(Blockquote " <> show bs <> ")"
@@ -42,8 +33,10 @@ instance showBlock ∷ (Show a) ⇒ Show (Block a) where
   show (LinkReference l uri) = "(LinkReference " <> show l <> " " <> show uri <> ")"
   show Rule = "Rule"
 
-derive instance eqBlock ∷ (Eq a, Ord a) ⇒ Eq (Block a)
-derive instance ordBlock ∷ (Ord a) ⇒ Ord (Block a)
+derive instance eqBlock ∷ Eq a ⇒ Eq (Block a)
+derive instance eq1Block ∷ Eq1 Block
+derive instance ordBlock ∷ Ord a ⇒ Ord (Block a)
+derive instance ord1Block ∷ Ord1 Block
 
 -- | Nota bene: this does not generate any recursive structure
 instance arbitraryBlock ∷ (SCA.Arbitrary a, Eq a) ⇒ SCA.Arbitrary (Block a) where

src/Text/Markdown/SlamDown/Syntax/FormField.purs

@@ -15,22 +15,18 @@ module Text.Markdown.SlamDown.Syntax.FormField
 import Prelude
 
 import Data.Array as A
-import Data.Eq (class Eq1)
+import Data.Eq (class Eq1, eq1)
 import Data.Functor.Compose (Compose(..))
 import Data.Identity (Identity(..))
 import Data.List as L
 import Data.Maybe as M
 import Data.Newtype (unwrap)
-import Data.Ord (class Ord1)
-import Data.Set as Set
+import Data.Ord (class Ord1, compare1)
 import Data.Traversable as TR
 import Data.Tuple (uncurry)
-
 import Partial.Unsafe (unsafePartial)
-
 import Test.StrongCheck.Arbitrary as SCA
 import Test.StrongCheck.Gen as Gen
-
 import Text.Markdown.SlamDown.Syntax.TextBox (TextBox(..), TimePrecision(..), transTextBox, traverseTextBox) as TB
 import Text.Markdown.SlamDown.Syntax.Value (class Value, renderValue, stringValue) as Value
 
@@ -80,31 +76,39 @@ instance showFormField ∷ (Functor f, Show (f a), Show (TB.TextBox (Compose M.M
       CheckBoxes sel ls → "(CheckBoxes " <> show sel <> " " <> show ls <> ")"
       DropDown sel ls → "(DropDown " <> show sel <> " " <> show ls <> ")"
 
-instance ordFormField ∷ (Functor f, Ord (f a), Ord (TB.TextBox (Compose M.Maybe f)), Eq (TB.TextBox (Compose M.Maybe f)), Ord (f (L.List a)), Ord (f (Set.Set a)), Ord a) ⇒ Ord (FormFieldP f a) where
-  compare =
+instance eq1FormField ∷ Eq1 f ⇒ Eq1 (FormFieldP f) where
+  eq1 = case _, _ of
+    TextBox tb1, TextBox tb2 -> tb1 == tb2
+    RadioButtons sel1 ls1, RadioButtons sel2 ls2 -> sel1 `eq1` sel2 && ls1 `eq1` ls2
+    CheckBoxes sel1 ls1, CheckBoxes sel2 ls2 -> sel1 `eq1` sel2 && ls1 `eq1` ls2
+    DropDown M.Nothing ls1, DropDown M.Nothing ls2 -> ls1 `eq1` ls2
+    DropDown (M.Just sel1) ls1, DropDown (M.Just sel2) ls2 -> sel1 `eq1` sel2 && ls1 `eq1` ls2
+    _, _ -> false
+
+instance eqFormField :: (Eq1 f, Eq a) => Eq (FormFieldP f a) where
+  eq = eq1
+
+instance ord1FormField ∷ Ord1 f ⇒ Ord1 (FormFieldP f) where
+  compare1 =
     case _, _ of
       TextBox tb1, TextBox tb2 → compare tb1 tb2
       TextBox _, _ → LT
       _, TextBox _ → GT
 
-      RadioButtons sel1 ls1, RadioButtons sel2 ls2 → compare sel1 sel2 <> compare ls1 ls2
+      RadioButtons sel1 ls1, RadioButtons sel2 ls2 → compare1 sel1 sel2 <> compare1 ls1 ls2
       RadioButtons _ _, _ → LT
       _, RadioButtons _ _ → GT
 
-      CheckBoxes sel1 ls1, CheckBoxes sel2 ls2 → compare (Set.fromFoldable <$> sel1) (Set.fromFoldable <$> sel2) <> compare ls1 ls2
+      CheckBoxes sel1 ls1, CheckBoxes sel2 ls2 → compare1 sel1 sel2 <> compare1 ls1 ls2
       CheckBoxes _ _, _ → LT
       _, CheckBoxes _ _ → GT
 
-      DropDown sel1 ls1, DropDown sel2 ls2 → compare sel1 sel2 <> compare ls1 ls2
+      DropDown M.Nothing ls1, DropDown M.Nothing ls2 → compare1 ls1 ls2
+      DropDown (M.Just sel1) ls1, DropDown (M.Just sel2) ls2 → compare1 sel1 sel2 <> compare1 ls1 ls2
+      _, _ -> EQ
 
-instance eqFormField ∷ (Functor f, Eq (f a), Eq (TB.TextBox (Compose M.Maybe f)), Eq (f (L.List a)), Eq (f (Set.Set a)), Ord a) ⇒ Eq (FormFieldP f a) where
-  eq =
-    case _, _ of
-      TextBox tb1, TextBox tb2 → tb1 == tb2
-      RadioButtons sel1 ls1, RadioButtons sel2 ls2 → sel1 == sel2 && ls1 == ls2
-      CheckBoxes sel1 ls1, CheckBoxes sel2 ls2 → ((Set.fromFoldable <$> sel1) == (Set.fromFoldable <$> sel2)) && ls1 == ls2
-      DropDown sel1 ls1, DropDown sel2 ls2 → sel1 == sel2 && ls1 == ls2
-      _, _ → false
+instance ordFormField :: (Ord1 f, Ord a) => Ord (FormFieldP f a) where
+  compare = compare1
 
 newtype ArbIdentity a = ArbIdentity a
 
@@ -302,13 +306,10 @@ instance showExpr ∷ (Show a) ⇒ Show (Expr a) where
       Unevaluated e → "(Unevaluated " <> show e <> ")"
 
 derive instance eqExpr ∷ Eq a ⇒ Eq (Expr a)
-derive instance ordExpr ∷ Ord a ⇒ Ord (Expr a)
+derive instance eq1 ∷ Eq1 Expr
 
-instance eq1 ∷ Eq1 Expr where
-  eq1 = eq
-
-instance ord1Expr ∷ Ord1 Expr where
-  compare1 = compare
+derive instance ord1Expr ∷ Ord1 Expr
+derive instance ordExpr ∷ Ord a ⇒ Ord (Expr a)
 
 genExpr ∷ ∀ a. Gen.Gen a → Gen.Gen (Expr a)
 genExpr g = do

src/Text/Markdown/SlamDown/Syntax/Inline.purs

@@ -5,12 +5,12 @@ module Text.Markdown.SlamDown.Syntax.Inline
 
 import Prelude
 
+import Data.Eq (class Eq1)
 import Data.List as L
 import Data.Maybe as M
-
+import Data.Ord (class Ord1)
 import Test.StrongCheck.Arbitrary as SCA
 import Test.StrongCheck.Gen as Gen
-
 import Text.Markdown.SlamDown.Syntax.FormField (FormField)
 
 data Inline a
@@ -26,20 +26,7 @@ data Inline a
   | Image (L.List (Inline a)) String
   | FormField String Boolean (FormField a)
 
-instance functorInline ∷ Functor Inline where
-  map f =
-    case _ of
-      Str s → Str s
-      Entity s → Entity s
-      Space → Space
-      SoftBreak → SoftBreak
-      LineBreak → LineBreak
-      Emph is → Emph (map f <$> is)
-      Strong is → Strong (map f <$> is)
-      Code b s → Code b s
-      Link is tgt → Link (map f <$> is) tgt
-      Image is tgt → Image (map f <$> is) tgt
-      FormField str b ff → FormField str b (f <$> ff)
+derive instance functorInline ∷ Functor Inline
 
 instance showInline ∷ (Show a) ⇒ Show (Inline a) where
   show (Str s) = "(Str " <> show s <> ")"
@@ -54,8 +41,10 @@ instance showInline ∷ (Show a) ⇒ Show (Inline a) where
   show (Image is uri) = "(Image " <> show is <> " " <> show uri <> ")"
   show (FormField l r f) = "(FormField " <> show l <> " " <> show r <> " " <> show f <> ")"
 
-derive instance eqInline ∷ (Eq a, Ord a) ⇒ Eq (Inline a)
+derive instance eqInline ∷ Eq a ⇒ Eq (Inline a)
+derive instance eq1Inline ∷ Eq1 Inline
 derive instance ordInline ∷ Ord a ⇒ Ord (Inline a)
+derive instance ord1Inline ∷ Ord1 Inline
 
 -- | Nota bene: this does not generate any recursive structure
 instance arbitraryInline ∷ (SCA.Arbitrary a, Eq a) ⇒ SCA.Arbitrary (Inline a) where

src/Text/Markdown/SlamDown/Syntax/TextBox.purs

@@ -62,16 +62,16 @@ traverseTextBox eta = case _ of
   Time prec def → Time prec <$> eta def
   DateTime prec def → DateTime prec <$> eta def
 
-instance showTextBox ∷ (Functor f, Show (f String), Show (f HN.HugeNum), Show (f DT.Time), Show (f DT.Date), Show (f DT.DateTime)) ⇒ Show (TextBox f) where
+instance showTextBox ∷ (Show (f String), Show (f HN.HugeNum), Show (f DT.Time), Show (f DT.Date), Show (f DT.DateTime)) ⇒ Show (TextBox f) where
   show = case _ of
     PlainText def → "(PlainText " <> show def <> ")"
     Numeric def → "(Numeric " <> show def <> ")"
     Date def → "(Date " <> show def <> ")"
     Time prec def → "(Time " <> show prec <> " " <> show def <> ")"
     DateTime prec def → "(DateTime " <> show prec <> " " <> show def <> ")"
 
-derive instance eqTextBox ∷ (Functor f, Eq1 f) ⇒ Eq (TextBox f)
-derive instance ordTextBox ∷ (Functor f, Ord1 f) ⇒ Ord (TextBox f)
+derive instance eqTextBox ∷ Eq1 f ⇒ Eq (TextBox f)
+derive instance ordTextBox ∷ Ord1 f ⇒ Ord (TextBox f)
 
 instance arbitraryTextBox ∷ (Functor f, SCA.Arbitrary (f String), SCA.Arbitrary (f Number), SCA.Arbitrary (f ADT.ArbTime), SCA.Arbitrary (f ADT.ArbDate), SCA.Arbitrary (f ADT.ArbDateTime)) ⇒ SCA.Arbitrary (TextBox f) where
   arbitrary = do