{-# LANGUAGE Safe #-}
{-# OPTIONS_GHC -Wno-orphans #-}

-- | Common pattern functors (and instances for them).
--
--   This re-exports the functors from the strict library because it also adds
--   some orphan instances for them.
module Yaya.Pattern
  ( module Data.Strict.Either,
    module Data.Strict.Maybe,
    module Data.Strict.Tuple,
    AndMaybe (Indeed, Only),
    XNor (Both, Neither),
  )
where

import "base" Control.Applicative (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.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 "comonad" Control.Comonad (Comonad (duplicate, extract))
import "strict" Data.Strict.Either
  ( Either (Left, Right),
    either,
    fromLeft,
    fromRight,
    isLeft,
    isRight,
    lefts,
    partitionEithers,
    rights,
  )
import "strict" Data.Strict.Maybe
  ( Maybe (Just, Nothing),
    catMaybes,
    fromJust,
    fromMaybe,
    isJust,
    isNothing,
    listToMaybe,
    mapMaybe,
    maybe,
    maybeToList,
  )
import "strict" Data.Strict.Tuple
  ( Pair ((:!:)),
    curry,
    fst,
    snd,
    swap,
    uncurry,
    unzip,
    zip,
    (:!:),
  )
import "base" Prelude (Num ((+)))

-- | Isomorphic to 'Maybe (a, b)', it’s also the pattern functor for lists.
data XNor a b = Neither | Both ~a b
  deriving stock
    ( XNor a b -> XNor a b -> Bool
(XNor a b -> XNor a b -> Bool)
-> (XNor a b -> XNor a b -> Bool) -> Eq (XNor a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => XNor a b -> XNor a b -> Bool
$c== :: forall a b. (Eq a, Eq b) => XNor a b -> XNor a b -> Bool
== :: XNor a b -> XNor a b -> Bool
$c/= :: forall a b. (Eq a, Eq b) => XNor a b -> XNor a b -> Bool
/= :: XNor a b -> XNor a b -> Bool
Eq,
      (forall x. XNor a b -> Rep (XNor a b) x)
-> (forall x. Rep (XNor a b) x -> XNor a b) -> Generic (XNor a b)
forall x. Rep (XNor a b) x -> XNor a b
forall x. XNor a b -> Rep (XNor a b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a b x. Rep (XNor a b) x -> XNor a b
forall a b x. XNor a b -> Rep (XNor a b) x
$cfrom :: forall a b x. XNor a b -> Rep (XNor a b) x
from :: forall x. XNor a b -> Rep (XNor a b) x
$cto :: forall a b x. Rep (XNor a b) x -> XNor a b
to :: forall x. Rep (XNor a b) x -> XNor a b
Generic,
      Eq (XNor a b)
Eq (XNor a b) =>
(XNor a b -> XNor a b -> Ordering)
-> (XNor a b -> XNor a b -> Bool)
-> (XNor a b -> XNor a b -> Bool)
-> (XNor a b -> XNor a b -> Bool)
-> (XNor a b -> XNor a b -> Bool)
-> (XNor a b -> XNor a b -> XNor a b)
-> (XNor a b -> XNor a b -> XNor a b)
-> Ord (XNor a b)
XNor a b -> XNor a b -> Bool
XNor a b -> XNor a b -> Ordering
XNor a b -> XNor a b -> XNor a b
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a b. (Ord a, Ord b) => Eq (XNor a b)
forall a b. (Ord a, Ord b) => XNor a b -> XNor a b -> Bool
forall a b. (Ord a, Ord b) => XNor a b -> XNor a b -> Ordering
forall a b. (Ord a, Ord b) => XNor a b -> XNor a b -> XNor a b
$ccompare :: forall a b. (Ord a, Ord b) => XNor a b -> XNor a b -> Ordering
compare :: XNor a b -> XNor a b -> Ordering
$c< :: forall a b. (Ord a, Ord b) => XNor a b -> XNor a b -> Bool
< :: XNor a b -> XNor a b -> Bool
$c<= :: forall a b. (Ord a, Ord b) => XNor a b -> XNor a b -> Bool
<= :: XNor a b -> XNor a b -> Bool
$c> :: forall a b. (Ord a, Ord b) => XNor a b -> XNor a b -> Bool
> :: XNor a b -> XNor a b -> Bool
$c>= :: forall a b. (Ord a, Ord b) => XNor a b -> XNor a b -> Bool
>= :: XNor a b -> XNor a b -> Bool
$cmax :: forall a b. (Ord a, Ord b) => XNor a b -> XNor a b -> XNor a b
max :: XNor a b -> XNor a b -> XNor a b
$cmin :: forall a b. (Ord a, Ord b) => XNor a b -> XNor a b -> XNor a b
min :: XNor a b -> XNor a b -> XNor a b
Ord,
      Int -> XNor a b -> ShowS
[XNor a b] -> ShowS
XNor a b -> String
(Int -> XNor a b -> ShowS)
-> (XNor a b -> String) -> ([XNor a b] -> ShowS) -> Show (XNor a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. (Show a, Show b) => Int -> XNor a b -> ShowS
forall a b. (Show a, Show b) => [XNor a b] -> ShowS
forall a b. (Show a, Show b) => XNor a b -> String
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> XNor a b -> ShowS
showsPrec :: Int -> XNor a b -> ShowS
$cshow :: forall a b. (Show a, Show b) => XNor a b -> String
show :: XNor a b -> String
$cshowList :: forall a b. (Show a, Show b) => [XNor a b] -> ShowS
showList :: [XNor a b] -> ShowS
Show,
      (forall m. Monoid m => XNor a m -> m)
-> (forall m a. Monoid m => (a -> m) -> XNor a a -> m)
-> (forall m a. Monoid m => (a -> m) -> XNor a a -> m)
-> (forall a b. (a -> b -> b) -> b -> XNor a a -> b)
-> (forall a b. (a -> b -> b) -> b -> XNor a a -> b)
-> (forall b a. (b -> a -> b) -> b -> XNor a a -> b)
-> (forall b a. (b -> a -> b) -> b -> XNor a a -> b)
-> (forall a. (a -> a -> a) -> XNor a a -> a)
-> (forall a. (a -> a -> a) -> XNor a a -> a)
-> (forall a. XNor a a -> [a])
-> (forall a. XNor a a -> Bool)
-> (forall a. XNor a a -> Int)
-> (forall a. Eq a => a -> XNor a a -> Bool)
-> (forall a. Ord a => XNor a a -> a)
-> (forall a. Ord a => XNor a a -> a)
-> (forall a. Num a => XNor a a -> a)
-> (forall a. Num a => XNor a a -> a)
-> Foldable (XNor a)
forall a. Eq a => a -> XNor a a -> Bool
forall a. Num a => XNor a a -> a
forall a. Ord a => XNor a a -> a
forall m. Monoid m => XNor a m -> m
forall a. XNor a a -> Bool
forall a. XNor a a -> Int
forall a. XNor a a -> [a]
forall a. (a -> a -> a) -> XNor a a -> a
forall a a. Eq a => a -> XNor a a -> Bool
forall a a. Num a => XNor a a -> a
forall a a. Ord a => XNor a a -> a
forall m a. Monoid m => (a -> m) -> XNor a a -> m
forall a m. Monoid m => XNor a m -> m
forall a a. XNor a a -> Bool
forall a a. XNor a a -> Int
forall a a. XNor a a -> [a]
forall b a. (b -> a -> b) -> b -> XNor a a -> b
forall a b. (a -> b -> b) -> b -> XNor a a -> b
forall a a. (a -> a -> a) -> XNor a a -> a
forall a m a. Monoid m => (a -> m) -> XNor a a -> m
forall a b a. (b -> a -> b) -> b -> XNor a a -> b
forall a a b. (a -> b -> b) -> b -> XNor a a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall a m. Monoid m => XNor a m -> m
fold :: forall m. Monoid m => XNor a m -> m
$cfoldMap :: forall a m a. Monoid m => (a -> m) -> XNor a a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> XNor a a -> m
$cfoldMap' :: forall a m a. Monoid m => (a -> m) -> XNor a a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> XNor a a -> m
$cfoldr :: forall a a b. (a -> b -> b) -> b -> XNor a a -> b
foldr :: forall a b. (a -> b -> b) -> b -> XNor a a -> b
$cfoldr' :: forall a a b. (a -> b -> b) -> b -> XNor a a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> XNor a a -> b
$cfoldl :: forall a b a. (b -> a -> b) -> b -> XNor a a -> b
foldl :: forall b a. (b -> a -> b) -> b -> XNor a a -> b
$cfoldl' :: forall a b a. (b -> a -> b) -> b -> XNor a a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> XNor a a -> b
$cfoldr1 :: forall a a. (a -> a -> a) -> XNor a a -> a
foldr1 :: forall a. (a -> a -> a) -> XNor a a -> a
$cfoldl1 :: forall a a. (a -> a -> a) -> XNor a a -> a
foldl1 :: forall a. (a -> a -> a) -> XNor a a -> a
$ctoList :: forall a a. XNor a a -> [a]
toList :: forall a. XNor a a -> [a]
$cnull :: forall a a. XNor a a -> Bool
null :: forall a. XNor a a -> Bool
$clength :: forall a a. XNor a a -> Int
length :: forall a. XNor a a -> Int
$celem :: forall a a. Eq a => a -> XNor a a -> Bool
elem :: forall a. Eq a => a -> XNor a a -> Bool
$cmaximum :: forall a a. Ord a => XNor a a -> a
maximum :: forall a. Ord a => XNor a a -> a
$cminimum :: forall a a. Ord a => XNor a a -> a
minimum :: forall a. Ord a => XNor a a -> a
$csum :: forall a a. Num a => XNor a a -> a
sum :: forall a. Num a => XNor a a -> a
$cproduct :: forall a a. Num a => XNor a a -> a
product :: forall a. Num a => XNor a a -> a
Foldable,
      (forall a b. (a -> b) -> XNor a a -> XNor a b)
-> (forall a b. a -> XNor a b -> XNor a a) -> Functor (XNor a)
forall a b. a -> XNor a b -> XNor a a
forall a b. (a -> b) -> XNor a a -> XNor a b
forall a a b. a -> XNor a b -> XNor a a
forall a a b. (a -> b) -> XNor a a -> XNor a b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a a b. (a -> b) -> XNor a a -> XNor a b
fmap :: forall a b. (a -> b) -> XNor a a -> XNor a b
$c<$ :: forall a a b. a -> XNor a b -> XNor a a
<$ :: forall a b. a -> XNor a b -> XNor a a
Functor,
      (forall a. XNor a a -> Rep1 (XNor a) a)
-> (forall a. Rep1 (XNor a) a -> XNor a a) -> Generic1 (XNor a)
forall a. Rep1 (XNor a) a -> XNor a a
forall a. XNor a a -> Rep1 (XNor a) a
forall a a. Rep1 (XNor a) a -> XNor a a
forall a a. XNor a a -> Rep1 (XNor a) a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cfrom1 :: forall a a. XNor a a -> Rep1 (XNor a) a
from1 :: forall a. XNor a a -> Rep1 (XNor a) a
$cto1 :: forall a a. Rep1 (XNor a) a -> XNor a a
to1 :: forall a. Rep1 (XNor a) a -> XNor a a
Generic1,
      Functor (XNor a)
Foldable (XNor a)
(Functor (XNor a), Foldable (XNor a)) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> XNor a a -> f (XNor a b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    XNor a (f a) -> f (XNor a a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> XNor a a -> m (XNor a b))
-> (forall (m :: * -> *) a.
    Monad m =>
    XNor a (m a) -> m (XNor a a))
-> Traversable (XNor a)
forall a. Functor (XNor a)
forall a. Foldable (XNor a)
forall a (m :: * -> *) a. Monad m => XNor a (m a) -> m (XNor a a)
forall a (f :: * -> *) a.
Applicative f =>
XNor a (f a) -> f (XNor a a)
forall a (m :: * -> *) a b.
Monad m =>
(a -> m b) -> XNor a a -> m (XNor a b)
forall a (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> XNor a a -> f (XNor a b)
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => XNor a (m a) -> m (XNor a a)
forall (f :: * -> *) a.
Applicative f =>
XNor a (f a) -> f (XNor a a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> XNor a a -> m (XNor a b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> XNor a a -> f (XNor a b)
$ctraverse :: forall a (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> XNor a a -> f (XNor a b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> XNor a a -> f (XNor a b)
$csequenceA :: forall a (f :: * -> *) a.
Applicative f =>
XNor a (f a) -> f (XNor a a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
XNor a (f a) -> f (XNor a a)
$cmapM :: forall a (m :: * -> *) a b.
Monad m =>
(a -> m b) -> XNor a a -> m (XNor a b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> XNor a a -> m (XNor a b)
$csequence :: forall a (m :: * -> *) a. Monad m => XNor a (m a) -> m (XNor a a)
sequence :: forall (m :: * -> *) a. Monad m => XNor a (m a) -> m (XNor a a)
Traversable
    )

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 :: forall a b. (a -> b -> Bool) -> XNor a a -> XNor a b -> Bool
liftEq = (a -> a -> Bool)
-> (a -> b -> Bool) -> XNor a a -> XNor a b -> Bool
forall a b c d.
(a -> b -> Bool)
-> (c -> d -> Bool) -> XNor a c -> XNor b d -> Bool
forall (f :: * -> * -> *) a b c d.
Eq2 f =>
(a -> b -> Bool) -> (c -> d -> Bool) -> f a c -> f b d -> Bool
liftEq2 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==)

instance Eq2 XNor where
  liftEq2 :: forall a b c d.
(a -> b -> Bool)
-> (c -> d -> Bool) -> XNor a c -> XNor b d -> Bool
liftEq2 a -> b -> Bool
f c -> d -> Bool
g = ((XNor a c, XNor b d) -> Bool) -> XNor a c -> XNor b d -> Bool
forall a b c. ((a, b) -> c) -> a -> b -> c
Tuple.curry (((XNor a c, XNor b d) -> Bool) -> XNor a c -> XNor b d -> Bool)
-> ((XNor a c, XNor b d) -> Bool) -> XNor a c -> XNor b d -> Bool
forall a b. (a -> b) -> a -> b
$ \case
    (XNor a c
Neither, XNor b d
Neither) -> Bool
True
    (Both a
x c
y, Both b
x' d
y') -> a -> b -> Bool
f a
x b
x' Bool -> Bool -> Bool
&& c -> d -> Bool
g c
y d
y'
    (XNor a c
_, XNor b d
_) -> Bool
False

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 :: forall a b.
(a -> b -> Ordering) -> XNor a a -> XNor a b -> Ordering
liftCompare = (a -> a -> Ordering)
-> (a -> b -> Ordering) -> XNor a a -> XNor a b -> Ordering
forall a b c d.
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> XNor a c -> XNor b d -> Ordering
forall (f :: * -> * -> *) a b c d.
Ord2 f =>
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> f a c -> f b d -> Ordering
liftCompare2 a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare

instance Ord2 XNor where
  liftCompare2 :: forall a b c d.
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> XNor a c -> XNor b d -> Ordering
liftCompare2 a -> b -> Ordering
f c -> d -> Ordering
g = ((XNor a c, XNor b d) -> Ordering)
-> XNor a c -> XNor b d -> Ordering
forall a b c. ((a, b) -> c) -> a -> b -> c
Tuple.curry (((XNor a c, XNor b d) -> Ordering)
 -> XNor a c -> XNor b d -> Ordering)
-> ((XNor a c, XNor b d) -> Ordering)
-> XNor a c
-> XNor b d
-> Ordering
forall a b. (a -> b) -> a -> b
$ \case
    (XNor a c
Neither, XNor b d
Neither) -> Ordering
EQ
    (XNor a c
Neither, Both b
_ d
_) -> Ordering
LT
    (Both a
_ c
_, XNor b d
Neither) -> Ordering
GT
    (Both a
x c
y, Both b
x' d
y') -> a -> b -> Ordering
f a
x b
x' Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> c -> d -> Ordering
g c
y d
y'

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 :: forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> XNor a a -> ShowS
liftShowsPrec = (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> Int
-> XNor a a
-> ShowS
forall a b.
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> XNor a b
-> ShowS
forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> f a b
-> ShowS
liftShowsPrec2 Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec [a] -> ShowS
forall a. Show a => [a] -> ShowS
showList

instance Show2 XNor where
  liftShowsPrec2 :: forall a b.
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> XNor a b
-> ShowS
liftShowsPrec2 Int -> a -> ShowS
showsPrecX [a] -> ShowS
_showListX Int -> b -> ShowS
showsPrecY [b] -> ShowS
_showListY Int
prec =
    let appPrec :: a
appPrec = a
10
        nextPrec :: a
nextPrec = a
forall {a}. Num a => a
appPrec a -> a -> a
forall a. Num a => a -> a -> a
+ a
1
     in \case
          XNor a b
Neither -> String -> ShowS
showString String
"Neither"
          Both a
x b
y ->
            Bool -> ShowS -> ShowS
showParen (Int
forall {a}. Num a => a
nextPrec Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
prec) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
              String -> ShowS
showString String
"Both "
                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> a -> ShowS
showsPrecX Int
forall {a}. Num a => a
nextPrec a
x
                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> ShowS
showString String
" "
                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> b -> ShowS
showsPrecY Int
forall {a}. Num a => a
nextPrec b
y

instance Bifunctor XNor where
  bimap :: forall a b c d. (a -> b) -> (c -> d) -> XNor a c -> XNor b d
bimap a -> b
f c -> d
g = \case
    XNor a c
Neither -> XNor b d
forall a b. XNor a b
Neither
    Both a
a c
b -> b -> d -> XNor b d
forall a b. a -> b -> XNor a b
Both (a -> b
f a
a) (c -> d
g c
b)

-- | 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 (AndMaybe a b -> AndMaybe a b -> Bool
(AndMaybe a b -> AndMaybe a b -> Bool)
-> (AndMaybe a b -> AndMaybe a b -> Bool) -> Eq (AndMaybe a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => AndMaybe a b -> AndMaybe a b -> Bool
$c== :: forall a b. (Eq a, Eq b) => AndMaybe a b -> AndMaybe a b -> Bool
== :: AndMaybe a b -> AndMaybe a b -> Bool
$c/= :: forall a b. (Eq a, Eq b) => AndMaybe a b -> AndMaybe a b -> Bool
/= :: AndMaybe a b -> AndMaybe a b -> Bool
Eq, (forall x. AndMaybe a b -> Rep (AndMaybe a b) x)
-> (forall x. Rep (AndMaybe a b) x -> AndMaybe a b)
-> Generic (AndMaybe a b)
forall x. Rep (AndMaybe a b) x -> AndMaybe a b
forall x. AndMaybe a b -> Rep (AndMaybe a b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a b x. Rep (AndMaybe a b) x -> AndMaybe a b
forall a b x. AndMaybe a b -> Rep (AndMaybe a b) x
$cfrom :: forall a b x. AndMaybe a b -> Rep (AndMaybe a b) x
from :: forall x. AndMaybe a b -> Rep (AndMaybe a b) x
$cto :: forall a b x. Rep (AndMaybe a b) x -> AndMaybe a b
to :: forall x. Rep (AndMaybe a b) x -> AndMaybe a b
Generic, Int -> AndMaybe a b -> ShowS
[AndMaybe a b] -> ShowS
AndMaybe a b -> String
(Int -> AndMaybe a b -> ShowS)
-> (AndMaybe a b -> String)
-> ([AndMaybe a b] -> ShowS)
-> Show (AndMaybe a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. (Show a, Show b) => Int -> AndMaybe a b -> ShowS
forall a b. (Show a, Show b) => [AndMaybe a b] -> ShowS
forall a b. (Show a, Show b) => AndMaybe a b -> String
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> AndMaybe a b -> ShowS
showsPrec :: Int -> AndMaybe a b -> ShowS
$cshow :: forall a b. (Show a, Show b) => AndMaybe a b -> String
show :: AndMaybe a b -> String
$cshowList :: forall a b. (Show a, Show b) => [AndMaybe a b] -> ShowS
showList :: [AndMaybe a b] -> ShowS
Show, (forall m. Monoid m => AndMaybe a m -> m)
-> (forall m a. Monoid m => (a -> m) -> AndMaybe a a -> m)
-> (forall m a. Monoid m => (a -> m) -> AndMaybe a a -> m)
-> (forall a b. (a -> b -> b) -> b -> AndMaybe a a -> b)
-> (forall a b. (a -> b -> b) -> b -> AndMaybe a a -> b)
-> (forall b a. (b -> a -> b) -> b -> AndMaybe a a -> b)
-> (forall b a. (b -> a -> b) -> b -> AndMaybe a a -> b)
-> (forall a. (a -> a -> a) -> AndMaybe a a -> a)
-> (forall a. (a -> a -> a) -> AndMaybe a a -> a)
-> (forall a. AndMaybe a a -> [a])
-> (forall a. AndMaybe a a -> Bool)
-> (forall a. AndMaybe a a -> Int)
-> (forall a. Eq a => a -> AndMaybe a a -> Bool)
-> (forall a. Ord a => AndMaybe a a -> a)
-> (forall a. Ord a => AndMaybe a a -> a)
-> (forall a. Num a => AndMaybe a a -> a)
-> (forall a. Num a => AndMaybe a a -> a)
-> Foldable (AndMaybe a)
forall a. Eq a => a -> AndMaybe a a -> Bool
forall a. Num a => AndMaybe a a -> a
forall a. Ord a => AndMaybe a a -> a
forall m. Monoid m => AndMaybe a m -> m
forall a. AndMaybe a a -> Bool
forall a. AndMaybe a a -> Int
forall a. AndMaybe a a -> [a]
forall a. (a -> a -> a) -> AndMaybe a a -> a
forall a a. Eq a => a -> AndMaybe a a -> Bool
forall a a. Num a => AndMaybe a a -> a
forall a a. Ord a => AndMaybe a a -> a
forall m a. Monoid m => (a -> m) -> AndMaybe a a -> m
forall a m. Monoid m => AndMaybe a m -> m
forall a a. AndMaybe a a -> Bool
forall a a. AndMaybe a a -> Int
forall a a. AndMaybe a a -> [a]
forall b a. (b -> a -> b) -> b -> AndMaybe a a -> b
forall a b. (a -> b -> b) -> b -> AndMaybe a a -> b
forall a a. (a -> a -> a) -> AndMaybe a a -> a
forall a m a. Monoid m => (a -> m) -> AndMaybe a a -> m
forall a b a. (b -> a -> b) -> b -> AndMaybe a a -> b
forall a a b. (a -> b -> b) -> b -> AndMaybe a a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall a m. Monoid m => AndMaybe a m -> m
fold :: forall m. Monoid m => AndMaybe a m -> m
$cfoldMap :: forall a m a. Monoid m => (a -> m) -> AndMaybe a a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> AndMaybe a a -> m
$cfoldMap' :: forall a m a. Monoid m => (a -> m) -> AndMaybe a a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> AndMaybe a a -> m
$cfoldr :: forall a a b. (a -> b -> b) -> b -> AndMaybe a a -> b
foldr :: forall a b. (a -> b -> b) -> b -> AndMaybe a a -> b
$cfoldr' :: forall a a b. (a -> b -> b) -> b -> AndMaybe a a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> AndMaybe a a -> b
$cfoldl :: forall a b a. (b -> a -> b) -> b -> AndMaybe a a -> b
foldl :: forall b a. (b -> a -> b) -> b -> AndMaybe a a -> b
$cfoldl' :: forall a b a. (b -> a -> b) -> b -> AndMaybe a a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> AndMaybe a a -> b
$cfoldr1 :: forall a a. (a -> a -> a) -> AndMaybe a a -> a
foldr1 :: forall a. (a -> a -> a) -> AndMaybe a a -> a
$cfoldl1 :: forall a a. (a -> a -> a) -> AndMaybe a a -> a
foldl1 :: forall a. (a -> a -> a) -> AndMaybe a a -> a
$ctoList :: forall a a. AndMaybe a a -> [a]
toList :: forall a. AndMaybe a a -> [a]
$cnull :: forall a a. AndMaybe a a -> Bool
null :: forall a. AndMaybe a a -> Bool
$clength :: forall a a. AndMaybe a a -> Int
length :: forall a. AndMaybe a a -> Int
$celem :: forall a a. Eq a => a -> AndMaybe a a -> Bool
elem :: forall a. Eq a => a -> AndMaybe a a -> Bool
$cmaximum :: forall a a. Ord a => AndMaybe a a -> a
maximum :: forall a. Ord a => AndMaybe a a -> a
$cminimum :: forall a a. Ord a => AndMaybe a a -> a
minimum :: forall a. Ord a => AndMaybe a a -> a
$csum :: forall a a. Num a => AndMaybe a a -> a
sum :: forall a. Num a => AndMaybe a a -> a
$cproduct :: forall a a. Num a => AndMaybe a a -> a
product :: forall a. Num a => AndMaybe a a -> a
Foldable, (forall a b. (a -> b) -> AndMaybe a a -> AndMaybe a b)
-> (forall a b. a -> AndMaybe a b -> AndMaybe a a)
-> Functor (AndMaybe a)
forall a b. a -> AndMaybe a b -> AndMaybe a a
forall a b. (a -> b) -> AndMaybe a a -> AndMaybe a b
forall a a b. a -> AndMaybe a b -> AndMaybe a a
forall a a b. (a -> b) -> AndMaybe a a -> AndMaybe a b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a a b. (a -> b) -> AndMaybe a a -> AndMaybe a b
fmap :: forall a b. (a -> b) -> AndMaybe a a -> AndMaybe a b
$c<$ :: forall a a b. a -> AndMaybe a b -> AndMaybe a a
<$ :: forall a b. a -> AndMaybe a b -> AndMaybe a a
Functor, (forall a. AndMaybe a a -> Rep1 (AndMaybe a) a)
-> (forall a. Rep1 (AndMaybe a) a -> AndMaybe a a)
-> Generic1 (AndMaybe a)
forall a. Rep1 (AndMaybe a) a -> AndMaybe a a
forall a. AndMaybe a a -> Rep1 (AndMaybe a) a
forall a a. Rep1 (AndMaybe a) a -> AndMaybe a a
forall a a. AndMaybe a a -> Rep1 (AndMaybe a) a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cfrom1 :: forall a a. AndMaybe a a -> Rep1 (AndMaybe a) a
from1 :: forall a. AndMaybe a a -> Rep1 (AndMaybe a) a
$cto1 :: forall a a. Rep1 (AndMaybe a) a -> AndMaybe a a
to1 :: forall a. Rep1 (AndMaybe a) a -> AndMaybe a a
Generic1, Functor (AndMaybe a)
Foldable (AndMaybe a)
(Functor (AndMaybe a), Foldable (AndMaybe a)) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> AndMaybe a a -> f (AndMaybe a b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    AndMaybe a (f a) -> f (AndMaybe a a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> AndMaybe a a -> m (AndMaybe a b))
-> (forall (m :: * -> *) a.
    Monad m =>
    AndMaybe a (m a) -> m (AndMaybe a a))
-> Traversable (AndMaybe a)
forall a. Functor (AndMaybe a)
forall a. Foldable (AndMaybe a)
forall a (m :: * -> *) a.
Monad m =>
AndMaybe a (m a) -> m (AndMaybe a a)
forall a (f :: * -> *) a.
Applicative f =>
AndMaybe a (f a) -> f (AndMaybe a a)
forall a (m :: * -> *) a b.
Monad m =>
(a -> m b) -> AndMaybe a a -> m (AndMaybe a b)
forall a (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> AndMaybe a a -> f (AndMaybe a b)
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
AndMaybe a (m a) -> m (AndMaybe a a)
forall (f :: * -> *) a.
Applicative f =>
AndMaybe a (f a) -> f (AndMaybe a a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> AndMaybe a a -> m (AndMaybe a b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> AndMaybe a a -> f (AndMaybe a b)
$ctraverse :: forall a (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> AndMaybe a a -> f (AndMaybe a b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> AndMaybe a a -> f (AndMaybe a b)
$csequenceA :: forall a (f :: * -> *) a.
Applicative f =>
AndMaybe a (f a) -> f (AndMaybe a a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
AndMaybe a (f a) -> f (AndMaybe a a)
$cmapM :: forall a (m :: * -> *) a b.
Monad m =>
(a -> m b) -> AndMaybe a a -> m (AndMaybe a b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> AndMaybe a a -> m (AndMaybe a b)
$csequence :: forall a (m :: * -> *) a.
Monad m =>
AndMaybe a (m a) -> m (AndMaybe a a)
sequence :: forall (m :: * -> *) a.
Monad m =>
AndMaybe a (m a) -> m (AndMaybe a a)
Traversable)

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 :: forall a b.
(a -> b -> Bool) -> AndMaybe a a -> AndMaybe a b -> Bool
liftEq = (a -> a -> Bool)
-> (a -> b -> Bool) -> AndMaybe a a -> AndMaybe a b -> Bool
forall a b c d.
(a -> b -> Bool)
-> (c -> d -> Bool) -> AndMaybe a c -> AndMaybe b d -> Bool
forall (f :: * -> * -> *) a b c d.
Eq2 f =>
(a -> b -> Bool) -> (c -> d -> Bool) -> f a c -> f b d -> Bool
liftEq2 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==)

instance Eq2 AndMaybe where
  liftEq2 :: forall a b c d.
(a -> b -> Bool)
-> (c -> d -> Bool) -> AndMaybe a c -> AndMaybe b d -> Bool
liftEq2 a -> b -> Bool
f c -> d -> Bool
g = ((AndMaybe a c, AndMaybe b d) -> Bool)
-> AndMaybe a c -> AndMaybe b d -> Bool
forall a b c. ((a, b) -> c) -> a -> b -> c
Tuple.curry (((AndMaybe a c, AndMaybe b d) -> Bool)
 -> AndMaybe a c -> AndMaybe b d -> Bool)
-> ((AndMaybe a c, AndMaybe b d) -> Bool)
-> AndMaybe a c
-> AndMaybe b d
-> Bool
forall a b. (a -> b) -> a -> b
$ \case
    (Only a
x, Only b
x') -> a -> b -> Bool
f a
x b
x'
    (Indeed a
x c
y, Indeed b
x' d
y') -> a -> b -> Bool
f a
x b
x' Bool -> Bool -> Bool
&& c -> d -> Bool
g c
y d
y'
    (AndMaybe a c
_, AndMaybe b d
_) -> Bool
False

-- | This definition is different from the one that is derivable. For example,
--   the derived instance would always have
--   @`compare` (`Only` x) (`Indeed` x' y) `==` `LT`@, but this instance will
--   return `GT` if @`compare` x x' `==` `GT`@.
instance (Ord a, Ord b) => Ord (AndMaybe a b) where
  compare :: AndMaybe a b -> AndMaybe a b -> Ordering
compare = (b -> b -> Ordering) -> AndMaybe a b -> AndMaybe a b -> Ordering
forall a b.
(a -> b -> Ordering) -> AndMaybe a a -> AndMaybe a b -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare b -> b -> Ordering
forall a. Ord a => a -> a -> Ordering
compare

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 :: forall a b.
(a -> b -> Ordering) -> AndMaybe a a -> AndMaybe a b -> Ordering
liftCompare = (a -> a -> Ordering)
-> (a -> b -> Ordering) -> AndMaybe a a -> AndMaybe a b -> Ordering
forall a b c d.
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> AndMaybe a c -> AndMaybe b d -> Ordering
forall (f :: * -> * -> *) a b c d.
Ord2 f =>
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> f a c -> f b d -> Ordering
liftCompare2 a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare

instance Ord2 AndMaybe where
  liftCompare2 :: forall a b c d.
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> AndMaybe a c -> AndMaybe b d -> Ordering
liftCompare2 a -> b -> Ordering
f c -> d -> Ordering
g = ((AndMaybe a c, AndMaybe b d) -> Ordering)
-> AndMaybe a c -> AndMaybe b d -> Ordering
forall a b c. ((a, b) -> c) -> a -> b -> c
Tuple.curry (((AndMaybe a c, AndMaybe b d) -> Ordering)
 -> AndMaybe a c -> AndMaybe b d -> Ordering)
-> ((AndMaybe a c, AndMaybe b d) -> Ordering)
-> AndMaybe a c
-> AndMaybe b d
-> Ordering
forall a b. (a -> b) -> a -> b
$ \case
    (Only a
x, Only b
x') -> a -> b -> Ordering
f a
x b
x'
    (Only a
x, Indeed b
x' d
_) -> a -> b -> Ordering
f a
x b
x' Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> Ordering
LT
    (Indeed a
x c
_, Only b
x') -> a -> b -> Ordering
f a
x b
x' Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> Ordering
GT
    (Indeed a
x c
y, Indeed b
x' d
y') -> a -> b -> Ordering
f a
x b
x' Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> c -> d -> Ordering
g c
y d
y'

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 :: forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> AndMaybe a a -> ShowS
liftShowsPrec = (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> Int
-> AndMaybe a a
-> ShowS
forall a b.
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> AndMaybe a b
-> ShowS
forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> f a b
-> ShowS
liftShowsPrec2 Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec [a] -> ShowS
forall a. Show a => [a] -> ShowS
showList

instance Show2 AndMaybe where
  liftShowsPrec2 :: forall a b.
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> AndMaybe a b
-> ShowS
liftShowsPrec2 Int -> a -> ShowS
showsPrecX [a] -> ShowS
_showListX Int -> b -> ShowS
showsPrecY [b] -> ShowS
_showListY Int
prec =
    let appPrec :: a
appPrec = a
10
        nextPrec :: a
nextPrec = a
forall {a}. Num a => a
appPrec a -> a -> a
forall a. Num a => a -> a -> a
+ a
1
     in \case
          Only a
x ->
            Bool -> ShowS -> ShowS
showParen (Int
forall {a}. Num a => a
nextPrec Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
prec) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
              String -> ShowS
showString String
"Only " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> a -> ShowS
showsPrecX Int
forall {a}. Num a => a
nextPrec a
x
          Indeed a
x b
y ->
            Bool -> ShowS -> ShowS
showParen (Int
forall {a}. Num a => a
nextPrec Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
prec) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
              String -> ShowS
showString String
"Indeed "
                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> a -> ShowS
showsPrecX Int
forall {a}. Num a => a
nextPrec a
x
                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> ShowS
showString String
" "
                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> b -> ShowS
showsPrecY Int
forall {a}. Num a => a
nextPrec b
y

instance Bifunctor AndMaybe where
  bimap :: forall a b c d.
(a -> b) -> (c -> d) -> AndMaybe a c -> AndMaybe b d
bimap a -> b
f c -> d
g = \case
    Only a
a -> b -> AndMaybe b d
forall a b. a -> AndMaybe a b
Only (a -> b
f a
a)
    Indeed a
a c
b -> b -> d -> AndMaybe b d
forall a b. a -> b -> AndMaybe a b
Indeed (a -> b
f a
a) (c -> d
g c
b)

-- * orphan instances for types from the strict library

-- TODO: Explain why these instances are actually legit (fast & loose).

instance Applicative (Either a) where
  pure :: forall a. a -> Either a a
pure = a -> Either a a
forall a a. a -> Either a a
Right
  liftA2 :: forall a b c.
(a -> b -> c) -> Either a a -> Either a b -> Either a c
liftA2 a -> b -> c
f = (Pair (Either a a) (Either a b) -> Either a c)
-> Either a a -> Either a b -> Either a c
forall a b c. (Pair a b -> c) -> a -> b -> c
curry ((Pair (Either a a) (Either a b) -> Either a c)
 -> Either a a -> Either a b -> Either a c)
-> (Pair (Either a a) (Either a b) -> Either a c)
-> Either a a
-> Either a b
-> Either a c
forall a b. (a -> b) -> a -> b
$ \case
    Right a
x :!: Right b
y -> c -> Either a c
forall a a. a -> Either a a
Right (c -> Either a c) -> c -> Either a c
forall a b. (a -> b) -> a -> b
$ a -> b -> c
f a
x b
y
    Right a
_ :!: Left a
a -> a -> Either a c
forall a b. a -> Either a b
Left a
a
    Left a
a :!: Either a b
_ -> a -> Either a c
forall a b. a -> Either a b
Left a
a

instance Monad (Either a) where
  Left a
a >>= :: forall a b. Either a a -> (a -> Either a b) -> Either a b
>>= a -> Either a b
_ = a -> Either a b
forall a b. a -> Either a b
Left a
a
  Right a
b >>= a -> Either a b
f = a -> Either a b
f a
b

instance Applicative Maybe where
  pure :: forall a. a -> Maybe a
pure = a -> Maybe a
forall a. a -> Maybe a
Just
  liftA2 :: forall a b c. (a -> b -> c) -> Maybe a -> Maybe b -> Maybe c
liftA2 a -> b -> c
f = (Pair (Maybe a) (Maybe b) -> Maybe c)
-> Maybe a -> Maybe b -> Maybe c
forall a b c. (Pair a b -> c) -> a -> b -> c
curry ((Pair (Maybe a) (Maybe b) -> Maybe c)
 -> Maybe a -> Maybe b -> Maybe c)
-> (Pair (Maybe a) (Maybe b) -> Maybe c)
-> Maybe a
-> Maybe b
-> Maybe c
forall a b. (a -> b) -> a -> b
$ \case
    Just a
x :!: Just b
y -> c -> Maybe c
forall a. a -> Maybe a
Just (c -> Maybe c) -> c -> Maybe c
forall a b. (a -> b) -> a -> b
$ a -> b -> c
f a
x b
y
    Maybe a
_ :!: Maybe b
_ -> Maybe c
forall a. Maybe a
Nothing

instance Monad Maybe where
  Maybe a
Nothing >>= :: forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
>>= a -> Maybe b
_ = Maybe b
forall a. Maybe a
Nothing
  Just a
a >>= a -> Maybe b
f = a -> Maybe b
f a
a

instance Comonad (Pair a) where
  extract :: forall a. Pair a a -> a
extract = Pair a a -> a
forall a a. Pair a a -> a
snd
  duplicate :: forall a. Pair a a -> Pair a (Pair a a)
duplicate x :: Pair a a
x@(a
a :!: a
_) = a
a a -> Pair a a -> Pair a (Pair a a)
forall a b. a -> b -> Pair a b
:!: Pair a a
x