| Copyright | (c) Justin Le 2019 |
|---|---|
| License | BSD3 |
| Maintainer | justin@jle.im |
| Stability | experimental |
| Portability | non-portable |
| Safe Haskell | None |
| Language | Haskell2010 |
Data.HBifunctor.Tensor
Description
This module provides tools for working with binary functor combinators.
Data.Functor.HFunctor deals with single functor combinators (transforming a single functor). This module provides tools for working with combinators that combine and mix two functors "together".
The binary analog of HFunctor is HBifunctor: we can map
a structure-transforming function over both of the transformed functors.
The binary analog of Interpret is Monoidal (and Tensor). If your
combinator is an instance of Monoidal, it means that you can "squish"
both arguments together into an Interpret. For example:
toMF:: (f:*:f) a ->ListFf atoMF::Compf f a ->Freef atoMF::Dayf f a ->Apf a
Synopsis
- class Associative t => Tensor t where
- rightIdentity :: (Tensor t, Functor f) => f <~> t f (I t)
- leftIdentity :: (Tensor t, Functor g) => g <~> t (I t) g
- sumLeftIdentity :: f <~> (V1 :+: f)
- sumRightIdentity :: f <~> (f :+: V1)
- prodLeftIdentity :: f <~> (Proxy :*: f)
- prodRightIdentity :: g <~> (g :*: Proxy)
- class (Tensor t, Semigroupoidal t, Interpret (MF t)) => Monoidal t where
- type CM t = C (MF t)
- nilMF :: forall t f. Monoidal t => I t ~> MF t f
- consMF :: Monoidal t => t f (MF t f) ~> MF t f
- unconsMF :: Monoidal t => MF t f ~> (I t :+: t f (MF t f))
- inL :: forall t f g. (Monoidal t, CM t g) => f ~> t f g
- inR :: forall t f g. (Monoidal t, CM t f) => g ~> t f g
- outL :: (Tensor t, I t ~ Proxy, Functor f) => t f g ~> f
- outR :: (Tensor t, I t ~ Proxy, Functor g) => t f g ~> g
- biretractT :: forall t f. (Monoidal t, CM t f) => t f f ~> f
- binterpretT :: forall t f g h. (Monoidal t, CM t h) => (f ~> h) -> (g ~> h) -> t f g ~> h
- prodOutL :: (f :*: g) ~> f
- prodOutR :: (f :*: g) ~> g
- class Monoidal t => Matchable t where
- splittingSF :: Matchable t => SF t f <~> t f (MF t f)
- matchingMF :: forall t f. Matchable t => MF t f <~> (I t :+: SF t f)
Tensor
class Associative t => Tensor t where Source #
An Associative HBifunctor can be a Tensor if there is some
identity i where t i f is equivalent to just f.
That is, "enhancing" f with t i does nothing.
The methods in this class provide us useful ways of navigating
a with respect to this property.Tensor t
The Tensor is essentially the HBifunctor equivalent of Inject,
with intro1 and intro2 taking the place of inject.
Associated Types
type I t :: Type -> Type Source #
The identity of . If you "combine" Tensor tf with the
identity, it leaves f unchanged.
For example, the identity of :*: is Proxy. This is because
(Proxy :*: f) a
is equivalent to just
f a
:*:-ing f with Proxy gives you no additional structure.
Another example:
(V1:+:f) a
is equivalent to just
f a
because the L1 case is unconstructable.
Methods
intro1 :: f ~> t f (I t) Source #
Because t f (I t) is equivalent to f, we can always "insert"
f into t f (I t).
This is analogous to inject from Inject, but for HBifunctors.
intro2 :: g ~> t (I t) g Source #
Because t (I t) g is equivalent to f, we can always "insert"
g into t (I t) g.
This is analogous to inject from Inject, but for HBifunctors.
Instances
| Tensor Day Source # | |
| Tensor These1 Source # | |
| Tensor Comp Source # | |
| Tensor ((:+:) :: (Type -> Type) -> (Type -> Type) -> Type -> Type) Source # | |
| Tensor ((:*:) :: (Type -> Type) -> (Type -> Type) -> Type -> Type) Source # | |
| Tensor (Product :: (Type -> Type) -> (Type -> Type) -> Type -> Type) Source # | |
Defined in Data.HBifunctor.Tensor | |
| Tensor (Sum :: (Type -> Type) -> (Type -> Type) -> Type -> Type) Source # | |
sumLeftIdentity :: f <~> (V1 :+: f) Source #
leftIdentity (intro1 and elim1) for :+: actually does not
require Functor. This is the more general version.
sumRightIdentity :: f <~> (f :+: V1) Source #
rightIdentity (intro2 and elim2) for :+: actually does not
require Functor. This is the more general version.
prodLeftIdentity :: f <~> (Proxy :*: f) Source #
leftIdentity (intro1 and elim1) for :*: actually does not
require Functor. This is the more general version.
prodRightIdentity :: g <~> (g :*: Proxy) Source #
rightIdentity (intro2 and elim2) for :*: actually does not
require Functor. This is the more general version.
Monoidal
class (Tensor t, Semigroupoidal t, Interpret (MF t)) => Monoidal t where Source #
A is a Monoidal tSemigroupoidal, in that it provides some type
that is equivalent to one of:MF t f
I a-- 0 timesf a-- 1 timet f f a-- 2 timest f (t f f) a-- 3 timest f (t f (t f f)) a-- 4 timest f (t f (t f (t f f))) a-- 5 times- .. etc
The difference is that unlike , SF t has the "zero times"
value.MF t
This typeclass lets you use a type like ListF in terms of repeated
applications of :*:, or Ap in terms of repeated applications of
Day, or Free in terms of repeated applications of Comp, etc.
For example, f can be interpreted as "a free selection of two
:*: ffs", allowing you to specify "I have to fs that I can use". If you
want to specify "I want 0, 1, or many different fs that I can use",
you can use .ListF f
At the high level, the thing that Monoidal adds to Semigroupoidal
is inL, inR, and nilMF:
inL:: f a -> t f g ainR:: g a -> t f g anilMF:: I a -> MF t f a
which are like the HBifunctor versions of inject: it lets you inject
an f into t f g, so you can start doing useful mixing operations
with it. nilMF lets you construct an "empty" .MF t
Also useful is:
toMF :: t f f a -> MF t f a
Which converts a t into its aggregate type MF
Minimal complete definition
Associated Types
type MF t :: (Type -> Type) -> Type -> Type Source #
The "monoidal functor combinator" induced by t.
A value of type MF t f a is equivalent to one of:
I a-- zero fsf a-- one ft f f a-- two fst f (t f f) a-- three fst f (t f (t f f)) a
t f (t f (t f (t f f))) a
- .. etc
For example, for :*:, we have ListF. This is because:
Proxy~ListF[] ~nilMF@(:*:) x ~ ListF [x] ~injectx x :*: y ~ ListF [x,y] ~toMF(x :*: y) x :*: y :*: z ~ ListF [x,y,z] -- etc.
You can create an "empty" one with nilMF, a "singleton" one with
inject, or else one from a single t f f with toMF.
Methods
appendMF :: t (MF t f) (MF t f) ~> MF t f Source #
If a represents multiple applications of MF t ft f to
itself, then we can also "append" two s applied to
themselves into one giant MF t f containing all of the MF t ft fs.
splitSF :: SF t f ~> t f (MF t f) Source #
Lets you convert an into a single application of SF t ff to
.MF t f
Analogous to a function NonEmpty a -> (a,
[a])
Note that this is not reversible in general unless we have
.Matchable t
splittingMF :: MF t f <~> (I t :+: t f (MF t f)) Source #
An is either empty, or a single application of MF t ft to f
and MF t f (the "head" and "tail"). This witnesses that
isomorphism.
toMF :: t f f ~> MF t f Source #
Embed a direct application of f to itself into a .MF t f
fromSF :: SF t f ~> MF t f Source #
is "one or more SF t ffs", and 'MF t f is "zero or more
fs". This function lets us convert from one to the other.
This is analogous to a function .NonEmpty a ->
[a]
Note that because t is not inferrable from the input or output
type, you should call this using -XTypeApplications:
fromSF@(:*:) ::NonEmptyFf a ->ListFf a fromSF @Comp::Free1f a ->Freef a
pureT :: CM t f => I t ~> f Source #
If we have an , we can generate an I tf based on how it
interacts with t.
Specialized (and simplified), this type is:
pureT@Day::Applicativef =>Identitya -> f a --purepureT @Comp::Monadf => Identity a -> f a --returnpureT @(:*:) ::Plusf =>Proxya -> f a --zero
Note that because t appears nowhere in the input or output types,
you must always use this with explicit type application syntax (like
pureT @Day)
upgradeC :: CM t f => proxy f -> (CS t f => r) -> r Source #
If we have a constraint on the Monoidal satisfied, it should
also imply the constraint on the Semigroupoidal.
This is basically saying that should be a superclass
of C (SF t).C (MF t)
For example, for :*:, this type signature says that Alt is
a superclass of Plus, so whenever you have Plus, you should
always also have Alt.
For Day, this type signature says that Apply is a superclass of
Applicative, so whenever you have Applicative, you should always
also have Apply.
This is necessary because in the current class hierarchy, Apply
isn't a true superclass of Applicative. upgradeC basically
"imbues" f with an Apply instance based on its Applicative
instance, so things can be easier to use.
For example, let's say I have a type Parser that is an
Applicative instance, but the source library does not define an
Apply instance. I cannot use biretract or binterpret with it,
even though I should be able to, because they require Apply.
That is:
biretract::DayParser Parser a -> Parser a
is a type error, because it requires .Apply Parser
But, if we know that Parser has an Applicative instance, we can
use:
upgradeC@Day(Proxy@Parser)biretract:: Day Parser Parser a -> a
and this will now typecheck properly.
Ideally, Parser would also have an Apply instance. But we
cannot control this if an external library defines Parser.
(Alternatively you can just use biretractT.)
Note that you should only use this if f doesn't already have the
SF constraint. If it does, this could lead to conflicting
instances. Only use this with specific, concrete fs. Otherwise
this is unsafe and can possibly break coherence guarantees.
The proxy argument can be provided using something like , to specify which Proxy
@ff you want to upgrade.
Instances
nilMF :: forall t f. Monoidal t => I t ~> MF t f Source #
Create the "empty MF@.
If represents multiple applications of MF t ft f with
itself, then nilMF gives us "zero applications of f".
Note that t cannot be inferred from the input or output type of
nilMF, so this function must always be called with -XTypeApplications:
nilMF@Day::Identity~>Apf nilMF @Comp:: Identity ~>Freef nilMF @(:*:) ::Proxy~>ListFf
consMF :: Monoidal t => t f (MF t f) ~> MF t f Source #
Lets us "cons" an application of f to the front of an .MF t f
Utility
inL :: forall t f g. (Monoidal t, CM t g) => f ~> t f g Source #
Convenient wrapper over intro1 that lets us introduce an arbitrary
functor g to the right of an f.
You can think of this as an HBifunctor analogue of inject.
inR :: forall t f g. (Monoidal t, CM t f) => g ~> t f g Source #
Convenient wrapper over intro2 that lets us introduce an arbitrary
functor f to the right of a g.
You can think of this as an HBifunctor analogue of inject.
biretractT :: forall t f. (Monoidal t, CM t f) => t f f ~> f Source #
This is biretract, but taking a constraint instead of
a C (MF t) constraint. For example, for C (SF t)Day, it takes an
Applicative constraint instead of an Apply constraint.
In an ideal world, this would be not necessary, and we can use
biretract. However, sometimes is not an actual
subclass of C (MF t) (like C (SF t)Apply and Applicative), even though
it should technically always be so.
Note that you should only use this if f doesn't already have the SF
constraint (for example, for Day, if f already has an Apply
instance). If it does, this could lead to conflicting instances. If
f already has the SF instance, just use biretract directly. Only
use this with specific, concrete fs.
binterpretT :: forall t f g h. (Monoidal t, CM t h) => (f ~> h) -> (g ~> h) -> t f g ~> h Source #
This is binterpret, but taking a constraint instead of
a C (MF t) constraint. For example, for C (SF t)Day, it takes an
Applicative constraint instead of an Apply constraint.
In an ideal world, this would be not necessary, and we can use
biretract. However, sometimes is not an actual
subclass of C (MF t) (like C (SF t)Apply and Applicative), even though
it should technically always be so.
Note that you should only use this if f doesn't already have the SF
constraint (for example, for Day, if f already has an Apply
instance). If it does, this could lead to conflicting instances. If
f already has the SF instance, just use biretract directly. Only
use this with specific, concrete fs.
Matchable
class Monoidal t => Matchable t where Source #
For some t, we have the ability to "statically analyze" the
and pattern match and manipulate the structure without ever
interpreting or retracting. These are MF tMatchable.
Methods
unsplitSF :: t f (MF t f) ~> SF t f Source #
The inverse of splitSF. A consing of f to is
non-empty, so it can be represented as an MF t f.SF t f
This is analogous to a function .uncurry (:|)
:: (a, [a]) -> NonEmpty a
matchMF :: MF t f ~> (I t :+: SF t f) Source #
"Pattern match" on an : it is either empty, or it is
non-empty (and so can be an MF t f).SF t f
This is analgous to a function .nonEmpty :: [a]
-> Maybe (NonEmpty a)
Note that because t cannot be inferred from the input or output
type, you should use this with -XTypeApplications:
matchMF@Day::Apf a -> (Identity:+:Ap1f) a
Instances
| Matchable Day Source # | |
| Matchable ((:+:) :: (Type -> Type) -> (Type -> Type) -> Type -> Type) Source # | |
| Matchable ((:*:) :: (Type -> Type) -> (Type -> Type) -> Type -> Type) Source # | |
| Matchable (Product :: (Type -> Type) -> (Type -> Type) -> Type -> Type) Source # | |
| Matchable (Sum :: (Type -> Type) -> (Type -> Type) -> Type -> Type) Source # | |