{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE Safe #-}
-- |
-- Module       : Data.Wedge
-- Copyright    : (c) 2020-2021 Emily Pillmore
-- License      : BSD-3-Clause
--
-- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>
-- Stability    : Experimental
-- Portability  : CPP, RankNTypes, TypeApplications
--
-- This module contains the definition for the 'Wedge' datatype. In
-- practice, this type is isomorphic to @'Maybe' ('Either' a b)@ - the type with
-- two possibly non-exclusive values and an empty case.
--
module Data.Wedge
( -- * Datatypes
  -- $general
  Wedge(..)
  -- ** Type synonyms
, type (∨)
  -- * Combinators
, quotWedge
, wedgeLeft
, wedgeRight
, fromWedge
, toWedge
, isHere
, isThere
, isNowhere
  -- ** Eliminators
, wedge
  -- ** Filtering
, heres
, theres
, filterHeres
, filterTheres
, filterNowheres
  -- ** Folding and Unfolding
, foldHeres
, foldTheres
, gatherWedges
, unfoldr
, unfoldrM
, iterateUntil
, iterateUntilM
, accumUntil
, accumUntilM
  -- ** Partitioning
, partitionWedges
, mapWedges
  -- ** Distributivity
, distributeWedge
, codistributeWedge
  -- ** Associativity
, reassocLR
, reassocRL
  -- ** Symmetry
, swapWedge
) where


import Control.Applicative (Alternative(..))
import Control.DeepSeq
import Control.Monad.Zip

import Data.Bifunctor
import Data.Bifoldable
import Data.Binary (Binary(..))
import Data.Bitraversable
import Data.Data
import Data.Functor.Classes
import Data.Functor.Identity
import Data.Hashable

import GHC.Generics
import GHC.Read

import qualified Language.Haskell.TH.Syntax as TH

import Text.Read hiding (get)

import Data.Smash.Internal
import Control.Monad
import Data.Hashable.Lifted


{- $general

Categorically, the 'Wedge' datatype represents the coproduct (like, 'Either')
in the category Hask* of pointed Hask types, called a <https://ncatlab.org/nlab/show/wedge+sum wedge sum>.
The category Hask* consists of Hask types affixed with
a dedicated base point along with an object. In Hask, this is
equivalent to @1 + a@, also known as @'Maybe' a@. Because we can conflate
basepoints of different types (there is only one @Nothing@ type), the wedge sum
can be viewed as the type @1 + a + b@, or @'Maybe' ('Either' a b)@ in Hask.

Pictorially, one can visualize this as:


@
'Wedge':
                  a
                  |
'Nowhere' +-------+
                  |
                  b
@


The fact that we can think about 'Wedge' as a coproduct gives us
some reasoning power about how a 'Wedge' will interact with the
product in Hask*, called 'Can'. Namely, we know that a product of a type and a
coproduct, @a * (b + c)@, is equivalent to @(a * b) + (a * c)@. Additionally,
we may derive other facts about its associativity, distributivity, commutativity, and
many more. As an exercise, think of something 'Either' can do. Now do it with 'Wedge'!

-}

-- | The 'Wedge' data type represents values with two exclusive
-- possibilities, and an empty case. This is a coproduct of pointed
-- types - i.e. of 'Maybe' values. The result is a type, 'Wedge a b',
-- which is isomorphic to @'Maybe' ('Either' a b)@.
--
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
/= :: 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
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
min :: 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
max :: Wedge a b -> Wedge a b -> Wedge a b
$cmax :: forall a b. (Ord a, Ord b) => Wedge a b -> Wedge a b -> Wedge a b
>= :: 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
$c< :: forall a b. (Ord a, Ord b) => Wedge a b -> Wedge a b -> Bool
compare :: Wedge a b -> Wedge a b -> Ordering
$ccompare :: forall a b. (Ord a, Ord b) => Wedge a b -> Wedge a b -> Ordering
$cp1Ord :: forall a b. (Ord a, Ord b) => Eq (Wedge a b)
Ord, ReadPrec [Wedge a b]
ReadPrec (Wedge a b)
Int -> ReadS (Wedge a b)
ReadS [Wedge a b]
(Int -> ReadS (Wedge a b))
-> ReadS [Wedge a b]
-> ReadPrec (Wedge a b)
-> ReadPrec [Wedge a b]
-> Read (Wedge a b)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall a b. (Read a, Read b) => ReadPrec [Wedge a b]
forall a b. (Read a, Read b) => ReadPrec (Wedge a b)
forall a b. (Read a, Read b) => Int -> ReadS (Wedge a b)
forall a b. (Read a, Read b) => ReadS [Wedge a b]
readListPrec :: ReadPrec [Wedge a b]
$creadListPrec :: forall a b. (Read a, Read b) => ReadPrec [Wedge a b]
readPrec :: ReadPrec (Wedge a b)
$creadPrec :: forall a b. (Read a, Read b) => ReadPrec (Wedge a b)
readList :: ReadS [Wedge a b]
$creadList :: forall a b. (Read a, Read b) => ReadS [Wedge a b]
readsPrec :: Int -> ReadS (Wedge a b)
$creadsPrec :: forall a b. (Read a, Read b) => Int -> ReadS (Wedge a b)
Read, 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
showList :: [Wedge a b] -> ShowS
$cshowList :: forall a b. (Show a, Show b) => [Wedge a b] -> ShowS
show :: Wedge a b -> String
$cshow :: forall a b. (Show a, Show b) => Wedge a b -> String
showsPrec :: Int -> Wedge a b -> ShowS
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> Wedge a b -> ShowS
Show
    , (forall x. Wedge a b -> Rep (Wedge a b) x)
-> (forall x. Rep (Wedge a b) x -> Wedge a b)
-> Generic (Wedge a b)
forall x. Rep (Wedge a b) x -> Wedge a b
forall x. Wedge a b -> Rep (Wedge a b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a b x. Rep (Wedge a b) x -> Wedge a b
forall a b x. Wedge a b -> Rep (Wedge a b) x
$cto :: forall a b x. Rep (Wedge a b) x -> Wedge a b
$cfrom :: forall a b x. Wedge a b -> Rep (Wedge a b) x
Generic, (forall a. Wedge a a -> Rep1 (Wedge a) a)
-> (forall a. Rep1 (Wedge a) a -> Wedge a a) -> Generic1 (Wedge a)
forall a. Rep1 (Wedge a) a -> Wedge a a
forall a. Wedge a a -> Rep1 (Wedge a) a
forall a a. Rep1 (Wedge a) a -> Wedge a a
forall a a. Wedge a a -> Rep1 (Wedge a) a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cto1 :: forall a a. Rep1 (Wedge a) a -> Wedge a a
$cfrom1 :: forall a a. Wedge a a -> Rep1 (Wedge a) a
Generic1
    , Typeable, Typeable (Wedge a b)
DataType
Constr
Typeable (Wedge a b) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Wedge a b -> c (Wedge a b))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Wedge a b))
-> (Wedge a b -> Constr)
-> (Wedge a b -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Wedge a b)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (Wedge a b)))
-> ((forall b. Data b => b -> b) -> Wedge a b -> Wedge a b)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Wedge a b -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Wedge a b -> r)
-> (forall u. (forall d. Data d => d -> u) -> Wedge a b -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Wedge a b -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Wedge a b -> m (Wedge a b))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Wedge a b -> m (Wedge a b))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Wedge a b -> m (Wedge a b))
-> Data (Wedge a b)
Wedge a b -> DataType
Wedge a b -> Constr
(forall b. Data b => b -> b) -> Wedge a b -> Wedge a b
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Wedge a b -> c (Wedge a b)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Wedge a b)
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Wedge a b))
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Wedge a b -> u
forall u. (forall d. Data d => d -> u) -> Wedge a b -> [u]
forall a b. (Data a, Data b) => Typeable (Wedge a b)
forall a b. (Data a, Data b) => Wedge a b -> DataType
forall a b. (Data a, Data b) => Wedge a b -> Constr
forall a b.
(Data a, Data b) =>
(forall b. Data b => b -> b) -> Wedge a b -> Wedge a b
forall a b u.
(Data a, Data b) =>
Int -> (forall d. Data d => d -> u) -> Wedge a b -> u
forall a b u.
(Data a, Data b) =>
(forall d. Data d => d -> u) -> Wedge a b -> [u]
forall a b r r'.
(Data a, Data b) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Wedge a b -> r
forall a b r r'.
(Data a, Data b) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Wedge a b -> r
forall a b (m :: * -> *).
(Data a, Data b, Monad m) =>
(forall d. Data d => d -> m d) -> Wedge a b -> m (Wedge a b)
forall a b (m :: * -> *).
(Data a, Data b, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Wedge a b -> m (Wedge a b)
forall a b (c :: * -> *).
(Data a, Data b) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Wedge a b)
forall a b (c :: * -> *).
(Data a, Data b) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Wedge a b -> c (Wedge a b)
forall a b (t :: * -> *) (c :: * -> *).
(Data a, Data b, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Wedge a b))
forall a b (t :: * -> * -> *) (c :: * -> *).
(Data a, Data b, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Wedge a b))
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Wedge a b -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Wedge a b -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Wedge a b -> m (Wedge a b)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Wedge a b -> m (Wedge a b)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Wedge a b)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Wedge a b -> c (Wedge a b)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Wedge a b))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Wedge a b))
$cThere :: Constr
$cHere :: Constr
$cNowhere :: Constr
$tWedge :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Wedge a b -> m (Wedge a b)
$cgmapMo :: forall a b (m :: * -> *).
(Data a, Data b, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Wedge a b -> m (Wedge a b)
gmapMp :: (forall d. Data d => d -> m d) -> Wedge a b -> m (Wedge a b)
$cgmapMp :: forall a b (m :: * -> *).
(Data a, Data b, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Wedge a b -> m (Wedge a b)
gmapM :: (forall d. Data d => d -> m d) -> Wedge a b -> m (Wedge a b)
$cgmapM :: forall a b (m :: * -> *).
(Data a, Data b, Monad m) =>
(forall d. Data d => d -> m d) -> Wedge a b -> m (Wedge a b)
gmapQi :: Int -> (forall d. Data d => d -> u) -> Wedge a b -> u
$cgmapQi :: forall a b u.
(Data a, Data b) =>
Int -> (forall d. Data d => d -> u) -> Wedge a b -> u
gmapQ :: (forall d. Data d => d -> u) -> Wedge a b -> [u]
$cgmapQ :: forall a b u.
(Data a, Data b) =>
(forall d. Data d => d -> u) -> Wedge a b -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Wedge a b -> r
$cgmapQr :: forall a b r r'.
(Data a, Data b) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Wedge a b -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Wedge a b -> r
$cgmapQl :: forall a b r r'.
(Data a, Data b) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Wedge a b -> r
gmapT :: (forall b. Data b => b -> b) -> Wedge a b -> Wedge a b
$cgmapT :: forall a b.
(Data a, Data b) =>
(forall b. Data b => b -> b) -> Wedge a b -> Wedge a b
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Wedge a b))
$cdataCast2 :: forall a b (t :: * -> * -> *) (c :: * -> *).
(Data a, Data b, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Wedge a b))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (Wedge a b))
$cdataCast1 :: forall a b (t :: * -> *) (c :: * -> *).
(Data a, Data b, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Wedge a b))
dataTypeOf :: Wedge a b -> DataType
$cdataTypeOf :: forall a b. (Data a, Data b) => Wedge a b -> DataType
toConstr :: Wedge a b -> Constr
$ctoConstr :: forall a b. (Data a, Data b) => Wedge a b -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Wedge a b)
$cgunfold :: forall a b (c :: * -> *).
(Data a, Data b) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Wedge a b)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Wedge a b -> c (Wedge a b)
$cgfoldl :: forall a b (c :: * -> *).
(Data a, Data b) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Wedge a b -> c (Wedge a b)
$cp1Data :: forall a b. (Data a, Data b) => Typeable (Wedge a b)
Data
    , Wedge a b -> Q Exp
(Wedge a b -> Q Exp) -> Lift (Wedge a b)
forall t. (t -> Q Exp) -> Lift t
forall a b. (Lift a, Lift b) => Wedge a b -> Q Exp
lift :: Wedge a b -> Q Exp
$clift :: forall a b. (Lift a, Lift b) => Wedge a b -> Q Exp
TH.Lift
    )

-- | A type operator synonym for 'Wedge'.
--
type a ∨ b = Wedge a b

-- -------------------------------------------------------------------- --
-- Eliminators

-- | Case elimination for the 'Wedge' datatype.
--
wedge
    :: c
    -> (a -> c)
    -> (b -> c)
    -> Wedge a b
    -> c
wedge :: c -> (a -> c) -> (b -> c) -> Wedge a b -> c
wedge c :: c
c _ _ Nowhere = c
c
wedge _ f :: a -> c
f _ (Here a :: a
a) = a -> c
f a
a
wedge _ _ g :: b -> c
g (There b :: b
b) = b -> c
g b
b

-- -------------------------------------------------------------------- --
-- Combinators

-- | Given two possible pointed types, produce a 'Wedge' by
-- considering the left case, the right case, and mapping their
-- 'Nothing' cases to 'Nowhere'. This is a pushout of pointed
-- types @A <- * -> B@.
--
quotWedge :: Either (Maybe a) (Maybe b) -> Wedge a b
quotWedge :: Either (Maybe a) (Maybe b) -> Wedge a b
quotWedge = (Maybe a -> Wedge a b)
-> (Maybe b -> Wedge a b)
-> Either (Maybe a) (Maybe b)
-> Wedge a b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Wedge a b -> (a -> Wedge a b) -> Maybe a -> Wedge a b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Wedge a b
forall a b. Wedge a b
Nowhere a -> Wedge a b
forall a b. a -> Wedge a b
Here) (Wedge a b -> (b -> Wedge a b) -> Maybe b -> Wedge a b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Wedge a b
forall a b. Wedge a b
Nowhere b -> Wedge a b
forall a b. b -> Wedge a b
There)

-- | Convert a 'Wedge a b' into a @'Maybe' ('Either' a b)@ value.
--
fromWedge :: Wedge a b -> Maybe (Either a b)
fromWedge :: Wedge a b -> Maybe (Either a b)
fromWedge = Maybe (Either a b)
-> (a -> Maybe (Either a b))
-> (b -> Maybe (Either a b))
-> Wedge a b
-> Maybe (Either a b)
forall c a b. c -> (a -> c) -> (b -> c) -> Wedge a b -> c
wedge Maybe (Either a b)
forall a. Maybe a
Nothing (Either a b -> Maybe (Either a b)
forall a. a -> Maybe a
Just (Either a b -> Maybe (Either a b))
-> (a -> Either a b) -> a -> Maybe (Either a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either a b
forall a b. a -> Either a b
Left) (Either a b -> Maybe (Either a b)
forall a. a -> Maybe a
Just (Either a b -> Maybe (Either a b))
-> (b -> Either a b) -> b -> Maybe (Either a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either a b
forall a b. b -> Either a b
Right)

-- | Convert a @'Maybe' ('Either' a b)@ value into a 'Wedge'
--
toWedge :: Maybe (Either a b) -> Wedge a b
toWedge :: Maybe (Either a b) -> Wedge a b
toWedge = Wedge a b
-> (Either a b -> Wedge a b) -> Maybe (Either a b) -> Wedge a b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Wedge a b
forall a b. Wedge a b
Nowhere ((a -> Wedge a b) -> (b -> Wedge a b) -> Either a b -> Wedge a b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> Wedge a b
forall a b. a -> Wedge a b
Here b -> Wedge a b
forall a b. b -> Wedge a b
There)

-- | Inject a 'Maybe' value into the 'Here' case of a 'Wedge',
-- or 'Nowhere' if the empty case is given. This is analogous to the
-- 'Left' constructor for 'Either'.
--
wedgeLeft :: Maybe a -> Wedge a b
wedgeLeft :: Maybe a -> Wedge a b
wedgeLeft Nothing = Wedge a b
forall a b. Wedge a b
Nowhere
wedgeLeft (Just a :: a
a) = a -> Wedge a b
forall a b. a -> Wedge a b
Here a
a

-- | Inject a 'Maybe' value into the 'There' case of a 'Wedge',
-- or 'Nowhere' if the empty case is given. This is analogous to the
-- 'Right' constructor for 'Either'.
--
wedgeRight :: Maybe b -> Wedge a b
wedgeRight :: Maybe b -> Wedge a b
wedgeRight Nothing = Wedge a b
forall a b. Wedge a b
Nowhere
wedgeRight (Just b :: b
b) = b -> Wedge a b
forall a b. b -> Wedge a b
There b
b

-- | Detect if a 'Wedge' is a 'Here' case.
--
isHere :: Wedge a b -> Bool
isHere :: Wedge a b -> Bool
isHere = \case
  Here _ -> Bool
True
  _ -> Bool
False

-- | Detect if a 'Wedge' is a 'There' case.
--
isThere :: Wedge a b -> Bool
isThere :: Wedge a b -> Bool
isThere = \case
  There _ -> Bool
True
  _ -> Bool
False

-- | Detect if a 'Wedge' is a 'Nowhere' empty case.
--
isNowhere :: Wedge a b -> Bool
isNowhere :: Wedge a b -> Bool
isNowhere = \case
  Nowhere -> Bool
True
  _ -> Bool
False

-- -------------------------------------------------------------------- --
-- Filtering


-- | Given a 'Foldable' of 'Wedge's, collect the 'Here' cases, if any.
--
heres :: Foldable f => f (Wedge a b) -> [a]
heres :: f (Wedge a b) -> [a]
heres = (Wedge a b -> [a] -> [a]) -> [a] -> f (Wedge a b) -> [a]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Wedge a b -> [a] -> [a]
forall a b. Wedge a b -> [a] -> [a]
go [a]
forall a. Monoid a => a
mempty
  where
    go :: Wedge a b -> [a] -> [a]
go (Here a :: a
a) acc :: [a]
acc = a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
acc
    go _ acc :: [a]
acc = [a]
acc

-- | Given a 'Foldable' of 'Wedge's, collect the 'There' cases, if any.
--
theres :: Foldable f => f (Wedge a b) -> [b]
theres :: f (Wedge a b) -> [b]
theres = (Wedge a b -> [b] -> [b]) -> [b] -> f (Wedge a b) -> [b]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Wedge a b -> [b] -> [b]
forall a a. Wedge a a -> [a] -> [a]
go [b]
forall a. Monoid a => a
mempty
  where
    go :: Wedge a a -> [a] -> [a]
go (There b :: a
b) acc :: [a]
acc = a
ba -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
acc
    go _ acc :: [a]
acc = [a]
acc

-- | Filter the 'Here' cases of a 'Foldable' of 'Wedge's.
--
filterHeres :: Foldable f => f (Wedge a b) -> [Wedge a b]
filterHeres :: f (Wedge a b) -> [Wedge a b]
filterHeres = (Wedge a b -> [Wedge a b] -> [Wedge a b])
-> [Wedge a b] -> f (Wedge a b) -> [Wedge a b]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Wedge a b -> [Wedge a b] -> [Wedge a b]
forall a b. Wedge a b -> [Wedge a b] -> [Wedge a b]
go [Wedge a b]
forall a. Monoid a => a
mempty
  where
    go :: Wedge a b -> [Wedge a b] -> [Wedge a b]
go (Here _) acc :: [Wedge a b]
acc = [Wedge a b]
acc
    go ab :: Wedge a b
ab acc :: [Wedge a b]
acc = Wedge a b
abWedge a b -> [Wedge a b] -> [Wedge a b]
forall a. a -> [a] -> [a]
:[Wedge a b]
acc

-- | Filter the 'There' cases of a 'Foldable' of 'Wedge's.
--
filterTheres :: Foldable f => f (Wedge a b) -> [Wedge a b]
filterTheres :: f (Wedge a b) -> [Wedge a b]
filterTheres = (Wedge a b -> [Wedge a b] -> [Wedge a b])
-> [Wedge a b] -> f (Wedge a b) -> [Wedge a b]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Wedge a b -> [Wedge a b] -> [Wedge a b]
forall a b. Wedge a b -> [Wedge a b] -> [Wedge a b]
go [Wedge a b]
forall a. Monoid a => a
mempty
  where
    go :: Wedge a b -> [Wedge a b] -> [Wedge a b]
go (There _) acc :: [Wedge a b]
acc = [Wedge a b]
acc
    go ab :: Wedge a b
ab acc :: [Wedge a b]
acc = Wedge a b
abWedge a b -> [Wedge a b] -> [Wedge a b]
forall a. a -> [a] -> [a]
:[Wedge a b]
acc

-- | Filter the 'Nowhere' cases of a 'Foldable' of 'Wedge's.
--
filterNowheres :: Foldable f => f (Wedge a b) -> [Wedge a b]
filterNowheres :: f (Wedge a b) -> [Wedge a b]
filterNowheres = (Wedge a b -> [Wedge a b] -> [Wedge a b])
-> [Wedge a b] -> f (Wedge a b) -> [Wedge a b]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Wedge a b -> [Wedge a b] -> [Wedge a b]
forall a b. Wedge a b -> [Wedge a b] -> [Wedge a b]
go [Wedge a b]
forall a. Monoid a => a
mempty
  where
    go :: Wedge a b -> [Wedge a b] -> [Wedge a b]
go Nowhere acc :: [Wedge a b]
acc = [Wedge a b]
acc
    go ab :: Wedge a b
ab acc :: [Wedge a b]
acc = Wedge a b
abWedge a b -> [Wedge a b] -> [Wedge a b]
forall a. a -> [a] -> [a]
:[Wedge a b]
acc

-- -------------------------------------------------------------------- --
-- Filtering

-- | Fold over the 'Here' cases of a 'Foldable' of 'Wedge's by some
-- accumulating function.
--
foldHeres :: Foldable f => (a -> m -> m) -> m -> f (Wedge a b) -> m
foldHeres :: (a -> m -> m) -> m -> f (Wedge a b) -> m
foldHeres k :: a -> m -> m
k = (Wedge a b -> m -> m) -> m -> f (Wedge a b) -> m
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Wedge a b -> m -> m
forall b. Wedge a b -> m -> m
go
  where
    go :: Wedge a b -> m -> m
go (Here a :: a
a) acc :: m
acc = a -> m -> m
k a
a m
acc
    go _ acc :: m
acc = m
acc

-- | Fold over the 'There' cases of a 'Foldable' of 'Wedge's by some
-- accumulating function.
--
foldTheres :: Foldable f => (b -> m -> m) -> m -> f (Wedge a b) -> m
foldTheres :: (b -> m -> m) -> m -> f (Wedge a b) -> m
foldTheres k :: b -> m -> m
k = (Wedge a b -> m -> m) -> m -> f (Wedge a b) -> m
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Wedge a b -> m -> m
forall a. Wedge a b -> m -> m
go
  where
    go :: Wedge a b -> m -> m
go (There b :: b
b) acc :: m
acc = b -> m -> m
k b
b m
acc
    go _ acc :: m
acc = m
acc


-- | Given a 'Wedge' of lists, produce a list of wedges by mapping
-- the list of 'as' to 'Here' values, or the list of 'bs' to 'There'
-- values.
--
gatherWedges :: Wedge [a] [b] -> [Wedge a b]
gatherWedges :: Wedge [a] [b] -> [Wedge a b]
gatherWedges Nowhere = []
gatherWedges (Here as :: [a]
as) = (a -> Wedge a b) -> [a] -> [Wedge a b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Wedge a b
forall a b. a -> Wedge a b
Here [a]
as
gatherWedges (There bs :: [b]
bs) = (b -> Wedge a b) -> [b] -> [Wedge a b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Wedge a b
forall a b. b -> Wedge a b
There [b]
bs

-- | Unfold from right to left into a wedge product. For a variant
-- that accumulates in the seed instead of just updating with a
-- new value, see 'accumUntil' and 'accumUntilM'.
--
unfoldr :: Alternative f => (b -> Wedge a b) -> b -> f a
unfoldr :: (b -> Wedge a b) -> b -> f a
unfoldr f :: b -> Wedge a b
f = Identity (f a) -> f a
forall a. Identity a -> a
runIdentity (Identity (f a) -> f a) -> (b -> Identity (f a)) -> b -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> Identity (Wedge a b)) -> b -> Identity (f a)
forall (m :: * -> *) (f :: * -> *) b a.
(Monad m, Alternative f) =>
(b -> m (Wedge a b)) -> b -> m (f a)
unfoldrM (Wedge a b -> Identity (Wedge a b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Wedge a b -> Identity (Wedge a b))
-> (b -> Wedge a b) -> b -> Identity (Wedge a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Wedge a b
f)

-- | Unfold from right to left into a monadic computation over a wedge product
--
unfoldrM :: (Monad m, Alternative f) => (b -> m (Wedge a b)) -> b -> m (f a)
unfoldrM :: (b -> m (Wedge a b)) -> b -> m (f a)
unfoldrM f :: b -> m (Wedge a b)
f b :: b
b = b -> m (Wedge a b)
f b
b m (Wedge a b) -> (Wedge a b -> m (f a)) -> m (f a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Nowhere -> f a -> m (f a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure f a
forall (f :: * -> *) a. Alternative f => f a
empty
    Here a :: a
a -> (a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>) (f a -> f a) -> m (f a) -> m (f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (b -> m (Wedge a b)) -> b -> m (f a)
forall (m :: * -> *) (f :: * -> *) b a.
(Monad m, Alternative f) =>
(b -> m (Wedge a b)) -> b -> m (f a)
unfoldrM b -> m (Wedge a b)
f b
b
    There b' :: b
b' -> (b -> m (Wedge a b)) -> b -> m (f a)
forall (m :: * -> *) (f :: * -> *) b a.
(Monad m, Alternative f) =>
(b -> m (Wedge a b)) -> b -> m (f a)
unfoldrM b -> m (Wedge a b)
f b
b'

-- | Iterate on a seed, accumulating a result. See 'iterateUntilM' for
-- more details.
--
iterateUntil :: Alternative f => (b -> Wedge a b) -> b -> f a
iterateUntil :: (b -> Wedge a b) -> b -> f a
iterateUntil f :: b -> Wedge a b
f = Identity (f a) -> f a
forall a. Identity a -> a
runIdentity (Identity (f a) -> f a) -> (b -> Identity (f a)) -> b -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> Identity (Wedge a b)) -> b -> Identity (f a)
forall (m :: * -> *) (f :: * -> *) b a.
(Monad m, Alternative f) =>
(b -> m (Wedge a b)) -> b -> m (f a)
iterateUntilM (Wedge a b -> Identity (Wedge a b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Wedge a b -> Identity (Wedge a b))
-> (b -> Wedge a b) -> b -> Identity (Wedge a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Wedge a b
f)

-- | Iterate on a seed, which may result in one of three scenarios:
--
--   1. The function yields a @Nowhere@ value, which terminates the
--      iteration.
--
--   2. The function yields a @Here@ value.
--
--   3. The function yields a @There@ value, which changes the seed
--      and iteration continues with the new seed.
--
iterateUntilM
    :: Monad m
    => Alternative f
    => (b -> m (Wedge a b))
    -> b
    -> m (f a)
iterateUntilM :: (b -> m (Wedge a b)) -> b -> m (f a)
iterateUntilM f :: b -> m (Wedge a b)
f b :: b
b = b -> m (Wedge a b)
f b
b m (Wedge a b) -> (Wedge a b -> m (f a)) -> m (f a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Nowhere -> f a -> m (f a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure f a
forall (f :: * -> *) a. Alternative f => f a
empty
    Here a :: a
a -> f a -> m (f a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a)
    There b' :: b
b' -> (b -> m (Wedge a b)) -> b -> m (f a)
forall (m :: * -> *) (f :: * -> *) b a.
(Monad m, Alternative f) =>
(b -> m (Wedge a b)) -> b -> m (f a)
iterateUntilM b -> m (Wedge a b)
f b
b'

-- | Iterate on a seed, accumulating values and monoidally
-- updating the seed with each update.
--
accumUntil
    :: Alternative f
    => Monoid b
    => (b -> Wedge a b)
    -> f a
accumUntil :: (b -> Wedge a b) -> f a
accumUntil f :: b -> Wedge a b
f = Identity (f a) -> f a
forall a. Identity a -> a
runIdentity ((b -> Identity (Wedge a b)) -> Identity (f a)
forall (m :: * -> *) (f :: * -> *) b a.
(Monad m, Alternative f, Monoid b) =>
(b -> m (Wedge a b)) -> m (f a)
accumUntilM (Wedge a b -> Identity (Wedge a b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Wedge a b -> Identity (Wedge a b))
-> (b -> Wedge a b) -> b -> Identity (Wedge a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Wedge a b
f))

-- | Iterate on a seed, accumulating values and monoidally
-- updating a seed within a monad.
--
accumUntilM
    :: Monad m
    => Alternative f
    => Monoid b
    => (b -> m (Wedge a b))
    -> m (f a)
accumUntilM :: (b -> m (Wedge a b)) -> m (f a)
accumUntilM f :: b -> m (Wedge a b)
f = b -> m (f a)
forall (f :: * -> *). Alternative f => b -> m (f a)
go b
forall a. Monoid a => a
mempty
  where
    go :: b -> m (f a)
go b :: b
b = b -> m (Wedge a b)
f b
b m (Wedge a b) -> (Wedge a b -> m (f a)) -> m (f a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Nowhere -> f a -> m (f a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure f a
forall (f :: * -> *) a. Alternative f => f a
empty
      Here a :: a
a -> (a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>) (f a -> f a) -> m (f a) -> m (f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> m (f a)
go b
b
      There b' :: b
b' -> b -> m (f a)
go (b
b' b -> b -> b
forall a. Monoid a => a -> a -> a
`mappend` b
b)

-- -------------------------------------------------------------------- --
-- Partitioning

-- | Given a 'Foldable' of 'Wedge's, partition it into a tuple of alternatives
-- their parts.
--
partitionWedges
    :: Foldable t
    => Alternative f
    => t (Wedge a b) -> (f a, f b)
partitionWedges :: t (Wedge a b) -> (f a, f b)
partitionWedges = (Wedge a b -> (f a, f b) -> (f a, f b))
-> (f a, f b) -> t (Wedge a b) -> (f a, f b)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Wedge a b -> (f a, f b) -> (f a, f b)
forall (f :: * -> *) (f :: * -> *) a a.
(Alternative f, Alternative f) =>
Wedge a a -> (f a, f a) -> (f a, f a)
go (f a
forall (f :: * -> *) a. Alternative f => f a
empty, f b
forall (f :: * -> *) a. Alternative f => f a
empty)
  where
    go :: Wedge a a -> (f a, f a) -> (f a, f a)
go Nowhere acc :: (f a, f a)
acc = (f a, f a)
acc
    go (Here a :: a
a) (as :: f a
as, bs :: f a
bs) = (a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> f a
as, f a
bs)
    go (There b :: a
b) (as :: f a
as, bs :: f a
bs) = (f a
as, a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
b f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> f a
bs)

-- | Partition a structure by mapping its contents into 'Wedge's,
-- and folding over @('<|>')@.
--
mapWedges
    :: Traversable t
    => Alternative f
    => (a -> Wedge b c)
    -> t a
    -> (f b, f c)
mapWedges :: (a -> Wedge b c) -> t a -> (f b, f c)
mapWedges f :: a -> Wedge b c
f = t (Wedge b c) -> (f b, f c)
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Alternative f) =>
t (Wedge a b) -> (f a, f b)
partitionWedges (t (Wedge b c) -> (f b, f c))
-> (t a -> t (Wedge b c)) -> t a -> (f b, f c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Wedge b c) -> t a -> t (Wedge b c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Wedge b c
f

-- -------------------------------------------------------------------- --
-- Associativity

-- | Re-associate a 'Wedge' of 'Wedge's from left to right.
--
reassocLR :: Wedge (Wedge a b) c -> Wedge a (Wedge b c)
reassocLR :: Wedge (Wedge a b) c -> Wedge a (Wedge b c)
reassocLR = \case
    Nowhere -> Wedge a (Wedge b c)
forall a b. Wedge a b
Nowhere
    Here w :: Wedge a b
w -> case Wedge a b
w of
      Nowhere -> Wedge b c -> Wedge a (Wedge b c)
forall a b. b -> Wedge a b
There Wedge b c
forall a b. Wedge a b
Nowhere
      Here a :: a
a -> a -> Wedge a (Wedge b c)
forall a b. a -> Wedge a b
Here a
a
      There b :: b
b -> Wedge b c -> Wedge a (Wedge b c)
forall a b. b -> Wedge a b
There (b -> Wedge b c
forall a b. a -> Wedge a b
Here b
b)
    There c :: c
c -> Wedge b c -> Wedge a (Wedge b c)
forall a b. b -> Wedge a b
There (c -> Wedge b c
forall a b. b -> Wedge a b
There c
c)

-- | Re-associate a 'Wedge' of 'Wedge's from left to right.
--
reassocRL :: Wedge a (Wedge b c) -> Wedge (Wedge a b) c
reassocRL :: Wedge a (Wedge b c) -> Wedge (Wedge a b) c
reassocRL = \case
  Nowhere -> Wedge (Wedge a b) c
forall a b. Wedge a b
Nowhere
  Here a :: a
a -> Wedge a b -> Wedge (Wedge a b) c
forall a b. a -> Wedge a b
Here (a -> Wedge a b
forall a b. a -> Wedge a b
Here a
a)
  There w :: Wedge b c
w -> case Wedge b c
w of
    Nowhere -> Wedge a b -> Wedge (Wedge a b) c
forall a b. a -> Wedge a b
Here Wedge a b
forall a b. Wedge a b
Nowhere
    Here b :: b
b -> Wedge a b -> Wedge (Wedge a b) c
forall a b. a -> Wedge a b
Here (b -> Wedge a b
forall a b. b -> Wedge a b
There b
b)
    There c :: c
c -> c -> Wedge (Wedge a b) c
forall a b. b -> Wedge a b
There c
c

-- -------------------------------------------------------------------- --
-- Distributivity

-- | Distribute a 'Wedge' over a product.
--
distributeWedge :: Wedge (a,b) c -> (Wedge a c, Wedge b c)
distributeWedge :: Wedge (a, b) c -> (Wedge a c, Wedge b c)
distributeWedge = Wedge (a, b) c -> (Wedge a c, Wedge b c)
forall (f :: * -> * -> *) a b c.
Bifunctor f =>
f (a, b) c -> (f a c, f b c)
unzipFirst

-- | Codistribute 'Wedge's over a coproduct.
--
codistributeWedge :: Either (Wedge a c) (Wedge b c) -> Wedge (Either a b) c
codistributeWedge :: Either (Wedge a c) (Wedge b c) -> Wedge (Either a b) c
codistributeWedge = Either (Wedge a c) (Wedge b c) -> Wedge (Either a b) c
forall (f :: * -> * -> *) a c b.
Bifunctor f =>
Either (f a c) (f b c) -> f (Either a b) c
undecideFirst

-- -------------------------------------------------------------------- --
-- Symmetry

-- | Swap the positions of the @a@'s and the @b@'s in a 'Wedge'.
--
swapWedge :: Wedge a b -> Wedge b a
swapWedge :: Wedge a b -> Wedge b a
swapWedge = Wedge b a
-> (a -> Wedge b a) -> (b -> Wedge b a) -> Wedge a b -> Wedge b a
forall c a b. c -> (a -> c) -> (b -> c) -> Wedge a b -> c
wedge Wedge b a
forall a b. Wedge a b
Nowhere a -> Wedge b a
forall a b. b -> Wedge a b
There b -> Wedge b a
forall a b. a -> Wedge a b
Here

-- -------------------------------------------------------------------- --
-- Functor class instances

instance Eq a => Eq1 (Wedge a) where
  liftEq :: (a -> b -> Bool) -> Wedge a a -> Wedge a b -> Bool
liftEq = (a -> a -> Bool)
-> (a -> b -> Bool) -> Wedge a a -> Wedge a b -> 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 Wedge where
  liftEq2 :: (a -> b -> Bool)
-> (c -> d -> Bool) -> Wedge a c -> Wedge b d -> Bool
liftEq2 _ _ Nowhere Nowhere = Bool
True
  liftEq2 f :: a -> b -> Bool
f _ (Here a :: a
a) (Here c :: b
c) = a -> b -> Bool
f a
a b
c
  liftEq2 _ g :: c -> d -> Bool
g (There b :: c
b) (There d :: d
d) = c -> d -> Bool
g c
b d
d
  liftEq2 _ _ _ _ = Bool
False

instance Ord a => Ord1 (Wedge a) where
  liftCompare :: (a -> b -> Ordering) -> Wedge a a -> Wedge a b -> Ordering
liftCompare = (a -> a -> Ordering)
-> (a -> b -> Ordering) -> Wedge a a -> Wedge a b -> 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 Wedge where
  liftCompare2 :: (a -> b -> Ordering)
-> (c -> d -> Ordering) -> Wedge a c -> Wedge b d -> Ordering
liftCompare2 _ _ Nowhere Nowhere = Ordering
EQ
  liftCompare2 _ _ Nowhere _ = Ordering
LT
  liftCompare2 _ _ _ Nowhere = Ordering
GT
  liftCompare2 f :: a -> b -> Ordering
f _ (Here a :: a
a) (Here c :: b
c) = a -> b -> Ordering
f a
a b
c
  liftCompare2 _ _ Here{} There{} = Ordering
LT
  liftCompare2 _ _ There{} Here{} = Ordering
GT
  liftCompare2 _ g :: c -> d -> Ordering
g (There b :: c
b) (There d :: d
d) = c -> d -> Ordering
g c
b d
d

instance Show a => Show1 (Wedge a) where
  liftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Wedge a a -> ShowS
liftShowsPrec = (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> Int
-> Wedge a a
-> 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 Wedge where
  liftShowsPrec2 :: (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> Wedge a b
-> ShowS
liftShowsPrec2 _ _ _ _ _ Nowhere = String -> ShowS
showString "Nowhere"
  liftShowsPrec2 f :: Int -> a -> ShowS
f _ _ _ d :: Int
d (Here a :: a
a) = (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith Int -> a -> ShowS
f "Here" Int
d a
a
  liftShowsPrec2 _ _ g :: Int -> b -> ShowS
g _ d :: Int
d (There b :: b
b) = (Int -> b -> ShowS) -> String -> Int -> b -> ShowS
forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith Int -> b -> ShowS
g "There" Int
d b
b

instance Read a => Read1 (Wedge a) where
  liftReadsPrec :: (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (Wedge a a)
liftReadsPrec = (Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS a)
-> ReadS [a]
-> Int
-> ReadS (Wedge a a)
forall (f :: * -> * -> *) a b.
Read2 f =>
(Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS b)
-> ReadS [b]
-> Int
-> ReadS (f a b)
liftReadsPrec2 Int -> ReadS a
forall a. Read a => Int -> ReadS a
readsPrec ReadS [a]
forall a. Read a => ReadS [a]
readList

instance Read2 Wedge where
  liftReadPrec2 :: ReadPrec a
-> ReadPrec [a]
-> ReadPrec b
-> ReadPrec [b]
-> ReadPrec (Wedge a b)
liftReadPrec2 rpa :: ReadPrec a
rpa _ rpb :: ReadPrec b
rpb _ = ReadPrec (Wedge a b)
forall a b. ReadPrec (Wedge a b)
nowhereP ReadPrec (Wedge a b)
-> ReadPrec (Wedge a b) -> ReadPrec (Wedge a b)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ReadPrec (Wedge a b)
forall b. ReadPrec (Wedge a b)
hereP ReadPrec (Wedge a b)
-> ReadPrec (Wedge a b) -> ReadPrec (Wedge a b)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ReadPrec (Wedge a b)
forall a. ReadPrec (Wedge a b)
thereP
    where
      nowhereP :: ReadPrec (Wedge a b)
nowhereP = Wedge a b
forall a b. Wedge a b
Nowhere Wedge a b -> ReadPrec () -> ReadPrec (Wedge a b)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Lexeme -> ReadPrec ()
expectP (String -> Lexeme
Ident "Nowhere")
      hereP :: ReadPrec (Wedge a b)
hereP = ReadPrec (Wedge a b) -> ReadPrec (Wedge a b)
forall a. ReadPrec a -> ReadPrec a
readData (ReadPrec (Wedge a b) -> ReadPrec (Wedge a b))
-> ReadPrec (Wedge a b) -> ReadPrec (Wedge a b)
forall a b. (a -> b) -> a -> b
$ ReadPrec a -> String -> (a -> Wedge a b) -> ReadPrec (Wedge a b)
forall a t. ReadPrec a -> String -> (a -> t) -> ReadPrec t
readUnaryWith ReadPrec a
rpa "Here" a -> Wedge a b
forall a b. a -> Wedge a b
Here
      thereP :: ReadPrec (Wedge a b)
thereP = ReadPrec (Wedge a b) -> ReadPrec (Wedge a b)
forall a. ReadPrec a -> ReadPrec a
readData (ReadPrec (Wedge a b) -> ReadPrec (Wedge a b))
-> ReadPrec (Wedge a b) -> ReadPrec (Wedge a b)
forall a b. (a -> b) -> a -> b
$ ReadPrec b -> String -> (b -> Wedge a b) -> ReadPrec (Wedge a b)
forall a t. ReadPrec a -> String -> (a -> t) -> ReadPrec t
readUnaryWith ReadPrec b
rpb "There" b -> Wedge a b
forall a b. b -> Wedge a b
There

instance Hashable a => Hashable1 (Wedge a) where
  liftHashWithSalt :: (Int -> a -> Int) -> Int -> Wedge a a -> Int
liftHashWithSalt = (Int -> a -> Int) -> (Int -> a -> Int) -> Int -> Wedge a a -> Int
forall (t :: * -> * -> *) a b.
Hashable2 t =>
(Int -> a -> Int) -> (Int -> b -> Int) -> Int -> t a b -> Int
liftHashWithSalt2 Int -> a -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt

instance Hashable2 Wedge where
  liftHashWithSalt2 :: (Int -> a -> Int) -> (Int -> b -> Int) -> Int -> Wedge a b -> Int
liftHashWithSalt2 f :: Int -> a -> Int
f g :: Int -> b -> Int
g salt :: Int
salt = \case
    Nowhere -> Int
salt Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (0 :: Int) Int -> () -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` ()
    Here a :: a
a -> Int
salt Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (1 :: Int) Int -> a -> Int
`f` a
a
    There b :: b
b -> Int
salt Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (2 :: Int) Int -> b -> Int
`g` b
b

instance NFData a => NFData1 (Wedge a) where
  liftRnf :: (a -> ()) -> Wedge a a -> ()
liftRnf = (a -> ()) -> (a -> ()) -> Wedge a a -> ()
forall (p :: * -> * -> *) a b.
NFData2 p =>
(a -> ()) -> (b -> ()) -> p a b -> ()
liftRnf2 a -> ()
forall a. NFData a => a -> ()
rnf

instance NFData2 Wedge where
  liftRnf2 :: (a -> ()) -> (b -> ()) -> Wedge a b -> ()
liftRnf2 f :: a -> ()
f g :: b -> ()
g = \case
    Nowhere -> ()
    Here a :: a
a -> a -> ()
f a
a
    There b :: b
b -> b -> ()
g b
b

-- -------------------------------------------------------------------- --
-- Std instances

instance (Hashable a, Hashable b) => Hashable (Wedge a b)

instance Functor (Wedge a) where
  fmap :: (a -> b) -> Wedge a a -> Wedge a b
fmap f :: a -> b
f = \case
    Nowhere -> Wedge a b
forall a b. Wedge a b
Nowhere
    Here a :: a
a -> a -> Wedge a b
forall a b. a -> Wedge a b
Here a
a
    There b :: a
b -> b -> Wedge a b
forall a b. b -> Wedge a b
There (a -> b
f a
b)

instance Foldable (Wedge a) where
  foldMap :: (a -> m) -> Wedge a a -> m
foldMap f :: a -> m
f (There b :: a
b) = a -> m
f a
b
  foldMap _ _ = m
forall a. Monoid a => a
mempty

instance Traversable (Wedge a) where
  traverse :: (a -> f b) -> Wedge a a -> f (Wedge a b)
traverse f :: a -> f b
f = \case
    Nowhere -> Wedge a b -> f (Wedge a b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Wedge a b
forall a b. Wedge a b
Nowhere
    Here a :: a
a -> Wedge a b -> f (Wedge a b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Wedge a b
forall a b. a -> Wedge a b
Here a
a)
    There b :: a
b -> b -> Wedge a b
forall a b. b -> Wedge a b
There (b -> Wedge a b) -> f b -> f (Wedge a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
b

instance Semigroup a => Applicative (Wedge a) where
  pure :: a -> Wedge a a
pure = a -> Wedge a a
forall a b. b -> Wedge a b
There

  _ <*> :: Wedge a (a -> b) -> Wedge a a -> Wedge a b
<*> Nowhere = Wedge a b
forall a b. Wedge a b
Nowhere
  Nowhere <*> _ = Wedge a b
forall a b. Wedge a b
Nowhere
  Here a :: a
a <*> _ = a -> Wedge a b
forall a b. a -> Wedge a b
Here a
a
  There _ <*> Here b :: a
b = a -> Wedge a b
forall a b. a -> Wedge a b
Here a
b
  There f :: a -> b
f <*> There a :: a
a = b -> Wedge a b
forall a b. b -> Wedge a b
There (a -> b
f a
a)

instance Semigroup a => Monad (Wedge a) where
  return :: a -> Wedge a a
return = a -> Wedge a a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  >> :: Wedge a a -> Wedge a b -> Wedge a b
(>>) = Wedge a a -> Wedge a b -> Wedge a b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)

  Nowhere >>= :: Wedge a a -> (a -> Wedge a b) -> Wedge a b
>>= _ = Wedge a b
forall a b. Wedge a b
Nowhere
  Here a :: a
a >>= _ = a -> Wedge a b
forall a b. a -> Wedge a b
Here a
a
  There b :: a
b >>= k :: a -> Wedge a b
k = a -> Wedge a b
k a
b

instance (Semigroup a, Semigroup b) => Semigroup (Wedge a b) where
  Nowhere <> :: Wedge a b -> Wedge a b -> Wedge a b
<> b :: Wedge a b
b = Wedge a b
b
  a :: Wedge a b
a <> Nowhere = Wedge a b
a
  Here a :: a
a <> Here b :: a
b = a -> Wedge a b
forall a b. a -> Wedge a b
Here (a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
b)
  Here _ <> There b :: b
b = b -> Wedge a b
forall a b. b -> Wedge a b
There b
b
  There a :: b
a <> Here _ = b -> Wedge a b
forall a b. b -> Wedge a b
There b
a
  There a :: b
a <> There b :: b
b = b -> Wedge a b
forall a b. b -> Wedge a b
There (b
a b -> b -> b
forall a. Semigroup a => a -> a -> a
<> b
b)

instance (Semigroup a, Semigroup b) => Monoid (Wedge a b) where
  mempty :: Wedge a b
mempty = Wedge a b
forall a b. Wedge a b
Nowhere
  mappend :: Wedge a b -> Wedge a b -> Wedge a b
mappend = Wedge a b -> Wedge a b -> Wedge a b
forall a. Semigroup a => a -> a -> a
(<>)

instance (NFData a, NFData b) => NFData (Wedge a b) where
    rnf :: Wedge a b -> ()
rnf Nowhere = ()
    rnf (Here a :: a
a) = a -> ()
forall a. NFData a => a -> ()
rnf a
a
    rnf (There b :: b
b) = b -> ()
forall a. NFData a => a -> ()
rnf b
b

instance (Binary a, Binary b) => Binary (Wedge a b) where
  put :: Wedge a b -> Put
put Nowhere = Int -> Put
forall t. Binary t => t -> Put
put @Int 0
  put (Here a :: a
a) = Int -> Put
forall t. Binary t => t -> Put
put @Int 1 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> Put
forall t. Binary t => t -> Put
put a
a
  put (There b :: b
b) = Int -> Put
forall t. Binary t => t -> Put
put @Int 2 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> Put
forall t. Binary t => t -> Put
put b
b

  get :: Get (Wedge a b)
get = Binary Int => Get Int
forall t. Binary t => Get t
get @Int Get Int -> (Int -> Get (Wedge a b)) -> Get (Wedge a b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    0 -> Wedge a b -> Get (Wedge a b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Wedge a b
forall a b. Wedge a b
Nowhere
    1 -> a -> Wedge a b
forall a b. a -> Wedge a b
Here (a -> Wedge a b) -> Get a -> Get (Wedge a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get a
forall t. Binary t => Get t
get
    2 -> b -> Wedge a b
forall a b. b -> Wedge a b
There (b -> Wedge a b) -> Get b -> Get (Wedge a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get b
forall t. Binary t => Get t
get
    _ -> String -> Get (Wedge a b)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Invalid Wedge index"

instance Semigroup a => MonadZip (Wedge a) where
  mzipWith :: (a -> b -> c) -> Wedge a a -> Wedge a b -> Wedge a c
mzipWith f :: a -> b -> c
f a :: Wedge a a
a b :: Wedge a b
b = a -> b -> c
f (a -> b -> c) -> Wedge a a -> Wedge a (b -> c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Wedge a a
a Wedge a (b -> c) -> Wedge a b -> Wedge a c
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Wedge a b
b

instance Monoid a => Alternative (Wedge a) where
  empty :: Wedge a a
empty = Wedge a a
forall a b. Wedge a b
Nowhere
  Nowhere <|> :: Wedge a a -> Wedge a a -> Wedge a a
<|> c :: Wedge a a
c = Wedge a a
c
  c :: Wedge a a
c <|> Nowhere = Wedge a a
c
  Here a :: a
a <|> Here b :: a
b = a -> Wedge a a
forall a b. a -> Wedge a b
Here (a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
b)
  Here _ <|> There b :: a
b = a -> Wedge a a
forall a b. b -> Wedge a b
There a
b
  There a :: a
a <|> Here _ = a -> Wedge a a
forall a b. b -> Wedge a b
There a
a
  There _ <|> There b :: a
b = a -> Wedge a a
forall a b. b -> Wedge a b
There a
b

instance Monoid a => MonadPlus (Wedge a)

-- -------------------------------------------------------------------- --
-- Bifunctors

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

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

instance Bitraversable Wedge where
  bitraverse :: (a -> f c) -> (b -> f d) -> Wedge a b -> f (Wedge c d)
bitraverse f :: a -> f c
f g :: b -> f d
g = \case
    Nowhere -> Wedge c d -> f (Wedge c d)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Wedge c d
forall a b. Wedge a b
Nowhere
    Here a :: 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
    There b :: 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