{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor  #-}

-- | This module is a simplified version of
-- <https://hackage.haskell.org/package/smash/docs/Data-Wedge.html#t:Wedge>,
-- which is copyrighted by Emily Pillmore and originally pulished using
-- BSD-3-Clause license.
--
-- copyright: Emily Pillmore 2020-2021, iohk 2021
--
module Data.Wedge where

import Control.Monad (ap)

import Data.Bifoldable
import Data.Bifunctor
import Data.Bitraversable

-- | A wedge product
-- <https://hackage.haskell.org/package/smash/docs/Data-Wedge.html#t:Wedge>
--
data Wedge a b =
    Nowhere
  | Here a
  | There b
  deriving (Wedge a b -> Wedge a b -> Bool
(Wedge a b -> Wedge a b -> Bool)
-> (Wedge a b -> Wedge a b -> Bool) -> Eq (Wedge a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => Wedge a b -> Wedge a b -> Bool
$c== :: forall a b. (Eq a, Eq b) => Wedge a b -> Wedge a b -> Bool
== :: Wedge a b -> Wedge a b -> Bool
$c/= :: forall a b. (Eq a, Eq b) => Wedge a b -> Wedge a b -> Bool
/= :: Wedge a b -> Wedge a b -> Bool
Eq, Eq (Wedge a b)
Eq (Wedge a b) =>
(Wedge a b -> Wedge a b -> Ordering)
-> (Wedge a b -> Wedge a b -> Bool)
-> (Wedge a b -> Wedge a b -> Bool)
-> (Wedge a b -> Wedge a b -> Bool)
-> (Wedge a b -> Wedge a b -> Bool)
-> (Wedge a b -> Wedge a b -> Wedge a b)
-> (Wedge a b -> Wedge a b -> Wedge a b)
-> Ord (Wedge a b)
Wedge a b -> Wedge a b -> Bool
Wedge a b -> Wedge a b -> Ordering
Wedge a b -> Wedge a b -> Wedge 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 (Wedge a b)
forall a b. (Ord a, Ord b) => Wedge a b -> Wedge a b -> Bool
forall a b. (Ord a, Ord b) => Wedge a b -> Wedge a b -> Ordering
forall a b. (Ord a, Ord b) => Wedge a b -> Wedge a b -> Wedge a b
$ccompare :: forall a b. (Ord a, Ord b) => Wedge a b -> Wedge a b -> Ordering
compare :: Wedge a b -> Wedge a b -> Ordering
$c< :: forall a b. (Ord a, Ord b) => Wedge a b -> Wedge a b -> Bool
< :: Wedge a b -> Wedge a b -> Bool
$c<= :: forall a b. (Ord a, Ord b) => Wedge a b -> Wedge a b -> Bool
<= :: Wedge a b -> Wedge a b -> Bool
$c> :: forall a b. (Ord a, Ord b) => Wedge a b -> Wedge a b -> Bool
> :: Wedge a b -> Wedge a b -> Bool
$c>= :: forall a b. (Ord a, Ord b) => Wedge a b -> Wedge a b -> Bool
>= :: Wedge a b -> Wedge a b -> Bool
$cmax :: forall a b. (Ord a, Ord b) => Wedge a b -> Wedge a b -> Wedge a b
max :: Wedge a b -> Wedge a b -> Wedge a b
$cmin :: forall a b. (Ord a, Ord b) => Wedge a b -> Wedge a b -> Wedge a b
min :: Wedge a b -> Wedge a b -> Wedge a b
Ord, (forall m. Monoid m => Wedge a m -> m)
-> (forall m a. Monoid m => (a -> m) -> Wedge a a -> m)
-> (forall m a. Monoid m => (a -> m) -> Wedge a a -> m)
-> (forall a b. (a -> b -> b) -> b -> Wedge a a -> b)
-> (forall a b. (a -> b -> b) -> b -> Wedge a a -> b)
-> (forall b a. (b -> a -> b) -> b -> Wedge a a -> b)
-> (forall b a. (b -> a -> b) -> b -> Wedge a a -> b)
-> (forall a. (a -> a -> a) -> Wedge a a -> a)
-> (forall a. (a -> a -> a) -> Wedge a a -> a)
-> (forall a. Wedge a a -> [a])
-> (forall a. Wedge a a -> Bool)
-> (forall a. Wedge a a -> Int)
-> (forall a. Eq a => a -> Wedge a a -> Bool)
-> (forall a. Ord a => Wedge a a -> a)
-> (forall a. Ord a => Wedge a a -> a)
-> (forall a. Num a => Wedge a a -> a)
-> (forall a. Num a => Wedge a a -> a)
-> Foldable (Wedge a)
forall a. Eq a => a -> Wedge a a -> Bool
forall a. Num a => Wedge a a -> a
forall a. Ord a => Wedge a a -> a
forall m. Monoid m => Wedge a m -> m
forall a. Wedge a a -> Bool
forall a. Wedge a a -> Int
forall a. Wedge a a -> [a]
forall a. (a -> a -> a) -> Wedge a a -> a
forall a a. Eq a => a -> Wedge a a -> Bool
forall a a. Num a => Wedge a a -> a
forall a a. Ord a => Wedge a a -> a
forall a m. Monoid m => Wedge a m -> m
forall m a. Monoid m => (a -> m) -> Wedge a a -> m
forall a a. Wedge a a -> Bool
forall a a. Wedge a a -> Int
forall a a. Wedge a a -> [a]
forall b a. (b -> a -> b) -> b -> Wedge a a -> b
forall a b. (a -> b -> b) -> b -> Wedge a a -> b
forall a a. (a -> a -> a) -> Wedge a a -> a
forall a m a. Monoid m => (a -> m) -> Wedge a a -> m
forall a b a. (b -> a -> b) -> b -> Wedge a a -> b
forall a a b. (a -> b -> b) -> b -> Wedge 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 => Wedge a m -> m
fold :: forall m. Monoid m => Wedge a m -> m
$cfoldMap :: forall a m a. Monoid m => (a -> m) -> Wedge a a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Wedge a a -> m
$cfoldMap' :: forall a m a. Monoid m => (a -> m) -> Wedge a a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Wedge a a -> m
$cfoldr :: forall a a b. (a -> b -> b) -> b -> Wedge a a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Wedge a a -> b
$cfoldr' :: forall a a b. (a -> b -> b) -> b -> Wedge a a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Wedge a a -> b
$cfoldl :: forall a b a. (b -> a -> b) -> b -> Wedge a a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Wedge a a -> b
$cfoldl' :: forall a b a. (b -> a -> b) -> b -> Wedge a a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Wedge a a -> b
$cfoldr1 :: forall a a. (a -> a -> a) -> Wedge a a -> a
foldr1 :: forall a. (a -> a -> a) -> Wedge a a -> a
$cfoldl1 :: forall a a. (a -> a -> a) -> Wedge a a -> a
foldl1 :: forall a. (a -> a -> a) -> Wedge a a -> a
$ctoList :: forall a a. Wedge a a -> [a]
toList :: forall a. Wedge a a -> [a]
$cnull :: forall a a. Wedge a a -> Bool
null :: forall a. Wedge a a -> Bool
$clength :: forall a a. Wedge a a -> Int
length :: forall a. Wedge a a -> Int
$celem :: forall a a. Eq a => a -> Wedge a a -> Bool
elem :: forall a. Eq a => a -> Wedge a a -> Bool
$cmaximum :: forall a a. Ord a => Wedge a a -> a
maximum :: forall a. Ord a => Wedge a a -> a
$cminimum :: forall a a. Ord a => Wedge a a -> a
minimum :: forall a. Ord a => Wedge a a -> a
$csum :: forall a a. Num a => Wedge a a -> a
sum :: forall a. Num a => Wedge a a -> a
$cproduct :: forall a a. Num a => Wedge a a -> a
product :: forall a. Num a => Wedge a a -> a
Foldable, (forall a b. (a -> b) -> Wedge a a -> Wedge a b)
-> (forall a b. a -> Wedge a b -> Wedge a a) -> Functor (Wedge a)
forall a b. a -> Wedge a b -> Wedge a a
forall a b. (a -> b) -> Wedge a a -> Wedge a b
forall a a b. a -> Wedge a b -> Wedge a a
forall a a b. (a -> b) -> Wedge a a -> Wedge 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) -> Wedge a a -> Wedge a b
fmap :: forall a b. (a -> b) -> Wedge a a -> Wedge a b
$c<$ :: forall a a b. a -> Wedge a b -> Wedge a a
<$ :: forall a b. a -> Wedge a b -> Wedge a a
Functor, Int -> Wedge a b -> ShowS
[Wedge a b] -> ShowS
Wedge a b -> String
(Int -> Wedge a b -> ShowS)
-> (Wedge a b -> String)
-> ([Wedge a b] -> ShowS)
-> Show (Wedge a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. (Show a, Show b) => Int -> Wedge a b -> ShowS
forall a b. (Show a, Show b) => [Wedge a b] -> ShowS
forall a b. (Show a, Show b) => Wedge a b -> String
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> Wedge a b -> ShowS
showsPrec :: Int -> Wedge a b -> ShowS
$cshow :: forall a b. (Show a, Show b) => Wedge a b -> String
show :: Wedge a b -> String
$cshowList :: forall a b. (Show a, Show b) => [Wedge a b] -> ShowS
showList :: [Wedge a b] -> ShowS
Show)

instance Bifunctor Wedge where
    bimap :: forall a b c d. (a -> b) -> (c -> d) -> Wedge a c -> Wedge b d
bimap a -> b
_ c -> d
_ Wedge a c
Nowhere   = Wedge b d
forall a b. Wedge a b
Nowhere
    bimap a -> b
f c -> d
_ (Here a
a)  = b -> Wedge b d
forall a b. a -> Wedge a b
Here  (a -> b
f a
a)
    bimap a -> b
_ c -> d
g (There c
b) = d -> Wedge b d
forall a b. b -> Wedge a b
There (c -> d
g c
b)

instance Bifoldable Wedge where
    bifoldMap :: forall m a b. Monoid m => (a -> m) -> (b -> m) -> Wedge a b -> m
bifoldMap a -> m
_ b -> m
_ Wedge a b
Nowhere   = m
forall a. Monoid a => a
mempty
    bifoldMap a -> m
f b -> m
_ (Here a
a)  = a -> m
f a
a
    bifoldMap a -> m
_ b -> m
g (There b
b) = b -> m
g b
b

instance Bitraversable Wedge where
    bitraverse :: forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Wedge a b -> f (Wedge c d)
bitraverse a -> f c
_ b -> f d
_ Wedge a b
Nowhere   = Wedge c d -> f (Wedge c d)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Wedge c d
forall a b. Wedge a b
Nowhere
    bitraverse a -> f c
f b -> f d
_ (Here a
a)  = c -> Wedge c d
forall a b. a -> Wedge a b
Here (c -> Wedge c d) -> f c -> f (Wedge c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f c
f a
a
    bitraverse a -> f c
_ b -> f d
g (There b
b) = d -> Wedge c d
forall a b. b -> Wedge a b
There (d -> Wedge c d) -> f d -> f (Wedge c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> f d
g b
b

instance Applicative (Wedge a) where
    pure :: forall a. a -> Wedge a a
pure  = a -> Wedge a a
forall a b. b -> Wedge a b
There
    <*> :: forall a b. Wedge a (a -> b) -> Wedge a a -> Wedge a b
(<*>) = Wedge a (a -> b) -> Wedge a a -> Wedge a b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad (Wedge a) where
    Wedge a a
Nowhere >>= :: forall a b. Wedge a a -> (a -> Wedge a b) -> Wedge a b
>>= a -> Wedge a b
_ = Wedge a b
forall a b. Wedge a b
Nowhere
    Here a
a  >>= a -> Wedge a b
_ = a -> Wedge a b
forall a b. a -> Wedge a b
Here a
a
    There a
a >>= a -> Wedge a b
f = a -> Wedge a b
f a
a