{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
-- |
-- Module       : Data.Wedge
-- Copyright    : (c) 2020 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(..)
  -- * Combinators
, quotWedge
, wedgeLeft
, wedgeRight
, fromWedge
, toWedge
, isHere
, isThere
, isNowhere
  -- ** Eliminators
, wedge
  -- ** Filtering
, heres
, theres
, filterHeres
, filterTheres
, filterNowheres
  -- ** Folding
, foldHeres
, foldTheres
, gatherWedges
  -- ** Partitioning
, partitionWedges
, mapWedges
  -- ** Distributivity
, distributeWedge
, codistributeWedge
  -- ** Associativity
, reassocLR
, reassocRL
  -- ** Symmetry
, swapWedge
) where


import Control.Applicative (Alternative(..))
import Control.DeepSeq (NFData(..))

import Data.Bifunctor
import Data.Bifoldable
import Data.Binary (Binary(..))
import Data.Bitraversable
import Data.Data
import Data.Hashable
#if __GLASGOW_HASKELL__ < 804
import Data.Semigroup (Semigroup(..))
#endif

import GHC.Generics

{- $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 is
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)`. Additioally,
we may derive other facts about its associativity, distributivity, commutativity, and
any more. As an exercise, think of soemthing `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
    )

-- -------------------------------------------------------------------- --
-- 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 a -> c
_ b -> c
_ Wedge a b
Nowhere = c
c
wedge c
_ a -> c
f b -> c
_ (Here a
a) = a -> c
f a
a
wedge c
_ a -> c
_ b -> c
g (There 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 (Left Maybe a
a) = 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 Maybe a
a
quotWedge (Right Maybe b
b) = 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 Maybe b
b

-- | 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 Wedge a b
Nowhere = Maybe (Either a b)
forall a. Maybe a
Nothing
fromWedge (Here a
a) = Either a b -> Maybe (Either a b)
forall a. a -> Maybe a
Just (a -> Either a b
forall a b. a -> Either a b
Left a
a)
fromWedge (There b
b) = Either a b -> Maybe (Either a b)
forall a. a -> Maybe a
Just (b -> Either a b
forall a b. b -> Either a b
Right b
b)

-- | 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 Maybe (Either a b)
Nothing = Wedge a b
forall a b. Wedge a b
Nowhere
toWedge (Just Either a b
e) = (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 Either a b
e

-- | 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 Maybe a
Nothing = Wedge a b
forall a b. Wedge a b
Nowhere
wedgeLeft (Just 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 Maybe b
Nothing = Wedge a b
forall a b. Wedge a b
Nowhere
wedgeRight (Just 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 a
_ -> Bool
True
  Wedge a b
_ -> Bool
False

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

-- | Detect if a 'Wedge' is a 'Nowhere' empty case.
--
isNowhere :: Wedge a b -> Bool
isNowhere :: Wedge a b -> Bool
isNowhere = \case
  Wedge a b
Nowhere -> Bool
True
  Wedge a b
_ -> 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
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
acc
    go Wedge a b
_ [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 a
b) [a]
acc = a
ba -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
acc
    go Wedge a a
_ [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 a
_) [Wedge a b]
acc = [Wedge a b]
acc
    go Wedge a b
ab [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 b
_) [Wedge a b]
acc = [Wedge a b]
acc
    go Wedge a b
ab [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 Wedge a b
Nowhere [Wedge a b]
acc = [Wedge a b]
acc
    go Wedge a b
ab [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 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) m
acc = a -> m -> m
k a
a m
acc
    go Wedge a b
_ 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 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) m
acc = b -> m -> m
k b
b m
acc
    go Wedge a b
_ 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 Wedge [a] [b]
Nowhere = []
gatherWedges (Here [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 [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

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

-- | Given a 'Foldable' of 'Wedge's, partition it into a tuple of alternatives
-- their parts.
--
partitionWedges
    :: forall f t a b
    . ( 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 Wedge a a
Nowhere (f a, f a)
acc = (f a, f a)
acc
    go (Here a
a) (f a
as, 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 a
b) (f a
as, 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
    :: forall f t a b c
    . ( Alternative f
      , Traversable t
      )
    => (a -> Wedge b c)
    -> t a
    -> (f b, f c)
mapWedges :: (a -> Wedge b c) -> t a -> (f b, f c)
mapWedges a -> Wedge b c
f = t (Wedge b c) -> (f b, f c)
forall (f :: * -> *) (t :: * -> *) 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
    Wedge (Wedge a b) c
Nowhere -> Wedge a (Wedge b c)
forall a b. Wedge a b
Nowhere
    Here Wedge a b
w -> case Wedge a b
w of
      Wedge a b
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 -> Wedge a (Wedge b c)
forall a b. a -> Wedge a b
Here a
a
      There 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 -> 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
  Wedge a (Wedge b c)
Nowhere -> Wedge (Wedge a b) c
forall a b. Wedge a b
Nowhere
  Here 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 Wedge b c
w -> case Wedge b c
w of
    Wedge b c
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 -> 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 -> 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 = \case
  Wedge (a, b) c
Nowhere -> (Wedge a c
forall a b. Wedge a b
Nowhere, Wedge b c
forall a b. Wedge a b
Nowhere)
  Here (a
a,b
b) -> (a -> Wedge a c
forall a b. a -> Wedge a b
Here a
a, b -> Wedge b c
forall a b. a -> Wedge a b
Here b
b)
  There c
c -> (c -> Wedge a c
forall a b. b -> Wedge a b
There c
c, c -> Wedge b c
forall a b. b -> Wedge a b
There c
c)

-- | 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 = \case
  Left Wedge a c
w -> case Wedge a c
w of
    Wedge a c
Nowhere -> Wedge (Either a b) c
forall a b. Wedge a b
Nowhere
    Here a
a -> Either a b -> Wedge (Either a b) c
forall a b. a -> Wedge a b
Here (a -> Either a b
forall a b. a -> Either a b
Left a
a)
    There c
c -> c -> Wedge (Either a b) c
forall a b. b -> Wedge a b
There c
c
  Right Wedge b c
w -> case Wedge b c
w of
    Wedge b c
Nowhere -> Wedge (Either a b) c
forall a b. Wedge a b
Nowhere
    Here b
b -> Either a b -> Wedge (Either a b) c
forall a b. a -> Wedge a b
Here (b -> Either a b
forall a b. b -> Either a b
Right b
b)
    There c
c -> c -> Wedge (Either a b) c
forall a b. b -> Wedge a b
There c
c

-- -------------------------------------------------------------------- --
-- 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 = \case
  Wedge a b
Nowhere -> Wedge b a
forall a b. Wedge a b
Nowhere
  Here a
a -> a -> Wedge b a
forall a b. b -> Wedge a b
There a
a
  There b
b -> b -> Wedge b a
forall a b. a -> Wedge a b
Here 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 a -> b
f = \case
    Wedge a a
Nowhere -> Wedge a b
forall a b. Wedge a b
Nowhere
    Here a
a -> a -> Wedge a b
forall a b. a -> Wedge a b
Here a
a
    There 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 a -> m
f (There a
b) = a -> m
f a
b
  foldMap a -> m
_ Wedge a a
_ = m
forall a. Monoid a => a
mempty

instance Traversable (Wedge a) where
  traverse :: (a -> f b) -> Wedge a a -> f (Wedge a b)
traverse a -> f b
f = \case
    Wedge a a
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 -> 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 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 -> b) -> Wedge a a -> Wedge a b
<*> Wedge a a
Nowhere = Wedge a b
forall a b. Wedge a b
Nowhere
  Wedge a (a -> b)
Nowhere <*> Wedge a a
_ = Wedge a b
forall a b. Wedge a b
Nowhere
  Here a
a <*> Wedge a a
_ = a -> Wedge a b
forall a b. a -> Wedge a b
Here a
a
  There a -> b
_ <*> Here a
b = a -> Wedge a b
forall a b. a -> Wedge a b
Here a
b
  There a -> b
f <*> There 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
(*>)

  Wedge a a
Nowhere >>= :: 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
b >>= a -> Wedge a b
k = a -> Wedge a b
k a
b

instance (Semigroup a, Semigroup b) => Semigroup (Wedge a b) where
  Wedge a b
Nowhere <> :: Wedge a b -> Wedge a b -> Wedge a b
<> Wedge a b
b = Wedge a b
b
  Wedge a b
a <> Wedge a b
Nowhere = Wedge a b
a
  Here a
a <> Here 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 a
_ <> There b
b = b -> Wedge a b
forall a b. b -> Wedge a b
There b
b
  There b
a <> Here a
_ = b -> Wedge a b
forall a b. b -> Wedge a b
There b
a
  There b
a <> There 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 Wedge a b
Nowhere = ()
    rnf (Here a
a) = a -> ()
forall a. NFData a => a -> ()
rnf a
a
    rnf (There 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 Wedge a b
Nowhere = Int -> Put
forall t. Binary t => t -> Put
put @Int Int
0
  put (Here a
a) = Int -> Put
forall t. Binary t => t -> Put
put @Int 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) = Int -> Put
forall t. Binary t => t -> Put
put @Int 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
    Int
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
    Int
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
    Int
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
    Int
_ -> String -> Get (Wedge a b)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid Wedge index"

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

instance Bifunctor Wedge where
  bimap :: (a -> b) -> (c -> d) -> Wedge a c -> Wedge b d
bimap a -> b
f c -> d
g = \case
    Wedge a c
Nowhere -> Wedge b d
forall a b. Wedge a b
Nowhere
    Here a
a -> b -> Wedge b d
forall a b. a -> Wedge a b
Here (a -> b
f a
a)
    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 :: (a -> m) -> (b -> m) -> Wedge a b -> m
bifoldMap a -> m
f b -> m
g = \case
    Wedge a b
Nowhere -> m
forall a. Monoid a => a
mempty
    Here a
a -> a -> m
f a
a
    There 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 a -> f c
f b -> f d
g = \case
    Wedge a b
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 -> 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 -> 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