{-# LANGUAGE StrictData #-}

-- | Common pattern functors (and instances for them).
module Yaya.Pattern where

import Data.Bifunctor

-- | Isomorphic to 'Maybe (a, b)', it’s also the pattern functor for lists.
data XNor a b = Neither | Both ~a b deriving (a -> XNor a b -> XNor a a
(a -> b) -> XNor a a -> XNor a b
(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
<$ :: a -> XNor a b -> XNor a a
$c<$ :: forall a a b. a -> XNor a b -> XNor a a
fmap :: (a -> b) -> XNor a a -> XNor a b
$cfmap :: forall a a b. (a -> b) -> XNor a a -> XNor a b
Functor, XNor a a -> Bool
(a -> m) -> XNor a a -> m
(a -> b -> b) -> b -> XNor a a -> b
(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
product :: XNor a a -> a
$cproduct :: forall a a. Num a => XNor a a -> a
sum :: XNor a a -> a
$csum :: forall a a. Num a => XNor a a -> a
minimum :: XNor a a -> a
$cminimum :: forall a a. Ord a => XNor a a -> a
maximum :: XNor a a -> a
$cmaximum :: forall a a. Ord a => XNor a a -> a
elem :: a -> XNor a a -> Bool
$celem :: forall a a. Eq a => a -> XNor a a -> Bool
length :: XNor a a -> Int
$clength :: forall a a. XNor a a -> Int
null :: XNor a a -> Bool
$cnull :: forall a a. XNor a a -> Bool
toList :: XNor a a -> [a]
$ctoList :: forall a a. XNor a a -> [a]
foldl1 :: (a -> a -> a) -> XNor a a -> a
$cfoldl1 :: forall a a. (a -> a -> a) -> XNor a a -> a
foldr1 :: (a -> a -> a) -> XNor a a -> a
$cfoldr1 :: forall a a. (a -> a -> a) -> XNor a a -> a
foldl' :: (b -> a -> b) -> b -> XNor a a -> b
$cfoldl' :: forall a b a. (b -> a -> b) -> b -> XNor a a -> b
foldl :: (b -> a -> b) -> b -> XNor a a -> b
$cfoldl :: forall a b a. (b -> a -> b) -> b -> XNor a a -> b
foldr' :: (a -> b -> b) -> b -> XNor a a -> b
$cfoldr' :: forall a a b. (a -> b -> b) -> b -> XNor a a -> b
foldr :: (a -> b -> b) -> b -> XNor a a -> b
$cfoldr :: forall a a b. (a -> b -> b) -> b -> XNor a a -> b
foldMap' :: (a -> m) -> XNor a a -> m
$cfoldMap' :: forall a m a. Monoid m => (a -> m) -> XNor a a -> m
foldMap :: (a -> m) -> XNor a a -> m
$cfoldMap :: forall a m a. Monoid m => (a -> m) -> XNor a a -> m
fold :: XNor a m -> m
$cfold :: forall a m. Monoid m => XNor a m -> m
Foldable, 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)
(a -> f b) -> XNor a a -> f (XNor a b)
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)
sequence :: XNor a (m a) -> m (XNor a a)
$csequence :: forall a (m :: * -> *) a. Monad m => XNor a (m a) -> m (XNor a a)
mapM :: (a -> m b) -> XNor a a -> m (XNor a b)
$cmapM :: forall a (m :: * -> *) a b.
Monad m =>
(a -> m b) -> XNor a a -> m (XNor a b)
sequenceA :: XNor a (f a) -> f (XNor a a)
$csequenceA :: forall a (f :: * -> *) a.
Applicative f =>
XNor a (f a) -> f (XNor a a)
traverse :: (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)
$cp2Traversable :: forall a. Foldable (XNor a)
$cp1Traversable :: forall a. Functor (XNor a)
Traversable)

instance Bifunctor XNor where
  bimap :: (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 (a -> AndMaybe a b -> AndMaybe a a
(a -> b) -> AndMaybe a a -> AndMaybe a b
(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
<$ :: a -> AndMaybe a b -> AndMaybe a a
$c<$ :: forall a a b. a -> AndMaybe a b -> AndMaybe a a
fmap :: (a -> b) -> AndMaybe a a -> AndMaybe a b
$cfmap :: forall a a b. (a -> b) -> AndMaybe a a -> AndMaybe a b
Functor, AndMaybe a a -> Bool
(a -> m) -> AndMaybe a a -> m
(a -> b -> b) -> b -> AndMaybe a a -> b
(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
product :: AndMaybe a a -> a
$cproduct :: forall a a. Num a => AndMaybe a a -> a
sum :: AndMaybe a a -> a
$csum :: forall a a. Num a => AndMaybe a a -> a
minimum :: AndMaybe a a -> a
$cminimum :: forall a a. Ord a => AndMaybe a a -> a
maximum :: AndMaybe a a -> a
$cmaximum :: forall a a. Ord a => AndMaybe a a -> a
elem :: a -> AndMaybe a a -> Bool
$celem :: forall a a. Eq a => a -> AndMaybe a a -> Bool
length :: AndMaybe a a -> Int
$clength :: forall a a. AndMaybe a a -> Int
null :: AndMaybe a a -> Bool
$cnull :: forall a a. AndMaybe a a -> Bool
toList :: AndMaybe a a -> [a]
$ctoList :: forall a a. AndMaybe a a -> [a]
foldl1 :: (a -> a -> a) -> AndMaybe a a -> a
$cfoldl1 :: forall a a. (a -> a -> a) -> AndMaybe a a -> a
foldr1 :: (a -> a -> a) -> AndMaybe a a -> a
$cfoldr1 :: forall a a. (a -> a -> a) -> AndMaybe a a -> a
foldl' :: (b -> a -> b) -> b -> AndMaybe a a -> b
$cfoldl' :: forall a b a. (b -> a -> b) -> b -> AndMaybe a a -> b
foldl :: (b -> a -> b) -> b -> AndMaybe a a -> b
$cfoldl :: forall a b a. (b -> a -> b) -> b -> AndMaybe a a -> b
foldr' :: (a -> b -> b) -> b -> AndMaybe a a -> b
$cfoldr' :: forall a a b. (a -> b -> b) -> b -> AndMaybe a a -> b
foldr :: (a -> b -> b) -> b -> AndMaybe a a -> b
$cfoldr :: forall a a b. (a -> b -> b) -> b -> AndMaybe a a -> b
foldMap' :: (a -> m) -> AndMaybe a a -> m
$cfoldMap' :: forall a m a. Monoid m => (a -> m) -> AndMaybe a a -> m
foldMap :: (a -> m) -> AndMaybe a a -> m
$cfoldMap :: forall a m a. Monoid m => (a -> m) -> AndMaybe a a -> m
fold :: AndMaybe a m -> m
$cfold :: forall a m. Monoid m => AndMaybe a m -> m
Foldable, 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)
(a -> f b) -> AndMaybe a a -> f (AndMaybe a b)
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)
sequence :: AndMaybe a (m a) -> m (AndMaybe a a)
$csequence :: forall a (m :: * -> *) a.
Monad m =>
AndMaybe a (m a) -> m (AndMaybe a a)
mapM :: (a -> m b) -> AndMaybe a a -> m (AndMaybe a b)
$cmapM :: forall a (m :: * -> *) a b.
Monad m =>
(a -> m b) -> AndMaybe a a -> m (AndMaybe a b)
sequenceA :: AndMaybe a (f a) -> f (AndMaybe a a)
$csequenceA :: forall a (f :: * -> *) a.
Applicative f =>
AndMaybe a (f a) -> f (AndMaybe a a)
traverse :: (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)
$cp2Traversable :: forall a. Foldable (AndMaybe a)
$cp1Traversable :: forall a. Functor (AndMaybe a)
Traversable)

instance Bifunctor AndMaybe where
  bimap :: (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)