yaya 0.6.0.0 → 0.6.1.0

raw patch · 7 files changed

+398/−86 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• src/Yaya/Fold.hs +180/−17
• src/Yaya/Fold/Common.hs +44/−14
• src/Yaya/Fold/Native.hs +14/−1
• src/Yaya/Fold/Native/Internal.hs +8/−0
• src/Yaya/Pattern.hs +145/−53
• src/Yaya/Retrofit.hs +6/−0
• yaya.cabal +1/−1

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE Safe #-} @@ -49,35 +50,59 @@     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 +126,13 @@     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 +147,9 @@   ) 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,21 +196,136 @@ 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.6.1.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 (==) --- | An implementation of `Show` for any `Recursive` instance.+-- | Like `recursiveCompare`, but allows you to provide a custom comparator for+--   @f@.+--+--   @since 0.6.1.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.6.1.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"++-- | Like `recursiveShowsPrec`, but allows you to provide a custom display+--   function for @f@.+--+--   @since 0.6.1.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.+#if MIN_VERSION_GLASGOW_HASKELL(8, 8, 0, 0) \+    && !MIN_VERSION_GLASGOW_HASKELL(8, 10, 0, 0)+--+--  __FIXME__: There should be doctests here, but `doctest` crashes with these+--             tests in the very specific case of GHC 8.8.4 from Nixpkgs 23.11.+--             So, either figure out how to get them working there, or wait+--             until we no longer support that combination.+#else+--+-- >>> :{+--   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)))))"+#endif+--+--  __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.6.1.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.6.1.0+steppableReadPrec :: (Steppable (->) t f, Read1 f) => ReadPrec t+steppableReadPrec = steppableReadPrec' liftReadPrec+ -- | A fixed-point operator for inductive / finite data structures. -- --  *NB*: This is only guaranteed to be finite when @f a@ is strict in @a@@@ -196,12 +345,21 @@ 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.6.1.0+instance (Functor f, Foldable f, Ord1 f) => Ord (Mu f) where+  compare = recursiveCompare++-- | @since 0.6.1.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@@ -217,6 +375,11 @@  instance DFunctor Nu where   dmap f (Nu φ a) = Nu (f . φ) a++-- | @since 0.6.1.0+instance (Functor f, Read1 f) => Read (Nu f) where+  readPrec = steppableReadPrec+  readListPrec = readListPrecDefault  instance Projectable (->) [a] (XNor a) where   project [] = Neither

@@ -4,8 +4,10 @@ module Yaya.Fold.Common   ( binarySequence,     definedOrInput,+    compareDay,     diagonal,     equal,+    equalDay,     fromEither,     height,     le,@@ -16,6 +18,7 @@     maybeTakeNext,     never,     replaceNeither,+    showsPrecF,     size,     takeAnother,     takeAvailable,@@ -24,6 +27,7 @@     toRight,     truncate',     unarySequence,+    xnor,   ) where @@ -32,40 +36,41 @@ 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,10 +79,35 @@   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.6.1.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.6.1.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.6.1.0+showsPrecF :: (Show1 f) => Int -> f (Int -> ShowS) -> ShowS+showsPrecF = liftShowsPrec (&) (showList__ ($ 0))  -- TODO: Redefine this using `Natural` 

@@ -17,9 +17,11 @@ 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 @@     Projectable (project),     Recursive (cata),     Steppable (embed),+    recursiveCompare,     recursiveEq,     recursiveShowsPrec,+    steppableReadPrec,   ) import "this" Yaya.Fold.Common (diagonal) import "this" Yaya.Fold.Native.Internal (Cofix (unCofix))@@ -59,6 +63,15 @@  instance (Functor f, Foldable f, Eq1 f) => Eq (Fix f) where   (==) = recursiveEq++-- | @since 0.6.1.0+instance (Functor f, Foldable f, Ord1 f) => Ord (Fix f) where+  compare = recursiveCompare++-- | @since 0.6.1.0+instance (Read1 f) => Read (Fix f) where+  readPrec = steppableReadPrec+  readListPrec = readListPrecDefault  instance (Functor f, Show1 f) => Show (Fix f) where   showsPrec = recursiveShowsPrec

@@ -14,10 +14,13 @@  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 (Functor f) => Corecursive (->) (Cofix f) f where   ana φ = embed . fmap (ana φ) . φ++-- | @since 0.6.1.0+instance (Read1 f) => Read (Cofix f) where+  readPrec = steppableReadPrec+  readListPrec = readListPrecDefault

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-} {-# OPTIONS_GHC -Wno-orphans #-} @@ -11,32 +12,31 @@     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 "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.6.1.0+      Read,       Show,       Foldable,       Functor,@@ -87,10 +116,20 @@       Traversable     ) +-- | Eliminator for `XNor`, akin to `Data.Either.either` or `Data.Maybe.maybe`.+--+--   @since 0.6.1.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 @@     (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 @@     (Both _ _, Neither) -> GT     (Both x y, Both x' y') -> f x x' <> g y y' +-- | @since 0.6.1.0+instance (Read a) => Read1 (XNor a) where+  liftReadPrec = liftReadPrec2 readPrec readListPrec++-- | @since 0.6.1.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.6.1.0+      Read,+      Show,+      Foldable,+      Functor,+      Generic1,+      Traversable+    ) +-- | Eliminator for `AndMaybe`, akin to `Data.Either.either` or+--  `Data.Maybe.maybe`.+--+--   @since 0.6.1.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 (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 @@     (Indeed x _, Only x') -> f x x' <> GT     (Indeed x y, Indeed x' y') -> f x x' <> g y y' +-- | @since 0.6.1.0+instance (Read a) => Read1 (AndMaybe a) where+  liftReadPrec = liftReadPrec2 readPrec readListPrec++-- | @since 0.6.1.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 

@@ -75,8 +75,14 @@     Projectable (project),     Recursive (cata),     Steppable (embed),+    recursiveCompare,+    recursiveCompare',     recursiveEq,+    recursiveEq',     recursiveShowsPrec,+    recursiveShowsPrec',+    steppableReadPrec,+    steppableReadPrec',   )  #if MIN_VERSION_template_haskell(2, 21, 0)

@@ -1,7 +1,7 @@ cabal-version:  3.0  name:        yaya-version:     0.6.0.0+version:     0.6.1.0 synopsis:    Total recursion schemes. description: Recursion schemes allow you to separate recursion from your              business logic – making your own operations simpler, more modular,