Safe Haskell | None |
---|---|
Language | Haskell98 |
Synopsis
- class (Applicative f, Applicative g) => Idiom tag f g where
- data Id
- data Comp tag1 tag2
- data Initial
- data Terminal
- data Inner
- data Outer
- type family CheckIdiomDup f where ...
- data Dup
- class (CheckIdiomDup g ~ tag, Applicative f, Applicative g) => IdiomDup tag f g where
- data tag1 &&& tag2
- data Fst
- data Snd
Documentation
class (Applicative f, Applicative g) => Idiom tag f g where Source #
An Idiom
captures an "applicative homomorphism" between two
applicatives, indexed by a tag
.
An appliative homomorphism is a polymorphic function between two
applicative functors that preserves the Applicative
structure.
idiom (pure a) = pure a idiom (liftA2 (·) as bs) = liftA2 (·) (idiom as) (idiom bs)
Based on: Abstracting with Applicatives.
Instances
The identity applicative morphism.
idiom :: f ~> f idiom = id
Instances
(Applicative f, f ~ g) => Idiom Id f g Source # | |
Defined in Generic.Applicative.Idiom |
The left-to-right composition of applicative morphisms.
The initial applicative morphism.
It turns Identity
into any Applicative
functor.
idiom :: Identity ~> f idiom (Identity a) = pure a
The terminal applicative morphism.
It turns any applicative into
, or Const
mProxy
idiom :: f ~> Const m idiom _ = Const mempty idiom :: f ~> Proxy idiom _ = Proxy
Instances
This applicative morphism composes a functor on the _inside_.
idiom :: f ~> Compose f inner idiom = Compose . fmap pure
Instances
(Applicative f, Applicative inner, comp ~ Compose f inner) => Idiom Inner f comp Source # | |
Defined in Generic.Applicative.Idiom |
This applicative morphism composes a functor on the _outside_.
idiom :: f ~> Compose outer f idiom = Compose . pure
Instances
(Applicative outer, Applicative f, comp ~ Compose outer f) => Idiom Outer f comp Source # | |
Defined in Generic.Applicative.Idiom |
type family CheckIdiomDup f where ... Source #
CheckIdiomDup (Product _ _) = 'True | |
CheckIdiomDup _ = 'False |
This applicative morphism duplicates a functor any number of times.
idiom :: f ~> f idiom = id idiom :: f ~> Product f f idiom as = Pair as as idiom :: f ~> Product f (Product f f) idiom as = Pair as (Pair as as)
Instances
(Applicative f, Applicative g, IdiomDup (CheckIdiomDup g) f g) => Idiom Dup f g Source # | |
Defined in Generic.Applicative.Idiom |
class (CheckIdiomDup g ~ tag, Applicative f, Applicative g) => IdiomDup tag f g where Source #
Nothing
Instances
(Applicative f, CheckIdiomDup f ~ 'False, f ~ f') => IdiomDup 'False f f' Source # | |
Defined in Generic.Applicative.Idiom | |
(f ~ g, IdiomDup (CheckIdiomDup g') g g') => IdiomDup 'True f (Product g g') Source # | |
An applicative functor for constructing a product.
idiom :: f ~> Product g h idiom as = Pair (idiom as) (idiom as)
The applicative functor that gets the first component of a product.
idiom :: Product f g ~> f idiom (Pair as _) = as
Instances
(Applicative f, Applicative g) => Idiom Fst (Product f g) f Source # | |