Copyright | (c) 2020-2021 Emily Pillmore |
---|---|
License | BSD-3-Clause |
Maintainer | Emily Pillmore <emilypi@cohomolo.gy> |
Stability | Experimental |
Portability | CPP, RankNTypes, TypeApplications |
Safe Haskell | Safe |
Language | Haskell2010 |
Synopsis
- data Wedge a b
- type (∨) a b = Wedge a b
- quotWedge :: Either (Maybe a) (Maybe b) -> Wedge a b
- wedgeLeft :: Maybe a -> Wedge a b
- wedgeRight :: Maybe b -> Wedge a b
- fromWedge :: Wedge a b -> Maybe (Either a b)
- toWedge :: Maybe (Either a b) -> Wedge a b
- isHere :: Wedge a b -> Bool
- isThere :: Wedge a b -> Bool
- isNowhere :: Wedge a b -> Bool
- wedge :: c -> (a -> c) -> (b -> c) -> Wedge a b -> c
- heres :: Foldable f => f (Wedge a b) -> [a]
- theres :: Foldable f => f (Wedge a b) -> [b]
- filterHeres :: Foldable f => f (Wedge a b) -> [Wedge a b]
- filterTheres :: Foldable f => f (Wedge a b) -> [Wedge a b]
- filterNowheres :: Foldable f => f (Wedge a b) -> [Wedge a b]
- foldHeres :: Foldable f => (a -> m -> m) -> m -> f (Wedge a b) -> m
- foldTheres :: Foldable f => (b -> m -> m) -> m -> f (Wedge a b) -> m
- gatherWedges :: Wedge [a] [b] -> [Wedge a b]
- unfoldr :: Alternative f => (b -> Wedge a b) -> b -> f a
- unfoldrM :: (Monad m, Alternative f) => (b -> m (Wedge a b)) -> b -> m (f a)
- iterateUntil :: Alternative f => (b -> Wedge a b) -> b -> f a
- iterateUntilM :: Monad m => Alternative f => (b -> m (Wedge a b)) -> b -> m (f a)
- accumUntil :: Alternative f => Monoid b => (b -> Wedge a b) -> f a
- accumUntilM :: Monad m => Alternative f => Monoid b => (b -> m (Wedge a b)) -> m (f a)
- partitionWedges :: Alternative f => Foldable t => t (Wedge a b) -> (f a, f b)
- mapWedges :: Traversable t => Alternative f => (a -> Wedge b c) -> t a -> (f b, f c)
- eqWedge :: Equivalence (Wedge a b)
- distributeWedge :: Wedge (a, b) c -> (Wedge a c, Wedge b c)
- codistributeWedge :: Either (Wedge a c) (Wedge b c) -> Wedge (Either a b) c
- reassocLR :: Wedge (Wedge a b) c -> Wedge a (Wedge b c)
- reassocRL :: Wedge a (Wedge b c) -> Wedge (Wedge a b) c
- swapWedge :: Wedge a b -> Wedge b a
Datatypes
Categorically, the Wedge
datatype represents the coproduct (like, Either
)
in the category Hask* of pointed Hask types, called a 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
. Because we can conflate
basepoints of different types (there is only one Maybe
aNothing
type), the wedge sum
can be viewed as the type 1 + a + b
, or
in Hask.Maybe
(Either
a b)
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)
Instances
Bitraversable Wedge Source # | |
Defined in Data.Wedge bitraverse :: Applicative f => (a -> f c) -> (b -> f d) -> Wedge a b -> f (Wedge c d) # | |
Bifoldable Wedge Source # | |
Bifunctor Wedge Source # | |
Eq2 Wedge Source # | |
Ord2 Wedge Source # | |
Defined in Data.Wedge | |
Read2 Wedge Source # | |
Defined in Data.Wedge liftReadsPrec2 :: (Int -> ReadS a) -> ReadS [a] -> (Int -> ReadS b) -> ReadS [b] -> Int -> ReadS (Wedge a b) # liftReadList2 :: (Int -> ReadS a) -> ReadS [a] -> (Int -> ReadS b) -> ReadS [b] -> ReadS [Wedge a b] # liftReadPrec2 :: ReadPrec a -> ReadPrec [a] -> ReadPrec b -> ReadPrec [b] -> ReadPrec (Wedge a b) # liftReadListPrec2 :: ReadPrec a -> ReadPrec [a] -> ReadPrec b -> ReadPrec [b] -> ReadPrec [Wedge a b] # | |
Show2 Wedge Source # | |
NFData2 Wedge Source # | |
Defined in Data.Wedge | |
Hashable2 Wedge Source # | |
Defined in Data.Wedge | |
(Lift a, Lift b) => Lift (Wedge a b :: Type) Source # | |
Monad (Wedge a) Source # | |
Functor (Wedge a) Source # | |
Applicative (Wedge a) Source # | |
Foldable (Wedge a) Source # | |
Defined in Data.Wedge fold :: Monoid m => Wedge a m -> m # foldMap :: Monoid m => (a0 -> m) -> Wedge a a0 -> m # foldMap' :: Monoid m => (a0 -> m) -> Wedge a a0 -> m # foldr :: (a0 -> b -> b) -> b -> Wedge a a0 -> b # foldr' :: (a0 -> b -> b) -> b -> Wedge a a0 -> b # foldl :: (b -> a0 -> b) -> b -> Wedge a a0 -> b # foldl' :: (b -> a0 -> b) -> b -> Wedge a a0 -> b # foldr1 :: (a0 -> a0 -> a0) -> Wedge a a0 -> a0 # foldl1 :: (a0 -> a0 -> a0) -> Wedge a a0 -> a0 # toList :: Wedge a a0 -> [a0] # elem :: Eq a0 => a0 -> Wedge a a0 -> Bool # maximum :: Ord a0 => Wedge a a0 -> a0 # minimum :: Ord a0 => Wedge a a0 -> a0 # | |
Traversable (Wedge a) Source # | |
Eq a => Eq1 (Wedge a) Source # | |
Ord a => Ord1 (Wedge a) Source # | |
Defined in Data.Wedge | |
Read a => Read1 (Wedge a) Source # | |
Defined in Data.Wedge | |
Show a => Show1 (Wedge a) Source # | |
Semigroup a => MonadZip (Wedge a) Source # | |
Monoid a => Alternative (Wedge a) Source # | |
Monoid a => MonadPlus (Wedge a) Source # | |
NFData a => NFData1 (Wedge a) Source # | |
Defined in Data.Wedge | |
Hashable a => Hashable1 (Wedge a) Source # | |
Defined in Data.Wedge | |
Generic1 (Wedge a :: Type -> Type) Source # | |
(Eq a, Eq b) => Eq (Wedge a b) Source # | |
(Data a, Data b) => Data (Wedge a b) Source # | |
Defined in Data.Wedge gfoldl :: (forall d b0. Data d => c (d -> b0) -> d -> c b0) -> (forall g. g -> c g) -> Wedge a b -> c (Wedge a b) # gunfold :: (forall b0 r. Data b0 => c (b0 -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (Wedge a b) # toConstr :: Wedge a b -> Constr # dataTypeOf :: Wedge a b -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (Wedge a b)) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Wedge a b)) # gmapT :: (forall b0. Data b0 => b0 -> b0) -> Wedge a b -> Wedge a b # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Wedge a b -> r # gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Wedge a b -> r # gmapQ :: (forall d. Data d => d -> u) -> Wedge a b -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Wedge a b -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Wedge a b -> m (Wedge a b) # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Wedge a b -> m (Wedge a b) # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Wedge a b -> m (Wedge a b) # | |
(Ord a, Ord b) => Ord (Wedge a b) Source # | |
Defined in Data.Wedge | |
(Read a, Read b) => Read (Wedge a b) Source # | |
(Show a, Show b) => Show (Wedge a b) Source # | |
Generic (Wedge a b) Source # | |
(Semigroup a, Semigroup b) => Semigroup (Wedge a b) Source # | |
(Semigroup a, Semigroup b) => Monoid (Wedge a b) Source # | |
(Binary a, Binary b) => Binary (Wedge a b) Source # | |
(NFData a, NFData b) => NFData (Wedge a b) Source # | |
Defined in Data.Wedge | |
(Hashable a, Hashable b) => Hashable (Wedge a b) Source # | |
Defined in Data.Wedge | |
type Rep1 (Wedge a :: Type -> Type) Source # | |
Defined in Data.Wedge type Rep1 (Wedge a :: Type -> Type) = D1 ('MetaData "Wedge" "Data.Wedge" "smash-0.1.3-E12XAymy47740sYMP7bPqd" 'False) (C1 ('MetaCons "Nowhere" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "Here" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 a)) :+: C1 ('MetaCons "There" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) Par1))) | |
type Rep (Wedge a b) Source # | |
Defined in Data.Wedge type Rep (Wedge a b) = D1 ('MetaData "Wedge" "Data.Wedge" "smash-0.1.3-E12XAymy47740sYMP7bPqd" 'False) (C1 ('MetaCons "Nowhere" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "Here" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 a)) :+: C1 ('MetaCons "There" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 b)))) |
Type synonyms
Combinators
wedgeRight :: Maybe b -> Wedge a b Source #
Eliminators
wedge :: c -> (a -> c) -> (b -> c) -> Wedge a b -> c Source #
Case elimination for the Wedge
datatype.
Filtering
Folding and Unfolding
foldTheres :: Foldable f => (b -> m -> m) -> m -> f (Wedge a b) -> m Source #
gatherWedges :: Wedge [a] [b] -> [Wedge a b] Source #
unfoldr :: Alternative f => (b -> Wedge a b) -> b -> f a Source #
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
.
unfoldrM :: (Monad m, Alternative f) => (b -> m (Wedge a b)) -> b -> m (f a) Source #
Unfold from right to left into a monadic computation over a wedge product
iterateUntil :: Alternative f => (b -> Wedge a b) -> b -> f a Source #
Iterate on a seed, accumulating a result. See iterateUntilM
for
more details.
iterateUntilM :: Monad m => Alternative f => (b -> m (Wedge a b)) -> b -> m (f a) Source #
Iterate on a seed, which may result in one of three scenarios:
- The function yields a
Nowhere
value, which terminates the iteration. - The function yields a
Here
value. - The function yields a
There
value, which changes the seed and iteration continues with the new seed.
accumUntil :: Alternative f => Monoid b => (b -> Wedge a b) -> f a Source #
Iterate on a seed, accumulating values and monoidally updating the seed with each update.
accumUntilM :: Monad m => Alternative f => Monoid b => (b -> m (Wedge a b)) -> m (f a) Source #
Iterate on a seed, accumulating values and monoidally updating a seed within a monad.
Partitioning
partitionWedges :: Alternative f => Foldable t => t (Wedge a b) -> (f a, f b) Source #
mapWedges :: Traversable t => Alternative f => (a -> Wedge b c) -> t a -> (f b, f c) Source #
eqWedge :: Equivalence (Wedge a b) Source #
Equivalence relation formed by grouping of equal Wedge
constructors.
Distributivity
distributeWedge :: Wedge (a, b) c -> (Wedge a c, Wedge b c) Source #
Distribute a Wedge
over a product.
codistributeWedge :: Either (Wedge a c) (Wedge b c) -> Wedge (Either a b) c Source #
Codistribute Wedge
s over a coproduct.