invertible-0.2.0: bidirectional arrows, bijective functions, and invariant functors

Safe HaskellSafe
LanguageHaskell2010

Control.Invertible.Monoidal

Contents

Description

Invariant monoidal functors.

This roughly corresponds to Control.Applicative, but exposes a non-overlapping API so can be imported unqualified. It does, however, use operators similar to those provided by contravariant.

Synopsis

Documentation

data Bijection a b c Source #

A representation of a bidirectional arrow (embedding-projection pair of arrows transformer): an arrow and its inverse. Most uses will prefer the specialized <-> type for function arrows.

To constitute a valid bijection, biTo and biFrom should be inverses:

  • biTo . biFrom = id
  • biFrom . biTo = id

It may be argued that the arguments should be in the opposite order due to the arrow syntax, but it makes more sense to me to have the forward function come first.

Constructors

(:<->:) infix 2 

Fields

Instances

Category * a => Category * (Bijection a) Source # 

Methods

id :: cat a a #

(.) :: cat b c -> cat a b -> cat a c #

Semigroupoid * a => Groupoid * (Bijection a) Source # 

Methods

inv :: k1 a b -> k1 b a #

Semigroupoid * a => Semigroupoid * (Bijection a) Source # 

Methods

o :: c j k1 -> c i j -> c i k1 #

Arrow a => Arrow (Bijection a) Source #

In order to use all the Arrow functions, we make a partially broken instance, where arr creates a bijection with a broken biFrom. See note on BiArrow'. &&& is first-biased, and uses only the left argument's biFrom.

Methods

arr :: (b -> c) -> Bijection a b c #

first :: Bijection a b c -> Bijection a (b, d) (c, d) #

second :: Bijection a b c -> Bijection a (d, b) (d, c) #

(***) :: Bijection a b c -> Bijection a b' c' -> Bijection a (b, b') (c, c') #

(&&&) :: Bijection a b c -> Bijection a b c' -> Bijection a b (c, c') #

ArrowChoice a => ArrowChoice (Bijection a) Source #

||| is Left-biased, and uses only the left argument's biFrom.

Methods

left :: Bijection a b c -> Bijection a (Either b d) (Either c d) #

right :: Bijection a b c -> Bijection a (Either d b) (Either d c) #

(+++) :: Bijection a b c -> Bijection a b' c' -> Bijection a (Either b b') (Either c c') #

(|||) :: Bijection a b d -> Bijection a c d -> Bijection a (Either b c) d #

ArrowZero a => ArrowZero (Bijection a) Source # 

Methods

zeroArrow :: Bijection a b c #

Invariant2 (Bijection (->)) Source # 

Methods

invmap2 :: (a -> c) -> (c -> a) -> (b -> d) -> (d -> b) -> Bijection (->) a b -> Bijection (->) c d #

(Semigroupoid * a, Arrow a) => BiArrow' (Bijection a) Source # 
(Semigroupoid * a, Arrow a) => BiArrow (Bijection a) Source # 

Methods

(<->) :: (b -> c) -> (c -> b) -> Bijection a b c Source #

invert :: Bijection a b c -> Bijection a c b Source #

Monad m => Arrow (MonadArrow (<->) m) # 

Methods

arr :: (b -> c) -> MonadArrow (<->) m b c #

first :: MonadArrow (<->) m b c -> MonadArrow (<->) m (b, d) (c, d) #

second :: MonadArrow (<->) m b c -> MonadArrow (<->) m (d, b) (d, c) #

(***) :: MonadArrow (<->) m b c -> MonadArrow (<->) m b' c' -> MonadArrow (<->) m (b, b') (c, c') #

(&&&) :: MonadArrow (<->) m b c -> MonadArrow (<->) m b c' -> MonadArrow (<->) m b (c, c') #

Monad m => ArrowChoice (MonadArrow (<->) m) # 

Methods

left :: MonadArrow (<->) m b c -> MonadArrow (<->) m (Either b d) (Either c d) #

right :: MonadArrow (<->) m b c -> MonadArrow (<->) m (Either d b) (Either d c) #

(+++) :: MonadArrow (<->) m b c -> MonadArrow (<->) m b' c' -> MonadArrow (<->) m (Either b b') (Either c c') #

(|||) :: MonadArrow (<->) m b d -> MonadArrow (<->) m c d -> MonadArrow (<->) m (Either b c) d #

MonadPlus m => ArrowZero (MonadArrow (<->) m) # 

Methods

zeroArrow :: MonadArrow (<->) m b c #

MonadPlus m => ArrowPlus (MonadArrow (<->) m) # 

Methods

(<+>) :: MonadArrow (<->) m b c -> MonadArrow (<->) m b c -> MonadArrow (<->) m b c #

Invariant (Bijection (->) b) Source # 

Methods

invmap :: (a -> b) -> (b -> a) -> Bijection (->) b a -> Bijection (->) b b #

Monad m => BiArrow' (MonadArrow (<->) m) Source # 
(Semigroupoid * a, Arrow a) => Functor (Bijection a b) Source # 

Methods

fmap :: (a <-> b) -> Bijection a b a -> Bijection a b b Source #

Monoidal (Bijection (->) ()) Source # 

Methods

unit :: Bijection (->) () () Source #

(>*<) :: Bijection (->) () a -> Bijection (->) () b -> Bijection (->) () (a, b) Source #

biCase :: QuasiQuoter Source #

Construct an expression representing a function bijection based on a set of newline- or semicolon-separated cases. Each case should be two pattern-expressions separated by -. Each pattern-expression is a haskell pattern that can also be interpreted as an expression. You can think of these as symmetric or bidirectional case expressions. The result will be a bijection that is the combination of two lambdas, one with the cases intepreted forward, and one reverse. For example:

newtype T a = C a
biC :: T a <-> a
biC = [biCase| C a <-> a |]
isJust :: Maybe () <-> Bool
isJust = [biCase|
    Just () <-> True
    Nothing <-> False
  |]

Functor

(>$<) :: Functor f => (a <-> b) -> f a -> f b infixl 4 Source #

Another synonym for fmap to match other operators in this module.

(>$) :: Functor f => a -> f a -> f () infixl 4 Source #

Given a value an an invariant for that value, always provide that value and ignore the produced value. fmap . flip consts ()

($<) :: Functor f => f a -> a -> f () infixl 4 Source #

flip (>$)

Monoidal

class Functor f => Monoidal f where Source #

Invariant monoidal functor. This roughly corresponds to Applicative, which, for covariant functors, is equivalent to a monoidal functor. Invariant functors, however, may admit a monoidal instance but not applicative.

Minimal complete definition

unit, (>*<)

Methods

unit :: f () Source #

Lift a unit value, analogous to pure () (but also like const ()).

(>*<) :: f a -> f b -> f (a, b) infixl 4 Source #

Merge two functors into a tuple, analogous to liftA2 (,). (Sometimes known as **.)

Instances

Monoidal m => Monoidal (MaybeT m) Source # 

Methods

unit :: MaybeT m () Source #

(>*<) :: MaybeT m a -> MaybeT m b -> MaybeT m (a, b) Source #

Monoidal (Free f) Source # 

Methods

unit :: Free f () Source #

(>*<) :: Free f a -> Free f b -> Free f (a, b) Source #

Monoidal (Bijection (->) ()) Source # 

Methods

unit :: Bijection (->) () () Source #

(>*<) :: Bijection (->) () a -> Bijection (->) () b -> Bijection (->) () (a, b) Source #

unitDefault :: Applicative f => f () Source #

Default unit implementation for non-invertible Applicatives.

pairADefault :: Applicative f => f a -> f b -> f (a, b) Source #

Default '>*< implementation for non-invertible Applicatives.

(>*) :: Monoidal f => f a -> f () -> f a infixl 4 Source #

Sequence actions, discarding/inhabiting the unit value of the second argument.

(*<) :: Monoidal f => f () -> f a -> f a infixl 4 Source #

Sequence actions, discarding/inhabiting the unit value of the first argument.

Tuple combinators

liftI2 :: Monoidal f => ((a, b) <-> c) -> f a -> f b -> f c Source #

Lift an (uncurried) bijection into a monoidal functor.

liftI3 :: Monoidal f => ((a, b, c) <-> d) -> f a -> f b -> f c -> f d Source #

liftI4 :: Monoidal f => ((a, b, c, d) <-> e) -> f a -> f b -> f c -> f d -> f e Source #

liftI5 :: Monoidal f => ((a, b, c, d, e) <-> g) -> f a -> f b -> f c -> f d -> f e -> f g Source #

(>*<<) :: Monoidal f => f a -> f (b, c) -> f (a, b, c) infixr 3 Source #

(>*<<<) :: Monoidal f => f a -> f (b, c, d) -> f (a, b, c, d) infixr 3 Source #

(>*<<<<) :: Monoidal f => f a -> f (b, c, d, e) -> f (a, b, c, d, e) infixr 3 Source #

(>>*<) :: Monoidal f => f (a, b) -> f c -> f (a, b, c) infixl 4 Source #

(>>>*<) :: Monoidal f => f (a, b, c) -> f d -> f (a, b, c, d) infixl 4 Source #

(>>>>*<) :: Monoidal f => f (a, b, c, d) -> f e -> f (a, b, c, d, e) infixl 4 Source #

(>>*<<) :: Monoidal f => f (a, b) -> f (c, d) -> f (a, b, c, d) infix 3 Source #

pureI :: Monoidal f => a -> f a Source #

A constant monoidal (like pure), which always produces the same value and ignores everything.

constI :: Monoidal f => a -> f a -> f () Source #

Supply a constant value to a monoidal and ignore whatever is produced.

sequenceI_ :: (Foldable t, Monoidal f) => t (f ()) -> f () Source #

Sequence (like sequenceA_) a list of monoidals, ignoring (const ()) all the results.

mapI_ :: (Foldable t, Monoidal f) => (a -> f ()) -> t a -> f () Source #

Map each element to a monoidal and sequenceI_ the results.

forI_ :: (Foldable t, Monoidal f) => t a -> (a -> f ()) -> f () Source #

flip mapI_

sequenceMaybesI :: Monoidal f => [f (Maybe a)] -> f [a] Source #

Sequence (like sequenceA) and filter (like catMaybes) a list of monoidals, producing the list of non-Nothing values. Shorter input lists pad with Nothings and longer ones are ignored.

mapMaybeI :: Monoidal f => (a -> f (Maybe b)) -> [a] -> f [b] Source #

Map each element to a Maybe monoidal and sequence the results (like traverse and mapMaybe).

MonoidalAlt

class Monoidal f => MonoidalAlt f where Source #

Monoidal functors that allow choice.

Minimal complete definition

zero, (>|<)

Methods

zero :: f Void Source #

An always-failing (and thus impossible) value.

(>|<) :: f a -> f b -> f (Either a b) infixl 3 Source #

Associative binary choice.

Instances

Monoidal m => MonoidalAlt (MaybeT m) Source # 

Methods

zero :: MaybeT m Void Source #

(>|<) :: MaybeT m a -> MaybeT m b -> MaybeT m (Either a b) Source #

MonoidalAlt (Free f) Source # 

Methods

zero :: Free f Void Source #

(>|<) :: Free f a -> Free f b -> Free f (Either a b) Source #

eitherADefault :: Alternative f => f a -> f b -> f (Either a b) Source #

Default >|< implementation for non-invertible Alternatives.

(>|) :: MonoidalAlt f => f a -> f a -> f a infixl 3 Source #

Assymetric (and therefore probably not bijective) version of >|< that returns whichever action succeeds but always uses the left one on inputs.

(|<) :: MonoidalAlt f => f a -> f a -> f a infixl 3 Source #

Assymetric (and therefore probably not bijective) version of >|< that returns whichever action succeeds but always uses the right one on inputs.

optionalI :: MonoidalAlt f => f a -> f (Maybe a) Source #

Analogous to optional: always succeeds.

defaulting :: (MonoidalAlt f, Eq a) => a -> f a -> f a Source #

Return a default value if a monoidal functor fails, and only apply it to non-default values.

manyI :: MonoidalAlt f => f a -> f [a] Source #

Repeatedly apply a monoidal functor until it fails. Analogous to many.

msumIndex :: MonoidalAlt f => [f ()] -> f Int Source #

Try a list of monoidal actions in sequence, producing the index of the first successful action, and evaluating the action with the given index.

msumFirst :: (MonoidalAlt f, Traversable t) => t (f a) -> f a Source #

Fold a structure with >| (|<), thus always applying the input to the first (last) item for generation.

msumLast :: (MonoidalAlt f, Traversable t) => t (f a) -> f a Source #

Fold a structure with >| (|<), thus always applying the input to the first (last) item for generation.

oneOfI :: (MonoidalAlt f, Eq a) => (a -> f ()) -> [a] -> f a Source #

Take a list of items and apply them to the action in sequence until one succeeds and return the cooresponding item; match the input with the list and apply the corresponding action (or produce an error if the input is not an element of the list).

Orphan instances

Functor m => Functor (MaybeT m) Source # 

Methods

fmap :: (a <-> b) -> MaybeT m a -> MaybeT m b Source #