From fd28f56d1c0bd9a5e56fd859fab405ec05e04cdf Mon Sep 17 00:00:00 2001
From: Greg Pfeil <greg@technomadic.org>
Date: Sun, 3 Mar 2024 23:20:49 -0700
Subject: [PATCH] Add more instances, mostly `Read` and `Ord`
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Also some helper functions, for when the functor variants of type classes aren’t
flexible enough.
---
 .../src/Yaya/Containers/Pattern/IntMap.hs     |  90 ++++++--
 .../src/Yaya/Containers/Pattern/IntSet.hs     |  36 +++-
 containers/src/Yaya/Containers/Pattern/Map.hs | 197 +++++++++++++----
 containers/src/Yaya/Containers/Pattern/Set.hs |  88 ++++++--
 containers/yaya-containers.cabal              |   2 +-
 core-test/test/Test/Retrofit.hs               |  63 ++++--
 core-test/yaya-test.cabal                     |   2 +-
 core/src/Yaya/Fold.hs                         | 187 +++++++++++++++--
 core/src/Yaya/Fold/Common.hs                  |  58 +++--
 core/src/Yaya/Fold/Native.hs                  |  15 +-
 core/src/Yaya/Fold/Native/Internal.hs         |   8 +
 core/src/Yaya/Pattern.hs                      | 198 +++++++++++++-----
 core/src/Yaya/Retrofit.hs                     |   6 +
 core/yaya.cabal                               |   2 +-
 unsafe/src/Yaya/Unsafe/Fold/Instances.hs      |  12 +-
 unsafe/yaya-unsafe.cabal                      |   2 +-
 16 files changed, 778 insertions(+), 188 deletions(-)

diff --git a/containers/src/Yaya/Containers/Pattern/IntMap.hs b/containers/src/Yaya/Containers/Pattern/IntMap.hs
index 4a257c7..c99797f 100644
--- a/containers/src/Yaya/Containers/Pattern/IntMap.hs
+++ b/containers/src/Yaya/Containers/Pattern/IntMap.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE Safe #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 
@@ -6,26 +7,21 @@ module Yaya.Containers.Pattern.IntMap
   )
 where
 
+import "base" Control.Applicative (Alternative ((<|>)), Applicative ((<*>)), (*>))
 import "base" Control.Category (Category ((.)))
 import "base" Data.Bool (Bool (False, True), (&&))
 import "base" Data.Eq (Eq ((==)))
 import "base" Data.Foldable (Foldable)
 import "base" Data.Function (($))
-import "base" Data.Functor (Functor (fmap))
-import "base" Data.Functor.Classes
-  ( Eq1 (liftEq),
-    Eq2 (liftEq2),
-    Ord1 (liftCompare),
-    Ord2 (liftCompare2),
-    Show1 (liftShowsPrec),
-    Show2 (liftShowsPrec2),
-  )
+import "base" Data.Functor (Functor (fmap), (<$), (<$>))
 import "base" Data.Ord (Ord (compare, (<=)), Ordering (EQ, GT, LT))
 import "base" Data.Semigroup ((<>))
 import "base" Data.Traversable (Traversable)
 import qualified "base" Data.Tuple as Tuple
 import "base" GHC.Generics (Generic, Generic1)
-import "base" Text.Show (Show (showList, showsPrec), showParen, showString)
+import "base" GHC.Read (Read (readListPrec, readPrec), expectP, parens)
+import "base" Text.ParserCombinators.ReadPrec (prec, step)
+import qualified "base" Text.Read.Lex as Lex
 import qualified "containers" Data.IntMap.Internal as IntMap
 import "yaya" Yaya.Fold
   ( Projectable (project),
@@ -33,6 +29,31 @@ import "yaya" Yaya.Fold
     Steppable (embed),
   )
 import "base" Prelude (Num ((+)))
+#if MIN_VERSION_base(4, 18, 0)
+import "base" Data.Functor.Classes
+  ( Eq1,
+    Eq2 (liftEq2),
+    Ord2 (liftCompare2),
+    Ord1,
+    Read1 (liftReadPrec),
+    Read2 (liftReadPrec2),
+    Show1,
+    Show2 (liftShowsPrec2),
+  )
+import "base" Text.Show (Show (showsPrec), showParen, showString)
+#else
+import "base" Data.Functor.Classes
+  ( Eq1 (liftEq),
+    Eq2 (liftEq2),
+    Ord1 (liftCompare),
+    Ord2 (liftCompare2),
+    Read1 (liftReadPrec),
+    Read2 (liftReadPrec2),
+    Show1 (liftShowsPrec),
+    Show2 (liftShowsPrec2),
+  )
+import "base" Text.Show (Show (showList, showsPrec), showParen, showString)
+#endif
 
 data IntMapF a r
   = NilF
@@ -42,6 +63,8 @@ data IntMapF a r
     ( Eq,
       Ord,
       Generic,
+      -- | @since 0.1.1.0
+      Read,
       Show,
       Foldable,
       Functor,
@@ -62,10 +85,12 @@ instance Steppable (->) (IntMap.IntMap a) (IntMapF a) where
   embed (TipF key a) = IntMap.Tip key a
   embed (BinF prefix mask l r) = IntMap.Bin prefix mask l r
 
+#if MIN_VERSION_base(4, 18, 0)
+instance (Eq a) => Eq1 (IntMapF a)
+#else
 instance (Eq a) => Eq1 (IntMapF a) where
-  -- TODO: Remove this once base-4.18 is the oldest supported verson, as it’s
-  --       the default impl.
   liftEq = liftEq2 (==)
+#endif
 
 instance Eq2 IntMapF where
   liftEq2 f g = Tuple.curry $ \case
@@ -75,10 +100,12 @@ instance Eq2 IntMapF where
       prefix == prefix' && mask == mask' && g l l' && g r r'
     (_, _) -> False
 
+#if MIN_VERSION_base(4, 18, 0)
+instance (Ord a) => Ord1 (IntMapF a)
+#else
 instance (Ord a) => Ord1 (IntMapF a) where
-  -- TODO: Remove this once base-4.18 is the oldest supported verson, as it’s
-  --       the default impl.
   liftCompare = liftCompare2 compare
+#endif
 
 instance Ord2 IntMapF where
   liftCompare2 f g = Tuple.curry $ \case
@@ -91,25 +118,48 @@ instance Ord2 IntMapF where
       compare prefix prefix' <> compare mask mask' <> g l l' <> g r r'
     (BinF {}, _) -> GT
 
+-- | @since 0.1.1.0
+instance (Read a) => Read1 (IntMapF a) where
+  liftReadPrec = liftReadPrec2 readPrec readListPrec
+
+-- | @since 0.1.1.0
+instance Read2 IntMapF where
+  liftReadPrec2 readPrecA _ readPrecR _ =
+    let appPrec = 10
+     in parens . prec appPrec $
+          NilF
+            <$ expectP (Lex.Ident "NilF")
+            <|> expectP (Lex.Ident "TipF")
+              *> (TipF <$> step readPrec <*> step readPrecA)
+            <|> expectP (Lex.Ident "BinF")
+              *> ( BinF
+                     <$> step readPrec
+                     <*> step readPrec
+                     <*> step readPrecR
+                     <*> step readPrecR
+                 )
+
+#if MIN_VERSION_base(4, 18, 0)
+instance (Show a) => Show1 (IntMapF a)
+#else
 instance (Show a) => Show1 (IntMapF a) where
-  -- TODO: Remove this once base-4.18 is the oldest supported verson, as it’s
-  --       the default impl.
   liftShowsPrec = liftShowsPrec2 showsPrec showList
+#endif
 
 instance Show2 IntMapF where
-  liftShowsPrec2 showsPrecA _showListA showsPrecR _showListR prec =
+  liftShowsPrec2 showsPrecA _ showsPrecR _ p =
     let appPrec = 10
         nextPrec = appPrec + 1
      in \case
           NilF -> showString "NilF"
           TipF key a ->
-            showParen (nextPrec <= prec) $
-              showString "BipF "
+            showParen (nextPrec <= p) $
+              showString "TipF "
                 . showsPrec nextPrec key
                 . showString " "
                 . showsPrecA nextPrec a
           BinF prefix mask l r ->
-            showParen (nextPrec <= prec) $
+            showParen (nextPrec <= p) $
               showString "BinF "
                 . showsPrec nextPrec prefix
                 . showString " "
diff --git a/containers/src/Yaya/Containers/Pattern/IntSet.hs b/containers/src/Yaya/Containers/Pattern/IntSet.hs
index 29deda3..757d6c1 100644
--- a/containers/src/Yaya/Containers/Pattern/IntSet.hs
+++ b/containers/src/Yaya/Containers/Pattern/IntSet.hs
@@ -6,15 +6,21 @@ module Yaya.Containers.Pattern.IntSet
   )
 where
 
+import "base" Control.Applicative
+  ( Alternative ((<|>)),
+    Applicative ((<*>)),
+    (*>),
+  )
 import "base" Control.Category (Category ((.)))
 import "base" Data.Bool (Bool (False, True), (&&))
 import "base" Data.Eq (Eq ((==)))
 import "base" Data.Foldable (Foldable)
 import "base" Data.Function (($))
-import "base" Data.Functor (Functor (fmap))
+import "base" Data.Functor (Functor (fmap), (<$), (<$>))
 import "base" Data.Functor.Classes
   ( Eq1 (liftEq),
     Ord1 (liftCompare),
+    Read1 (liftReadPrec),
     Show1 (liftShowsPrec),
   )
 import "base" Data.Ord (Ord (compare, (<=)), Ordering (EQ, GT, LT))
@@ -22,6 +28,9 @@ import "base" Data.Semigroup ((<>))
 import "base" Data.Traversable (Traversable)
 import qualified "base" Data.Tuple as Tuple
 import "base" GHC.Generics (Generic, Generic1)
+import "base" GHC.Read (Read (readPrec), expectP, parens)
+import "base" Text.ParserCombinators.ReadPrec (prec, step)
+import qualified "base" Text.Read.Lex as Lex
 import "base" Text.Show (Show (showsPrec), showParen, showString)
 import qualified "containers" Data.IntSet.Internal as IntSet
 import "yaya" Yaya.Fold
@@ -39,6 +48,8 @@ data IntSetF r
     ( Eq,
       Ord,
       Generic,
+      -- | @since 0.1.1.0
+      Read,
       Show,
       Foldable,
       Functor,
@@ -79,20 +90,37 @@ instance Ord1 IntSetF where
       compare prefix prefix' <> compare mask mask' <> f l l' <> f r r'
     (BinF {}, _) -> GT
 
+-- | @since 0.1.1.0
+instance Read1 IntSetF where
+  liftReadPrec readPrecR _ =
+    let appPrec = 10
+     in parens . prec appPrec $
+          NilF
+            <$ expectP (Lex.Ident "NilF")
+            <|> expectP (Lex.Ident "TipF")
+              *> (TipF <$> step readPrec <*> step readPrec)
+            <|> expectP (Lex.Ident "BinF")
+              *> ( BinF
+                     <$> step readPrec
+                     <*> step readPrec
+                     <*> step readPrecR
+                     <*> step readPrecR
+                 )
+
 instance Show1 IntSetF where
-  liftShowsPrec showsPrecR _showListR prec =
+  liftShowsPrec showsPrecR _ p =
     let appPrec = 10
         nextPrec = appPrec + 1
      in \case
           NilF -> showString "NilF"
           TipF prefix bm ->
-            showParen (nextPrec <= prec) $
+            showParen (nextPrec <= p) $
               showString "TipF "
                 . showsPrec nextPrec prefix
                 . showString " "
                 . showsPrec nextPrec bm
           BinF prefix mask l r ->
-            showParen (nextPrec <= prec) $
+            showParen (nextPrec <= p) $
               showString "BinF "
                 . showsPrec nextPrec prefix
                 . showString " "
diff --git a/containers/src/Yaya/Containers/Pattern/Map.hs b/containers/src/Yaya/Containers/Pattern/Map.hs
index 1021bd0..02323a7 100644
--- a/containers/src/Yaya/Containers/Pattern/Map.hs
+++ b/containers/src/Yaya/Containers/Pattern/Map.hs
@@ -1,31 +1,46 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE Safe #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 
 module Yaya.Containers.Pattern.Map
   ( MapF (BinF, TipF),
+    -- | @since 0.1.1.0
+    eqMapF,
+    -- | @since 0.1.1.0
+    compareMapF,
+    -- | @since 0.1.1.0
+    readMapFPrec,
+    -- | @since 0.1.1.0
+    showsMapFPrec,
   )
 where
 
+import "base" Control.Applicative
+  ( Alternative ((<|>)),
+    Applicative ((<*>)),
+    (*>),
+  )
 import "base" Control.Category (Category ((.)))
 import "base" Data.Bool (Bool (False, True), (&&))
 import "base" Data.Eq (Eq ((==)))
 import "base" Data.Foldable (Foldable)
 import "base" Data.Function (($))
-import "base" Data.Functor (Functor (fmap))
-import "base" Data.Functor.Classes
-  ( Eq1 (liftEq),
-    Eq2 (liftEq2),
-    Ord1 (liftCompare),
-    Ord2 (liftCompare2),
-    Show1 (liftShowsPrec),
-    Show2 (liftShowsPrec2),
-  )
+import "base" Data.Functor (Functor (fmap), (<$), (<$>))
+import "base" Data.Int (Int)
 import "base" Data.Ord (Ord (compare, (<=)), Ordering (EQ, GT, LT))
 import "base" Data.Semigroup ((<>))
 import "base" Data.Traversable (Traversable)
 import qualified "base" Data.Tuple as Tuple
 import "base" GHC.Generics (Generic, Generic1)
-import "base" Text.Show (Show (showList, showsPrec), showParen, showString)
+import "base" GHC.Read (expectP)
+import "base" Text.Read
+  ( Read (readListPrec, readPrec),
+    ReadPrec,
+    parens,
+    prec,
+    step,
+  )
+import qualified "base" Text.Read.Lex as Lex
 import qualified "containers" Data.Map.Internal as Map
 import "yaya" Yaya.Fold
   ( Projectable (project),
@@ -33,12 +48,44 @@ import "yaya" Yaya.Fold
     Steppable (embed),
   )
 import "base" Prelude (Num ((+)))
+#if MIN_VERSION_base(4, 18, 0)
+import "base" Data.Functor.Classes
+  ( Eq1,
+    Eq2 (liftEq2),
+    Ord1,
+    Ord2 (liftCompare2),
+    Read1 (liftReadPrec),
+    Read2 (liftReadPrec2),
+    Show1,
+    Show2 (liftShowsPrec2),
+  )
+import "base" Text.Show (Show (showsPrec), ShowS, showParen, showString)
+#else
+import "base" Data.Functor.Classes
+  ( Eq1 (liftEq),
+    Eq2 (liftEq2),
+    Ord1 (liftCompare),
+    Ord2 (liftCompare2),
+    Read1 (liftReadPrec),
+    Read2 (liftReadPrec2),
+    Show1 (liftShowsPrec),
+    Show2 (liftShowsPrec2),
+  )
+import "base" Text.Show
+  ( Show (showList, showsPrec),
+    ShowS,
+    showParen,
+    showString,
+  )
+#endif
 
 data MapF k v r = TipF | BinF Map.Size k ~v r r
   deriving stock
     ( Eq,
       Ord,
       Generic,
+      -- | @since 0.1.1.0
+      Read,
       Show,
       Foldable,
       Functor,
@@ -57,51 +104,113 @@ instance Steppable (->) (Map.Map k v) (MapF k v) where
   embed TipF = Map.Tip
   embed (BinF size k v l r) = Map.Bin size k v l r
 
+eqMapF ::
+  (k -> k' -> Bool) ->
+  (v -> v' -> Bool) ->
+  (r -> r' -> Bool) ->
+  MapF k v r ->
+  MapF k' v' r' ->
+  Bool
+eqMapF eqK eqV eqR = Tuple.curry $ \case
+  (TipF, TipF) -> True
+  (BinF size k v l r, BinF size' k' v' l' r') ->
+    size == size' && eqK k k' && eqV v v' && eqR l l' && eqR r r'
+  (_, _) -> False
+
+compareMapF ::
+  (k -> k' -> Ordering) ->
+  (v -> v' -> Ordering) ->
+  (r -> r' -> Ordering) ->
+  MapF k v r ->
+  MapF k' v' r' ->
+  Ordering
+compareMapF compareK compareV compareR = Tuple.curry $ \case
+  (TipF, TipF) -> EQ
+  (TipF, BinF {}) -> LT
+  (BinF {}, TipF) -> GT
+  (BinF size k v l r, BinF size' k' v' l' r') ->
+    compare size size'
+      <> compareK k k'
+      <> compareV v v'
+      <> compareR l l'
+      <> compareR r r'
+
+readMapFPrec :: ReadPrec k -> ReadPrec v -> ReadPrec r -> ReadPrec (MapF k v r)
+readMapFPrec readPrecK readPrecV readPrecR =
+  let appPrec = 10
+   in parens . prec appPrec $
+        TipF
+          <$ expectP (Lex.Ident "TipF")
+          <|> expectP (Lex.Ident "BinF")
+            *> ( BinF
+                   <$> step readPrec
+                   <*> step readPrecK
+                   <*> step readPrecV
+                   <*> step readPrecR
+                   <*> step readPrecR
+               )
+
+showsMapFPrec ::
+  (Int -> k -> ShowS) ->
+  (Int -> v -> ShowS) ->
+  (Int -> r -> ShowS) ->
+  Int ->
+  MapF k v r ->
+  ShowS
+showsMapFPrec showsPrecK showsPrecV showsPrecR p =
+  let appPrec = 10
+      nextPrec = appPrec + 1
+   in \case
+        TipF -> showString "TipF"
+        BinF size k v l r ->
+          showParen (nextPrec <= p) $
+            showString "BinF "
+              . showsPrec nextPrec size
+              . showString " "
+              . showsPrecK nextPrec k
+              . showString " "
+              . showsPrecV nextPrec v
+              . showString " "
+              . showsPrecR nextPrec l
+              . showString " "
+              . showsPrecR nextPrec r
+
+#if MIN_VERSION_base(4, 18, 0)
+instance (Eq k, Eq v) => Eq1 (MapF k v)
+#else
 instance (Eq k, Eq v) => Eq1 (MapF k v) where
-  -- TODO: Remove this once base-4.18 is the oldest supported verson, as it’s
-  --       the default impl.
   liftEq = liftEq2 (==)
+#endif
 
 instance (Eq k) => Eq2 (MapF k) where
-  liftEq2 f g = Tuple.curry $ \case
-    (TipF, TipF) -> True
-    (BinF size k v l r, BinF size' k' v' l' r') ->
-      size == size' && k == k' && f v v' && g l l' && g r r'
-    (_, _) -> False
+  liftEq2 = eqMapF (==)
 
+#if MIN_VERSION_base(4, 18, 0)
+instance (Ord k, Ord v) => Ord1 (MapF k v)
+#else
 instance (Ord k, Ord v) => Ord1 (MapF k v) where
-  -- TODO: Remove this once base-4.18 is the oldest supported verson, as it’s
-  --       the default impl.
   liftCompare = liftCompare2 compare
+#endif
 
 instance (Ord k) => Ord2 (MapF k) where
-  liftCompare2 f g = Tuple.curry $ \case
-    (TipF, TipF) -> EQ
-    (TipF, BinF {}) -> LT
-    (BinF {}, TipF) -> GT
-    (BinF size k v l r, BinF size' k' v' l' r') ->
-      compare size size' <> compare k k' <> f v v' <> g l l' <> g r r'
+  liftCompare2 = compareMapF compare
+
+-- | @since 0.1.1.0
+instance (Read k, Read v) => Read1 (MapF k v) where
+  liftReadPrec = liftReadPrec2 readPrec readListPrec
+
+-- | @since 0.1.1.0
+instance (Read k) => Read2 (MapF k) where
+  liftReadPrec2 readPrecV _ readPrecR _ =
+    readMapFPrec readPrec readPrecV readPrecR
 
+#if MIN_VERSION_base(4, 18, 0)
+instance (Show k, Show v) => Show1 (MapF k v)
+#else
 instance (Show k, Show v) => Show1 (MapF k v) where
-  -- TODO: Remove this once base-4.18 is the oldest supported verson, as it’s
-  --       the default impl.
   liftShowsPrec = liftShowsPrec2 showsPrec showList
+#endif
 
 instance (Show k) => Show2 (MapF k) where
-  liftShowsPrec2 showsPrecV _showListV showsPrecR _showListR prec =
-    let appPrec = 10
-        nextPrec = appPrec + 1
-     in \case
-          TipF -> showString "TipF"
-          BinF size k v l r ->
-            showParen (nextPrec <= prec) $
-              showString "BinF "
-                . showsPrec nextPrec size
-                . showString " "
-                . showsPrec nextPrec k
-                . showString " "
-                . showsPrecV nextPrec v
-                . showString " "
-                . showsPrecR nextPrec l
-                . showString " "
-                . showsPrecR nextPrec r
+  liftShowsPrec2 showsPrecV _ showsPrecR _ =
+    showsMapFPrec showsPrec showsPrecV showsPrecR
diff --git a/containers/src/Yaya/Containers/Pattern/Set.hs b/containers/src/Yaya/Containers/Pattern/Set.hs
index 6078490..0994a5f 100644
--- a/containers/src/Yaya/Containers/Pattern/Set.hs
+++ b/containers/src/Yaya/Containers/Pattern/Set.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE Safe #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 
@@ -6,26 +7,25 @@ module Yaya.Containers.Pattern.Set
   )
 where
 
+import "base" Control.Applicative
+  ( Alternative ((<|>)),
+    Applicative ((<*>)),
+    (*>),
+  )
 import "base" Control.Category (Category ((.)))
 import "base" Data.Bool (Bool (False, True), (&&))
 import "base" Data.Eq (Eq ((==)))
 import "base" Data.Foldable (Foldable)
 import "base" Data.Function (($))
-import "base" Data.Functor (Functor (fmap))
-import "base" Data.Functor.Classes
-  ( Eq1 (liftEq),
-    Eq2 (liftEq2),
-    Ord1 (liftCompare),
-    Ord2 (liftCompare2),
-    Show1 (liftShowsPrec),
-    Show2 (liftShowsPrec2),
-  )
+import "base" Data.Functor (Functor (fmap), (<$), (<$>))
 import "base" Data.Ord (Ord (compare, (<=)), Ordering (EQ, GT, LT))
 import "base" Data.Semigroup ((<>))
 import "base" Data.Traversable (Traversable)
 import qualified "base" Data.Tuple as Tuple
 import "base" GHC.Generics (Generic, Generic1)
-import "base" Text.Show (Show (showList, showsPrec), showParen, showString)
+import "base" GHC.Read (Read (readListPrec, readPrec), expectP, parens)
+import "base" Text.ParserCombinators.ReadPrec (prec, step)
+import qualified "base" Text.Read.Lex as Lex
 import qualified "containers" Data.Set.Internal as Set
 import "yaya" Yaya.Fold
   ( Projectable (project),
@@ -33,12 +33,39 @@ import "yaya" Yaya.Fold
     Steppable (embed),
   )
 import "base" Prelude (Num ((+)))
+#if MIN_VERSION_base(4, 18, 0)
+import "base" Data.Functor.Classes
+  ( Eq1,
+    Eq2 (liftEq2),
+    Ord1,
+    Ord2 (liftCompare2),
+    Read1 (liftReadPrec),
+    Read2 (liftReadPrec2),
+    Show1,
+    Show2 (liftShowsPrec2),
+  )
+import "base" Text.Show (Show (showsPrec), showParen, showString)
+#else
+import "base" Data.Functor.Classes
+  ( Eq1 (liftEq),
+    Eq2 (liftEq2),
+    Ord1 (liftCompare),
+    Ord2 (liftCompare2),
+    Read1 (liftReadPrec),
+    Read2 (liftReadPrec2),
+    Show1 (liftShowsPrec),
+    Show2 (liftShowsPrec2),
+  )
+import "base" Text.Show (Show (showList, showsPrec), showParen, showString)
+#endif
 
 data SetF a r = TipF | BinF Set.Size a r r
   deriving stock
     ( Eq,
       Ord,
       Generic,
+      -- | @since 0.1.1.0
+      Read,
       Show,
       Foldable,
       Functor,
@@ -57,10 +84,12 @@ instance Steppable (->) (Set.Set a) (SetF a) where
   embed TipF = Set.Tip
   embed (BinF size a l r) = Set.Bin size a l r
 
+#if MIN_VERSION_base(4, 18, 0)
+instance (Eq a) => Eq1 (SetF a)
+#else
 instance (Eq a) => Eq1 (SetF a) where
-  -- TODO: Remove this once base-4.18 is the oldest supported verson, as it’s
-  --       the default impl.
   liftEq = liftEq2 (==)
+#endif
 
 instance Eq2 SetF where
   liftEq2 f g = Tuple.curry $ \case
@@ -69,10 +98,12 @@ instance Eq2 SetF where
       size == size' && f a a' && g l l' && g r r'
     (_, _) -> False
 
+#if MIN_VERSION_base(4, 18, 0)
+instance (Ord a) => Ord1 (SetF a)
+#else
 instance (Ord a) => Ord1 (SetF a) where
-  -- TODO: Remove this once base-4.18 is the oldest supported verson, as it’s
-  --       the default impl.
   liftCompare = liftCompare2 compare
+#endif
 
 instance Ord2 SetF where
   liftCompare2 f g = Tuple.curry $ \case
@@ -82,19 +113,40 @@ instance Ord2 SetF where
     (BinF size a l r, BinF size' a' l' r') ->
       compare size size' <> f a a' <> g l l' <> g r r'
 
+-- | @since 0.1.1.0
+instance (Read a) => Read1 (SetF a) where
+  liftReadPrec = liftReadPrec2 readPrec readListPrec
+
+-- | @since 0.1.1.0
+instance Read2 SetF where
+  liftReadPrec2 readPrecA _ readPrecR _ =
+    let appPrec = 10
+     in parens . prec appPrec $
+          TipF
+            <$ expectP (Lex.Ident "TipF")
+            <|> expectP (Lex.Ident "BinF")
+              *> ( BinF
+                     <$> step readPrec
+                     <*> step readPrecA
+                     <*> step readPrecR
+                     <*> step readPrecR
+                 )
+
+#if MIN_VERSION_base(4, 18, 0)
+instance (Show a) => Show1 (SetF a)
+#else
 instance (Show a) => Show1 (SetF a) where
-  -- TODO: Remove this once base-4.18 is the oldest supported verson, as it’s
-  --       the default impl.
   liftShowsPrec = liftShowsPrec2 showsPrec showList
+#endif
 
 instance Show2 SetF where
-  liftShowsPrec2 showsPrecA _showListA showsPrecR _showListR prec =
+  liftShowsPrec2 showsPrecA _ showsPrecR _ p =
     let appPrec = 10
         nextPrec = appPrec + 1
      in \case
           TipF -> showString "TipF"
           BinF size a l r ->
-            showParen (nextPrec <= prec) $
+            showParen (nextPrec <= p) $
               showString "BinF "
                 . showsPrec nextPrec size
                 . showString " "
diff --git a/containers/yaya-containers.cabal b/containers/yaya-containers.cabal
index 313f2f5..312e459 100644
--- a/containers/yaya-containers.cabal
+++ b/containers/yaya-containers.cabal
@@ -1,7 +1,7 @@
 cabal-version:  3.0
 
 name:        yaya-containers
-version:     0.1.0.2
+version:     0.1.1.0
 synopsis:    Pattern functors and instances for types in the containers package.
 author:      Greg Pfeil <greg@technomadic.org>
 maintainer:  Greg Pfeil <greg@technomadic.org>
diff --git a/core-test/test/Test/Retrofit.hs b/core-test/test/Test/Retrofit.hs
index 71e9f72..65c7d33 100644
--- a/core-test/test/Test/Retrofit.hs
+++ b/core-test/test/Test/Retrofit.hs
@@ -6,30 +6,69 @@
 module Test.Retrofit (tests) where
 
 import safe "base" Data.Bool (Bool)
-import safe "base" Data.Eq (Eq)
+import safe "base" Data.Eq (Eq ((==)))
 import safe "base" Data.Int (Int)
+import safe "base" Data.Ord (Ord (compare))
 import safe "base" System.IO (IO)
-import safe "base" Text.Show (Show)
+import safe "base" Text.Read
+  ( Read (readListPrec, readPrec),
+    readListPrecDefault,
+  )
+import safe "base" Text.Show (Show (showsPrec))
+import safe "deriving-compat" Data.Eq.Deriving (deriveEq1)
+import safe "deriving-compat" Data.Ord.Deriving (deriveOrd1)
+import safe "deriving-compat" Text.Read.Deriving (deriveRead1)
+import safe "deriving-compat" Text.Show.Deriving (deriveShow1)
 import safe "hedgehog" Hedgehog (checkParallel, discover)
-import safe "yaya" Yaya.Retrofit (defaultRules, extractPatternFunctor)
+import safe "yaya" Yaya.Retrofit
+  ( defaultRules,
+    extractPatternFunctor,
+    recursiveCompare,
+    recursiveEq,
+    recursiveShowsPrec,
+    steppableReadPrec,
+  )
 
 data DExpr
   = Lit Int
   | Add DExpr DExpr
   | Mult DExpr DExpr
-  deriving stock (Eq, Show)
 
 extractPatternFunctor defaultRules ''DExpr
 
--- -- | This can be derived in this case, but we want to ensure we could define it
--- --   if necessary.
--- instance Eq DExpr where
---   (==) = recursiveEq
+deriving stock instance (Eq a) => Eq (DExprF a)
 
--- -- | This can be derived in this case, but we want to ensure we could define it
--- --   if necessary.
--- instance Show DExpr where
---   showsPrec = recursiveShowsPrec
+deriving stock instance (Ord a) => Ord (DExprF a)
+
+deriving stock instance (Read a) => Read (DExprF a)
+
+deriving stock instance (Show a) => Show (DExprF a)
+
+deriveEq1 ''DExprF
+deriveOrd1 ''DExprF
+deriveRead1 ''DExprF
+deriveShow1 ''DExprF
+
+-- | This can be derived in this case, but we want to ensure we could define it
+--   if necessary.
+instance Eq DExpr where
+  (==) = recursiveEq
+
+-- | This can be derived in this case, but we want to ensure we could define it
+--   if necessary.
+instance Ord DExpr where
+  compare = recursiveCompare
+
+-- | This can be derived in this case, but we want to ensure we could define it
+--   if necessary.
+instance Read DExpr where
+  readPrec = steppableReadPrec
+  readListPrec = readListPrecDefault
+
+-- | This can be derived in this case, but we want to ensure we could define it
+--   if necessary.
+instance Show DExpr where
+  showsPrec = recursiveShowsPrec
 
 tests :: IO Bool
 tests = checkParallel $$discover
diff --git a/core-test/yaya-test.cabal b/core-test/yaya-test.cabal
index 793d42e..03f2e3a 100644
--- a/core-test/yaya-test.cabal
+++ b/core-test/yaya-test.cabal
@@ -1,7 +1,7 @@
 cabal-version:  3.0
 
 name:        yaya-test
-version:     0.3.1.3
+version:     0.3.2.0
 synopsis:    Test suites for `yaya`.
 description: This package should not be depended on by anything.
 author:      Greg Pfeil <greg@technomadic.org>
diff --git a/core/src/Yaya/Fold.hs b/core/src/Yaya/Fold.hs
index dbaef1b..60dc9db 100644
--- a/core/src/Yaya/Fold.hs
+++ b/core/src/Yaya/Fold.hs
@@ -49,35 +49,59 @@ module Yaya.Fold
     lowerCoalgebra,
     lowerCoalgebraM,
     lowerDay,
+    recursiveCompare,
+    recursiveCompare',
     recursiveEq,
+    recursiveEq',
     recursivePrism,
     recursiveShowsPrec,
+    recursiveShowsPrec',
     seqEither,
     seqIdentity,
     steppableIso,
+    steppableReadPrec,
+    steppableReadPrec',
     unFree,
     zipAlgebraMs,
     zipAlgebras,
   )
 where
 
-import "base" Control.Applicative (Applicative (pure))
-import "base" Control.Category (Category (id, (.)))
+import "base" Control.Applicative (Applicative (pure), (*>))
+import "base" Control.Category (Category ((.)))
 import "base" Control.Monad (Monad, join, (<=<), (=<<))
 import "base" Data.Bifunctor (Bifunctor (bimap, first, second))
 import "base" Data.Bitraversable (bisequence)
-import "base" Data.Bool (Bool (True))
+import "base" Data.Bool (Bool)
 import "base" Data.Eq (Eq ((==)))
-import "base" Data.Foldable (Foldable (fold, toList))
-import "base" Data.Function (const, ($))
+import "base" Data.Foldable (Foldable (toList))
+import "base" Data.Function (const, flip, ($))
 import "base" Data.Functor (Functor (fmap), (<$>))
-import "base" Data.Functor.Classes (Eq1, Show1 (liftShowsPrec))
+import "base" Data.Functor.Classes
+  ( Eq1 (liftEq),
+    Ord1 (liftCompare),
+    Read1 (liftReadPrec),
+    Show1,
+  )
 import "base" Data.Int (Int)
 import "base" Data.List.NonEmpty (NonEmpty ((:|)))
+import "base" Data.Ord (Ord (compare, (<=)), Ordering)
+import "base" Data.String (String)
 import "base" Data.Traversable (sequenceA)
 import "base" Data.Void (Void, absurd)
+import "base" GHC.Read (expectP, list)
+import "base" GHC.Show (appPrec1)
 import "base" Numeric.Natural (Natural)
-import "base" Text.Show (Show (showsPrec), ShowS, showParen)
+import "base" Text.Read
+  ( Read (readListPrec, readPrec),
+    ReadPrec,
+    parens,
+    prec,
+    readListPrecDefault,
+    step,
+  )
+import qualified "base" Text.Read.Lex as Lex
+import "base" Text.Show (Show (showsPrec), ShowS, showParen, showString)
 import "comonad" Control.Comonad (Comonad (duplicate, extend, extract))
 import "comonad" Control.Comonad.Trans.Env
   ( EnvT (EnvT),
@@ -101,7 +125,13 @@ import "lens" Control.Lens
     view,
   )
 import "strict" Data.Strict.Classes (Strict (toStrict))
-import "this" Yaya.Fold.Common (diagonal, equal, fromEither)
+import "this" Yaya.Fold.Common
+  ( compareDay,
+    diagonal,
+    equalDay,
+    fromEither,
+    showsPrecF,
+  )
 import "this" Yaya.Functor (DFunctor (dmap))
 import "this" Yaya.Pattern
   ( AndMaybe (Indeed, Only),
@@ -116,6 +146,9 @@ import "this" Yaya.Pattern
   )
 import "base" Prelude (Enum (pred, succ))
 
+-- $setup
+-- >>> :seti -XTypeApplications
+
 type Algebra c f a = f a `c` a
 
 type GAlgebra c w f a = f (w a) `c` a
@@ -162,20 +195,126 @@ class Recursive c t f | t -> f where
 class Corecursive c t f | t -> f where
   ana :: Coalgebra c f a -> a `c` t
 
--- | An implementation of `Eq` for any `Recursive` instance. Note that this is
---   actually more general than `Eq`, as it can compare between different
+-- | Like `recursiveEq`, but allows you to provide a custom comparator for @f@.
+--
+--   @since 0.5.3.0
+recursiveEq' ::
+  (Recursive (->) t f, Steppable (->) u f, Functor f, Foldable f) =>
+  (f () -> f () -> Bool) ->
+  t ->
+  u ->
+  Bool
+recursiveEq' = cata2 . equalDay
+
+-- | An implementation of `==` for any `Recursive` instance. Note that this is
+--   actually more general than `Eq`’s `==`, as it can compare between different
 --   fixed-point representations of the same functor.
+--
+--  __NB__: Use `recursiveEq'` if you need to use a custom comparator for @f@.
 recursiveEq ::
   (Recursive (->) t f, Steppable (->) u f, Functor f, Foldable f, Eq1 f) =>
   t ->
   u ->
   Bool
-recursiveEq = cata2 equal
+recursiveEq = recursiveEq' $ liftEq (==)
+
+-- | Like `recursiveCompare`, but allows you to provide a custom comparator for
+--   @f@.
+--
+--   @since 0.5.3.0
+recursiveCompare' ::
+  (Recursive (->) t f, Steppable (->) u f, Functor f, Foldable f) =>
+  (f () -> f () -> Ordering) ->
+  t ->
+  u ->
+  Ordering
+recursiveCompare' = cata2 . compareDay
+
+-- | An implementation of `==` for any `Recursive` instance. Note that this is
+--   actually more general than `Ord`’s `compare`, as it can compare between
+--   different fixed-point representations of the same functor.
+--
+--  __NB__: Use `recursiveCompare'` if you need to use a custom comparator for
+--          @f@.
+--
+--   @since 0.5.3.0
+recursiveCompare ::
+  (Recursive (->) t f, Steppable (->) u f, Functor f, Foldable f, Ord1 f) =>
+  t ->
+  u ->
+  Ordering
+recursiveCompare = recursiveCompare' $ liftCompare compare
+
+embedOperation :: String
+embedOperation = "embed"
 
--- | An implementation of `Show` for any `Recursive` instance.
+-- | Like `recursiveShowsPrec`, but allows you to provide a custom display
+--   function for @f@.
+--
+--   @since 0.5.3.0
+recursiveShowsPrec' ::
+  (Recursive (->) t f) => Algebra (->) f (Int -> ShowS) -> Int -> t -> ShowS
+recursiveShowsPrec' showsFPrec = flip . cata $
+  \f p ->
+    showParen (appPrec1 <= p) $
+      showString embedOperation . showString " " . showsFPrec f appPrec1
+
+-- | An implementation of `showsPrec` for any `Recursive` instance.
+--
+-- >>> :{
+--   recursiveShowsPrec
+--     @(Mu (XNor String))
+--     10
+--     (embed (Both "a" (embed (Both "b" (embed Neither)))))
+--     ""
+-- :}
+-- "embed (Both \"a\" (embed (Both \"b\" (embed Neither))))"
+--
+-- >>> :{
+--   recursiveShowsPrec
+--     @(Mu (XNor String))
+--     11
+--     (embed (Both "a" (embed (Both "b" (embed Neither)))))
+--     ""
+-- :}
+-- "(embed (Both \"a\" (embed (Both \"b\" (embed Neither)))))"
+--
+--  __NB__: Use `recursiveShowsPrec'` if you need to use a custom serialization
+--          function for @f@.
+--
+--  __NB__: This only requires `Recursive`, but the inverse operation is
+--         `steppableReadPrec`, which requires `Steppable` instead.
 recursiveShowsPrec :: (Recursive (->) t f, Show1 f) => Int -> t -> ShowS
-recursiveShowsPrec prec =
-  cata (showParen True . liftShowsPrec (const id) fold prec)
+recursiveShowsPrec = recursiveShowsPrec' $ flip showsPrecF
+
+-- | Like `steppableReadPrec`, but allows you to provide a custom display
+--   function for @f@.
+--
+--   @since 0.5.3.0
+steppableReadPrec' ::
+  (Steppable (->) t f) =>
+  (ReadPrec t -> ReadPrec [t] -> ReadPrec (f t)) ->
+  ReadPrec t
+steppableReadPrec' readFPrec =
+  let appPrec = 10
+   in parens . prec appPrec . fmap embed $
+        expectP (Lex.Ident embedOperation)
+          *> step
+            ( readFPrec (steppableReadPrec' readFPrec) . list $
+                steppableReadPrec' readFPrec
+            )
+
+-- | An implementation of `readPrec` for any `Steppable` instance.
+--
+--  __NB__: Use `steppableReadPrec'` if you need to use a custom parsing
+--          function  for @f@.
+--
+--  __NB__: This only requires `Steppable`, but the inverse operation is
+--         `recursiveShowsPrec`, which requires `Recursive` instead.
+--
+--   @since 0.5.3.0
+steppableReadPrec :: (Steppable (->) t f, Read1 f) => ReadPrec t
+steppableReadPrec = steppableReadPrec' liftReadPrec
 
 -- | A fixed-point operator for inductive / finite data structures.
 --
@@ -196,12 +335,21 @@ instance Recursive (->) (Mu f) f where
 instance DFunctor Mu where
   dmap f (Mu run) = Mu (\φ -> run (φ . f))
 
-instance (Show1 f) => Show (Mu f) where
-  showsPrec = recursiveShowsPrec
-
 instance (Functor f, Foldable f, Eq1 f) => Eq (Mu f) where
   (==) = recursiveEq
 
+-- | @since 0.5.3.0
+instance (Functor f, Foldable f, Ord1 f) => Ord (Mu f) where
+  compare = recursiveCompare
+
+-- | @since 0.5.3.0
+instance (Functor f, Read1 f) => Read (Mu f) where
+  readPrec = steppableReadPrec
+  readListPrec = readListPrecDefault
+
+instance (Show1 f) => Show (Mu f) where
+  showsPrec = recursiveShowsPrec
+
 -- | A fixed-point operator for coinductive / potentially-infinite data
 --   structures.
 data Nu f where Nu :: Coalgebra (->) f a -> a -> Nu f
@@ -218,6 +366,11 @@ instance Corecursive (->) (Nu f) f where
 instance DFunctor Nu where
   dmap f (Nu φ a) = Nu (f . φ) a
 
+-- | @since 0.5.3.0
+instance (Functor f, Read1 f) => Read (Nu f) where
+  readPrec = steppableReadPrec
+  readListPrec = readListPrecDefault
+
 instance Projectable (->) [a] (XNor a) where
   project [] = Neither
   project (h : t) = Both h t
diff --git a/core/src/Yaya/Fold/Common.hs b/core/src/Yaya/Fold/Common.hs
index 0328658..e6a06c0 100644
--- a/core/src/Yaya/Fold/Common.hs
+++ b/core/src/Yaya/Fold/Common.hs
@@ -4,8 +4,10 @@
 module Yaya.Fold.Common
   ( binarySequence,
     definedOrInput,
+    compareDay,
     diagonal,
     equal,
+    equalDay,
     fromEither,
     height,
     le,
@@ -16,6 +18,7 @@ module Yaya.Fold.Common
     maybeTakeNext,
     never,
     replaceNeither,
+    showsPrecF,
     size,
     takeAnother,
     takeAvailable,
@@ -24,6 +27,7 @@ module Yaya.Fold.Common
     toRight,
     truncate',
     unarySequence,
+    xnor,
   )
 where
 
@@ -32,40 +36,41 @@ import "base" Control.Category (Category (id, (.)))
 import "base" Control.Monad (Monad, join)
 import "base" Data.Bool (Bool (False, True), (&&))
 import "base" Data.Eq (Eq ((==)))
-import "base" Data.Foldable (Foldable (foldr, toList), and)
-import "base" Data.Function (($))
+import "base" Data.Foldable (Foldable (foldr, toList), and, fold)
+import "base" Data.Function (($), (&))
 import "base" Data.Functor (Functor (fmap), void)
-import "base" Data.Functor.Classes (Eq1 (liftEq))
+import "base" Data.Functor.Classes (Eq1 (liftEq), Show1 (liftShowsPrec))
 import "base" Data.Functor.Identity (Identity (Identity, runIdentity))
+import "base" Data.Int (Int)
 import "base" Data.List (zipWith)
 import "base" Data.Monoid (Monoid (mempty))
-import "base" Data.Ord (Ord (max))
+import "base" Data.Ord (Ord (max), Ordering)
 import "base" Data.Semigroup (Semigroup ((<>)))
+import "base" GHC.Show (showList__)
 import "base" Numeric.Natural (Natural)
+import "base" Text.Show (ShowS)
 import "free" Control.Monad.Trans.Free (FreeF (Free, Pure))
 import "kan-extensions" Data.Functor.Day (Day (Day))
 import "this" Yaya.Pattern
-  ( AndMaybe (Indeed, Only),
+  ( AndMaybe,
     Either (Left, Right),
     Maybe (Just, Nothing),
     Pair ((:!:)),
     XNor (Both, Neither),
+    andMaybe,
     either,
     maybe,
+    xnor,
   )
 import Prelude (Integer, Num ((*), (+), (-)))
 
 -- | Converts the free monoid (a list) into some other `Monoid`.
 lowerMonoid :: (Monoid m) => (a -> m) -> XNor a m -> m
-lowerMonoid f = \case
-  Neither -> mempty
-  Both a b -> f a <> b
+lowerMonoid = xnor mempty . ((<>) .)
 
 -- | Converts the free semigroup (a non-empty list) into some other `Semigroup`.
 lowerSemigroup :: (Semigroup m) => (a -> m) -> AndMaybe a m -> m
-lowerSemigroup f = \case
-  Only a -> f a
-  Indeed a b -> f a <> b
+lowerSemigroup f = andMaybe f ((<>) . f)
 
 -- | Converts the free monad into some other `Monad`.
 lowerMonad :: (Monad m) => (forall x. f x -> m x) -> FreeF f a (m a) -> m a
@@ -74,11 +79,36 @@ lowerMonad f = \case
   Free fm -> join (f fm)
 
 -- | Provides equality over arbitrary pattern functors.
-equal :: (Functor f, Foldable f, Eq1 f) => Day f f Bool -> Bool
-equal (Day f1 f2 fn) =
-  liftEq (==) (void f1) (void f2)
+--
+--   @since 0.5.3.0
+equalDay ::
+  (Functor f, Foldable f) => (f () -> f () -> Bool) -> Day f f Bool -> Bool
+equalDay eqF (Day f1 f2 fn) =
+  eqF (void f1) (void f2)
     && and (zipWith fn (toList f1) (toList f2))
 
+-- | Provides equality over arbitrary pattern functors.
+equal :: (Functor f, Foldable f, Eq1 f) => Day f f Bool -> Bool
+equal = equalDay $ liftEq (==)
+
+-- | Provides ordering over arbitrary pattern functors.
+--
+--   @since 0.5.3.0
+compareDay ::
+  (Functor f, Foldable f) =>
+  (f () -> f () -> Ordering) ->
+  Day f f Ordering ->
+  Ordering
+compareDay compareF (Day f1 f2 fn) =
+  compareF (void f1) (void f2)
+    <> fold (zipWith fn (toList f1) (toList f2))
+
+-- | Provides show over arbitrary pattern functors.
+--
+--   @since 0.5.3.0
+showsPrecF :: (Show1 f) => Int -> f (Int -> ShowS) -> ShowS
+showsPrecF = liftShowsPrec (&) (showList__ ($ 0))
+
 -- TODO: Redefine this using `Natural`
 
 -- | When folded, returns the height of the data structure.
diff --git a/core/src/Yaya/Fold/Native.hs b/core/src/Yaya/Fold/Native.hs
index febeca1..43d0fec 100644
--- a/core/src/Yaya/Fold/Native.hs
+++ b/core/src/Yaya/Fold/Native.hs
@@ -17,9 +17,11 @@ import "base" Data.Eq (Eq ((==)))
 import "base" Data.Foldable (Foldable (toList))
 import "base" Data.Function (($))
 import "base" Data.Functor (Functor (fmap))
-import "base" Data.Functor.Classes (Eq1, Show1)
+import "base" Data.Functor.Classes (Eq1, Ord1, Read1, Show1)
 import "base" Data.List.NonEmpty (NonEmpty ((:|)))
+import "base" Data.Ord (Ord (compare))
 import "base" Numeric.Natural (Natural)
+import "base" Text.Read (Read (readListPrec, readPrec), readListPrecDefault)
 import "base" Text.Show (Show (showsPrec))
 import "comonad" Control.Comonad (Comonad (extract))
 import "comonad" Control.Comonad.Trans.Env (EnvT (EnvT), runEnvT)
@@ -32,8 +34,10 @@ import "this" Yaya.Fold
     Projectable (project),
     Recursive (cata),
     Steppable (embed),
+    recursiveCompare,
     recursiveEq,
     recursiveShowsPrec,
+    steppableReadPrec,
   )
 import "this" Yaya.Fold.Common (diagonal)
 import "this" Yaya.Fold.Native.Internal (Cofix (unCofix))
@@ -60,6 +64,15 @@ instance (Functor f) => Recursive (->) (Fix f) f where
 instance (Functor f, Foldable f, Eq1 f) => Eq (Fix f) where
   (==) = recursiveEq
 
+-- | @since 0.5.3.0
+instance (Functor f, Foldable f, Ord1 f) => Ord (Fix f) where
+  compare = recursiveCompare
+
+-- | @since 0.5.3.0
+instance (Read1 f) => Read (Fix f) where
+  readPrec = steppableReadPrec
+  readListPrec = readListPrecDefault
+
 instance (Functor f, Show1 f) => Show (Fix f) where
   showsPrec = recursiveShowsPrec
 
diff --git a/core/src/Yaya/Fold/Native/Internal.hs b/core/src/Yaya/Fold/Native/Internal.hs
index 1d53e26..5cd0b22 100644
--- a/core/src/Yaya/Fold/Native/Internal.hs
+++ b/core/src/Yaya/Fold/Native/Internal.hs
@@ -14,10 +14,13 @@ where
 
 import "base" Control.Category (Category ((.)))
 import "base" Data.Functor (Functor (fmap))
+import "base" Data.Functor.Classes (Read1)
+import "base" Text.Read (Read (readListPrec, readPrec), readListPrecDefault)
 import "this" Yaya.Fold
   ( Corecursive (ana),
     Projectable (project),
     Steppable (embed),
+    steppableReadPrec,
   )
 
 -- | A fixed-point constructor that uses Haskell's built-in recursion. This is
@@ -34,3 +37,8 @@ instance Steppable (->) (Cofix f) f where
 
 instance (Functor f) => Corecursive (->) (Cofix f) f where
   ana φ = embed . fmap (ana φ) . φ
+
+-- | @since 0.5.3.0
+instance (Read1 f) => Read (Cofix f) where
+  readPrec = steppableReadPrec
+  readListPrec = readListPrecDefault
diff --git a/core/src/Yaya/Pattern.hs b/core/src/Yaya/Pattern.hs
index 2c4210a..7f44353 100644
--- a/core/src/Yaya/Pattern.hs
+++ b/core/src/Yaya/Pattern.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE Safe #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 
@@ -11,32 +12,31 @@ module Yaya.Pattern
     module Data.Strict.Tuple,
     AndMaybe (Indeed, Only),
     XNor (Both, Neither),
+    andMaybe,
+    xnor,
   )
 where
 
-import "base" Control.Applicative (Applicative (liftA2, pure))
+import "base" Control.Applicative
+  ( Alternative ((<|>)),
+    Applicative (liftA2, pure, (<*>)),
+    (*>),
+  )
 import "base" Control.Category (Category ((.)))
 import "base" Control.Monad (Monad ((>>=)))
 import "base" Data.Bifunctor (Bifunctor (bimap))
 import "base" Data.Bool (Bool (False, True), (&&))
-import "base" Data.Eq (Eq ((==)))
 import "base" Data.Foldable (Foldable)
 import "base" Data.Function (($))
-import "base" Data.Functor (Functor)
-import "base" Data.Functor.Classes
-  ( Eq1 (liftEq),
-    Eq2 (liftEq2),
-    Ord1 (liftCompare),
-    Ord2 (liftCompare2),
-    Show1 (liftShowsPrec),
-    Show2 (liftShowsPrec2),
-  )
+import "base" Data.Functor (Functor, (<$), (<$>))
 import "base" Data.Ord (Ord (compare, (<=)), Ordering (EQ, GT, LT))
 import "base" Data.Semigroup ((<>))
 import "base" Data.Traversable (Traversable)
 import qualified "base" Data.Tuple as Tuple
 import "base" GHC.Generics (Generic, Generic1)
-import "base" Text.Show (Show (showList, showsPrec), showParen, showString)
+import "base" GHC.Read (expectP)
+import "base" Text.Read (Read (readListPrec, readPrec), parens, prec, step)
+import qualified "base" Text.Read.Lex as Lex
 import "comonad" Control.Comonad (Comonad (duplicate, extract))
 import "strict" Data.Strict.Either
   ( Either (Left, Right),
@@ -73,13 +73,42 @@ import "strict" Data.Strict.Tuple
     (:!:),
   )
 import "base" Prelude (Num ((+)))
+#if MIN_VERSION_base(4, 18, 0)
+import "base" Data.Eq (Eq)
+import "base" Data.Functor.Classes
+  ( Eq1,
+    Eq2 (liftEq2),
+    Ord1 (liftCompare),
+    Ord2 (liftCompare2),
+    Read1 (liftReadPrec),
+    Read2 (liftReadPrec2),
+    Show1,
+    Show2 (liftShowsPrec2),
+  )
+import "base" Text.Show (Show, showParen, showString)
+#else
+import "base" Data.Eq (Eq ((==)))
+import "base" Data.Functor.Classes
+  ( Eq1 (liftEq),
+    Eq2 (liftEq2),
+    Ord1 (liftCompare),
+    Ord2 (liftCompare2),
+    Read1 (liftReadPrec),
+    Read2 (liftReadPrec2),
+    Show1 (liftShowsPrec),
+    Show2 (liftShowsPrec2),
+  )
+import "base" Text.Show (Show (showList, showsPrec), showParen, showString)
+#endif
 
--- | Isomorphic to 'Maybe (a, b)', it’s also the pattern functor for lists.
+-- | Isomorphic to @'Maybe` (a, b)@, it’s also the pattern functor for lists.
 data XNor a b = Neither | Both ~a b
   deriving stock
     ( Eq,
       Generic,
       Ord,
+      -- | @since 0.5.3.0
+      Read,
       Show,
       Foldable,
       Functor,
@@ -87,10 +116,20 @@ data XNor a b = Neither | Both ~a b
       Traversable
     )
 
+-- | Eliminator for `XNor`, akin to `Data.Either.either` or `Data.Maybe.maybe`.
+--
+--   @since 0.5.3.0
+xnor :: c -> (a -> b -> c) -> XNor a b -> c
+xnor neither both = \case
+  Neither -> neither
+  Both x y -> both x y
+
+#if MIN_VERSION_base(4, 18, 0)
+instance (Eq a) => Eq1 (XNor a)
+#else
 instance (Eq a) => Eq1 (XNor a) where
-  -- TODO: Remove this once base-4.18 is the oldest supported verson, as it’s
-  --       the default impl.
   liftEq = liftEq2 (==)
+#endif
 
 instance Eq2 XNor where
   liftEq2 f g = Tuple.curry $ \case
@@ -98,10 +137,12 @@ instance Eq2 XNor where
     (Both x y, Both x' y') -> f x x' && g y y'
     (_, _) -> False
 
+#if MIN_VERSION_base(4, 18, 0)
+instance (Ord a) => Ord1 (XNor a)
+#else
 instance (Ord a) => Ord1 (XNor a) where
-  -- TODO: Remove this once base-4.18 is the oldest supported verson, as it’s
-  --       the default impl.
   liftCompare = liftCompare2 compare
+#endif
 
 instance Ord2 XNor where
   liftCompare2 f g = Tuple.curry $ \case
@@ -110,38 +151,74 @@ instance Ord2 XNor where
     (Both _ _, Neither) -> GT
     (Both x y, Both x' y') -> f x x' <> g y y'
 
+-- | @since 0.5.3.0
+instance (Read a) => Read1 (XNor a) where
+  liftReadPrec = liftReadPrec2 readPrec readListPrec
+
+-- | @since 0.5.3.0
+instance Read2 XNor where
+  liftReadPrec2 readPrecX _ readPrecY _ =
+    let appPrec = 10
+     in parens . prec appPrec $
+          Neither
+            <$ expectP (Lex.Ident "Neither")
+            <|> expectP (Lex.Ident "Both")
+              *> (Both <$> step readPrecX <*> step readPrecY)
+
+#if MIN_VERSION_base(4, 18, 0)
+instance (Show a) => Show1 (XNor a)
+#else
 instance (Show a) => Show1 (XNor a) where
-  -- TODO: Remove this once base-4.18 is the oldest supported verson, as it’s
-  --       the default impl.
   liftShowsPrec = liftShowsPrec2 showsPrec showList
+#endif
 
 instance Show2 XNor where
-  liftShowsPrec2 showsPrecX _showListX showsPrecY _showListY prec =
+  liftShowsPrec2 showsPrecX _ showsPrecY _ p =
     let appPrec = 10
         nextPrec = appPrec + 1
-     in \case
-          Neither -> showString "Neither"
-          Both x y ->
-            showParen (nextPrec <= prec) $
-              showString "Both "
-                . showsPrecX nextPrec x
-                . showString " "
-                . showsPrecY nextPrec y
+     in xnor
+          (showString "Neither")
+          ( \x y ->
+              showParen (nextPrec <= p) $
+                showString "Both "
+                  . showsPrecX nextPrec x
+                  . showString " "
+                  . showsPrecY nextPrec y
+          )
 
 instance Bifunctor XNor where
-  bimap f g = \case
-    Neither -> Neither
-    Both a b -> Both (f a) (g b)
+  bimap f g = xnor Neither (\a -> Both (f a) . g)
 
--- | Isomorphic to `(a, Maybe b)`, it’s also the pattern functor for non-empty
+-- | Isomorphic to @(a, `Maybe` b)@, it’s also the pattern functor for non-empty
 --   lists.
 data AndMaybe a b = Only ~a | Indeed ~a b
-  deriving stock (Eq, Generic, Show, Foldable, Functor, Generic1, Traversable)
+  deriving stock
+    ( Eq,
+      Generic,
+      -- | @since 0.5.3.0
+      Read,
+      Show,
+      Foldable,
+      Functor,
+      Generic1,
+      Traversable
+    )
 
+-- | Eliminator for `AndMaybe`, akin to `Data.Either.either` or
+--  `Data.Maybe.maybe`.
+--
+--   @since 0.5.3.0
+andMaybe :: (a -> c) -> (a -> b -> c) -> AndMaybe a b -> c
+andMaybe only indeed = \case
+  Only a -> only a
+  Indeed a b -> indeed a b
+
+#if MIN_VERSION_base(4, 18, 0)
+instance (Eq a) => Eq1 (AndMaybe a)
+#else
 instance (Eq a) => Eq1 (AndMaybe a) where
-  -- TODO: Remove this once base-4.18 is the oldest supported verson, as it’s
-  --       the default impl.
   liftEq = liftEq2 (==)
+#endif
 
 instance Eq2 AndMaybe where
   liftEq2 f g = Tuple.curry $ \case
@@ -156,10 +233,12 @@ instance Eq2 AndMaybe where
 instance (Ord a, Ord b) => Ord (AndMaybe a b) where
   compare = liftCompare compare
 
+#if MIN_VERSION_base(4, 18, 0)
+instance (Ord a) => Ord1 (AndMaybe a)
+#else
 instance (Ord a) => Ord1 (AndMaybe a) where
-  -- TODO: Remove this once base-4.18 is the oldest supported verson, as it’s
-  --       the default impl.
   liftCompare = liftCompare2 compare
+#endif
 
 instance Ord2 AndMaybe where
   liftCompare2 f g = Tuple.curry $ \case
@@ -168,30 +247,43 @@ instance Ord2 AndMaybe where
     (Indeed x _, Only x') -> f x x' <> GT
     (Indeed x y, Indeed x' y') -> f x x' <> g y y'
 
+-- | @since 0.5.3.0
+instance (Read a) => Read1 (AndMaybe a) where
+  liftReadPrec = liftReadPrec2 readPrec readListPrec
+
+-- | @since 0.5.3.0
+instance Read2 AndMaybe where
+  liftReadPrec2 readPrecX _ readPrecY _ =
+    let appPrec = 10
+     in parens . prec appPrec $
+          expectP (Lex.Ident "Only")
+            *> (Only <$> step readPrecX)
+            <|> expectP (Lex.Ident "Indeed")
+              *> (Indeed <$> step readPrecX <*> step readPrecY)
+
+#if MIN_VERSION_base(4, 18, 0)
+instance (Show a) => Show1 (AndMaybe a)
+#else
 instance (Show a) => Show1 (AndMaybe a) where
-  -- TODO: Remove this once base-4.18 is the oldest supported verson, as it’s
-  --       the default impl.
   liftShowsPrec = liftShowsPrec2 showsPrec showList
+#endif
 
 instance Show2 AndMaybe where
-  liftShowsPrec2 showsPrecX _showListX showsPrecY _showListY prec =
+  liftShowsPrec2 showsPrecX _ showsPrecY _ p =
     let appPrec = 10
         nextPrec = appPrec + 1
-     in \case
-          Only x ->
-            showParen (nextPrec <= prec) $
-              showString "Only " . showsPrecX nextPrec x
-          Indeed x y ->
-            showParen (nextPrec <= prec) $
-              showString "Indeed "
-                . showsPrecX nextPrec x
-                . showString " "
-                . showsPrecY nextPrec y
+     in showParen (nextPrec <= p)
+          . andMaybe
+            (\x -> showString "Only " . showsPrecX nextPrec x)
+            ( \x y ->
+                showString "Indeed "
+                  . showsPrecX nextPrec x
+                  . showString " "
+                  . showsPrecY nextPrec y
+            )
 
 instance Bifunctor AndMaybe where
-  bimap f g = \case
-    Only a -> Only (f a)
-    Indeed a b -> Indeed (f a) (g b)
+  bimap f g = andMaybe (Only . f) (\a -> Indeed (f a) . g)
 
 -- * orphan instances for types from the strict library
 
diff --git a/core/src/Yaya/Retrofit.hs b/core/src/Yaya/Retrofit.hs
index dff69b6..d2fb2c2 100644
--- a/core/src/Yaya/Retrofit.hs
+++ b/core/src/Yaya/Retrofit.hs
@@ -75,8 +75,14 @@ import safe "this" Yaya.Fold
     Projectable (project),
     Recursive (cata),
     Steppable (embed),
+    recursiveCompare,
+    recursiveCompare',
     recursiveEq,
+    recursiveEq',
     recursiveShowsPrec,
+    recursiveShowsPrec',
+    steppableReadPrec,
+    steppableReadPrec',
   )
 
 #if MIN_VERSION_template_haskell(2, 21, 0)
diff --git a/core/yaya.cabal b/core/yaya.cabal
index 23a6d52..57a641d 100644
--- a/core/yaya.cabal
+++ b/core/yaya.cabal
@@ -1,7 +1,7 @@
 cabal-version:  3.0
 
 name:        yaya
-version:     0.5.2.1
+version:     0.5.3.0
 synopsis:    Total recursion schemes.
 description: Recursion schemes allow you to separate recursion from your
              business logic – making your own operations simpler, more modular,
diff --git a/unsafe/src/Yaya/Unsafe/Fold/Instances.hs b/unsafe/src/Yaya/Unsafe/Fold/Instances.hs
index 41bbd9b..a40057a 100644
--- a/unsafe/src/Yaya/Unsafe/Fold/Instances.hs
+++ b/unsafe/src/Yaya/Unsafe/Fold/Instances.hs
@@ -30,8 +30,9 @@ import safe "base" Data.Eq (Eq ((==)))
 import safe "base" Data.Foldable (Foldable)
 import safe "base" Data.Function (flip)
 import safe "base" Data.Functor (Functor, (<$>))
-import safe "base" Data.Functor.Classes (Eq1, Show1)
+import safe "base" Data.Functor.Classes (Eq1, Ord1, Show1)
 import safe "base" Data.List.NonEmpty (NonEmpty)
+import safe "base" Data.Ord (Ord (compare))
 
 -- See comment on @{-# LANGUAGE Safe #-}@ above.
 #if MIN_VERSION_base(4, 17, 0)
@@ -51,6 +52,7 @@ import safe "yaya" Yaya.Fold
     Projectable (project),
     Recursive (cata),
     Steppable (embed),
+    recursiveCompare,
     recursiveEq,
     recursiveShowsPrec,
   )
@@ -68,6 +70,10 @@ instance (Functor f) => Recursive (->) (Cofix f) f where
 instance (Functor f, Foldable f, Eq1 f) => Eq (Cofix f) where
   (==) = recursiveEq
 
+-- | @since 0.3.4.0
+instance (Functor f, Foldable f, Ord1 f) => Ord (Cofix f) where
+  compare = recursiveCompare
+
 instance (Functor f, Show1 f) => Show (Cofix f) where
   showsPrec = recursiveShowsPrec
 
@@ -80,6 +86,10 @@ instance (Functor f) => Recursive (->) (Nu f) f where
 instance (Functor f, Foldable f, Eq1 f) => Eq (Nu f) where
   (==) = recursiveEq
 
+-- | @since 0.3.4.0
+instance (Functor f, Foldable f, Ord1 f) => Ord (Nu f) where
+  compare = recursiveCompare
+
 instance (Functor f, Show1 f) => Show (Nu f) where
   showsPrec = recursiveShowsPrec
 
diff --git a/unsafe/yaya-unsafe.cabal b/unsafe/yaya-unsafe.cabal
index dc875e7..94d8026 100644
--- a/unsafe/yaya-unsafe.cabal
+++ b/unsafe/yaya-unsafe.cabal
@@ -1,7 +1,7 @@
 cabal-version:  3.0
 
 name:        yaya-unsafe
-version:     0.3.3.0
+version:     0.3.4.0
 synopsis:    Non-total extensions to the Yaya recursion scheme library.
 description: Yaya is designed as a _total_ library. However, it is often
              expedient to use partial operations in some cases, and this package