{-# 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
, eqWedge
  -- ** 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.Contravariant (Equivalence(..))
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 (TExp (Wedge a b))
(Wedge a b -> Q Exp)
-> (Wedge a b -> Q (TExp (Wedge a b))) -> Lift (Wedge a b)
forall a b. (Lift a, Lift b) => Wedge a b -> Q Exp
forall a b. (Lift a, Lift b) => Wedge a b -> Q (TExp (Wedge a b))
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: Wedge a b -> Q (TExp (Wedge a b))
$cliftTyped :: forall a b. (Lift a, Lift b) => Wedge a b -> Q (TExp (Wedge a b))
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 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 = (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 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

-- | 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 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 b -> m (Wedge a b)
f 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
    Wedge a b
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
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 -> 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 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 b -> m (Wedge a b)
f 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
    Wedge a b
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 -> 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 -> 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 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 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 -> 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
      Wedge a b
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
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 -> 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
    :: Alternative f
    => Foldable t
    => 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
    :: 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 a -> Wedge b c
f = t (Wedge b c) -> (f b, f c)
forall (f :: * -> *) (t :: * -> *) a b.
(Alternative f, Foldable t) =>
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

-- | Equivalence relation formed by grouping of equal 'Wedge' constructors.
--
eqWedge :: Equivalence (Wedge a b)
eqWedge :: Equivalence (Wedge a b)
eqWedge = (Wedge a b -> Wedge a b -> Bool) -> Equivalence (Wedge a b)
forall a. (a -> a -> Bool) -> Equivalence a
Equivalence Wedge a b -> Wedge a b -> Bool
forall a b. Wedge a b -> Wedge a b -> Bool
equivalence
  where
    equivalence :: Wedge a b -> Wedge a b -> Bool
    equivalence :: Wedge a b -> Wedge a b -> Bool
equivalence Wedge a b
Nowhere   Wedge a b
Nowhere   = Bool
True
    equivalence (Here  a
_) (Here  a
_) = Bool
True
    equivalence (There b
_) (There b
_) = Bool
True
    equivalence Wedge a b
_         Wedge a b
_         = Bool
False

-- -------------------------------------------------------------------- --
-- 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 = 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 a -> b -> Bool
_ c -> d -> Bool
_ Wedge a c
Nowhere Wedge b d
Nowhere = Bool
True
  liftEq2 a -> b -> Bool
f c -> d -> Bool
_ (Here a
a) (Here b
c) = a -> b -> Bool
f a
a b
c
  liftEq2 a -> b -> Bool
_ c -> d -> Bool
g (There c
b) (There d
d) = c -> d -> Bool
g c
b d
d
  liftEq2 a -> b -> Bool
_ c -> d -> Bool
_ Wedge a c
_ Wedge b d
_ = 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 a -> b -> Ordering
_ c -> d -> Ordering
_ Wedge a c
Nowhere Wedge b d
Nowhere = Ordering
EQ
  liftCompare2 a -> b -> Ordering
_ c -> d -> Ordering
_ Wedge a c
Nowhere Wedge b d
_ = Ordering
LT
  liftCompare2 a -> b -> Ordering
_ c -> d -> Ordering
_ Wedge a c
_ Wedge b d
Nowhere = Ordering
GT
  liftCompare2 a -> b -> Ordering
f c -> d -> Ordering
_ (Here a
a) (Here b
c) = a -> b -> Ordering
f a
a b
c
  liftCompare2 a -> b -> Ordering
_ c -> d -> Ordering
_ Here{} There{} = Ordering
LT
  liftCompare2 a -> b -> Ordering
_ c -> d -> Ordering
_ There{} Here{} = Ordering
GT
  liftCompare2 a -> b -> Ordering
_ c -> d -> Ordering
g (There c
b) (There 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 Int -> a -> ShowS
_ [a] -> ShowS
_ Int -> b -> ShowS
_ [b] -> ShowS
_ Int
_ Wedge a b
Nowhere = String -> ShowS
showString String
"Nowhere"
  liftShowsPrec2 Int -> a -> ShowS
f [a] -> ShowS
_ Int -> b -> ShowS
_ [b] -> ShowS
_ Int
d (Here a
a) = (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith Int -> a -> ShowS
f String
"Here" Int
d a
a
  liftShowsPrec2 Int -> a -> ShowS
_ [a] -> ShowS
_ Int -> b -> ShowS
g [b] -> ShowS
_ Int
d (There b
b) = (Int -> b -> ShowS) -> String -> Int -> b -> ShowS
forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith Int -> b -> ShowS
g String
"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 ReadPrec a
rpa ReadPrec [a]
_ ReadPrec b
rpb ReadPrec [b]
_ = 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 String
"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 String
"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 String
"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 Int -> a -> Int
f Int -> b -> Int
g Int
salt = \case
    Wedge a b
Nowhere -> Int
salt Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
0 :: Int) Int -> () -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` ()
    Here a
a -> Int
salt Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
1 :: Int) Int -> a -> Int
`f` a
a
    There b
b -> Int
salt Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
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 a -> ()
f b -> ()
g = \case
    Wedge a b
Nowhere -> ()
    Here a
a -> a -> ()
f a
a
    There 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 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 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 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"

instance Semigroup a => MonadZip (Wedge a) where
  mzipWith :: (a -> b -> c) -> Wedge a a -> Wedge a b -> Wedge a c
mzipWith a -> b -> c
f Wedge a a
a 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
  Wedge a a
Nowhere <|> :: Wedge a a -> Wedge a a -> Wedge a a
<|> Wedge a a
c = Wedge a a
c
  Wedge a a
c <|> Wedge a a
Nowhere = Wedge a a
c
  Here a
a <|> Here 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 a
_ <|> There a
b = a -> Wedge a a
forall a b. b -> Wedge a b
There a
b
  There a
a <|> Here a
_ = a -> Wedge a a
forall a b. b -> Wedge a b
There a
a
  There a
_ <|> There 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 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