Copyright | (c) 2019 Edward Kmett 2019 Oleg Grenrus |
---|---|
License | BSD-2-Clause OR Apache-2.0 |
Maintainer | Oleg Grenrus <oleg.grenrus@iki.fi> |
Stability | experimental |
Portability | non-portable |
Safe Haskell | Trustworthy |
Language | Haskell2010 |
"Higher-Kinded Data" such as it is
Synopsis
- type (~>) f g = forall a. f a -> g a
- class FFunctor (t :: (k -> Type) -> Type) where
- class FContravariant (t :: (k -> Type) -> Type) where
- fcontramap :: (f ~> g) -> t g -> t f
- class FFoldable (t :: (k -> Type) -> Type) where
- ffoldMap :: Monoid m => (forall a. f a -> m) -> t f -> m
- flengthAcc :: Int -> t f -> Int
- flength :: FFoldable t => t f -> Int
- ftraverse_ :: (FFoldable t, Applicative m) => (forall a. f a -> m b) -> t f -> m ()
- ffor_ :: (FFoldable t, Applicative m) => t f -> (forall a. f a -> m b) -> m ()
- class (FFoldable t, FFunctor t) => FTraversable (t :: (k -> Type) -> Type) where
- ftraverse :: Applicative m => (forall a. f a -> m (g a)) -> t f -> m (t g)
- ffmapDefault :: FTraversable t => (f ~> g) -> t f -> t g
- ffoldMapDefault :: (FTraversable t, Monoid m) => (forall a. f a -> m) -> t f -> m
- ffor :: (FTraversable t, Applicative m) => t f -> (forall a. f a -> m (g a)) -> m (t g)
- fsequence :: (FTraversable t, Applicative f) => t f -> f (t Identity)
- gftraverse :: forall t (f :: Type -> Type) (g :: Type -> Type) m. (Applicative m, Generic (t f), Generic (t g), GFTraversable (Curried (Yoneda m)) f g (Rep (t f)) (Rep (t g))) => (forall a. f a -> m (g a)) -> t f -> m (t g)
- class FFunctor t => FZip t where
- fzipWith :: (forall x. f x -> g x -> h x) -> t f -> t g -> t h
- class FZip t => FRepeat t where
- frepeat :: (forall x. f x) -> t f
- gfzipWith :: forall t (f :: Type -> Type) (g :: Type -> Type) (h :: Type -> Type). (Generic (t f), Generic (t g), Generic (t h), GFZip f g h (Rep (t f)) (Rep (t g)) (Rep (t h))) => (forall a. f a -> g a -> h a) -> t f -> t g -> t h
- gfrepeat :: forall t (f :: Type -> Type). (Generic (t f), GFRepeat f (Rep (t f))) => (forall x. f x) -> t f
- newtype Logarithm f = Logarithm {
- runLogarithm :: forall a. f a -> a
- newtype Tab a f = Tab {}
- indexLogarithm :: f a -> Logarithm f -> a
- newtype Element a f = Element {
- runElement :: f a
- newtype NT f g = NT {}
- newtype Limit f = Limit {
- runLimit :: forall a. f a
Natural transformation
Functor
class FFunctor (t :: (k -> Type) -> Type) where Source #
Instances
Contravariant
class FContravariant (t :: (k -> Type) -> Type) where Source #
fcontramap :: (f ~> g) -> t g -> t f Source #
Instances
FContravariant (V1 :: (k -> Type) -> Type) Source # | |
FContravariant (U1 :: (k -> Type) -> Type) Source # | |
FContravariant (Proxy :: (k -> Type) -> Type) Source # | |
FContravariant (Const a :: (k -> Type) -> Type) Source # | |
(FContravariant f, FContravariant g) => FContravariant (f :+: g :: (k -> Type) -> Type) Source # | |
(FContravariant f, FContravariant g) => FContravariant (f :*: g :: (k -> Type) -> Type) Source # | |
FContravariant (K1 i a :: (k -> Type) -> Type) Source # | |
(FContravariant f, FContravariant g) => FContravariant (Sum f g :: (k -> Type) -> Type) Source # | |
(FContravariant f, FContravariant g) => FContravariant (Product f g :: (k -> Type) -> Type) Source # | |
(Functor f, FContravariant g) => FContravariant (f :.: g :: (k -> Type) -> Type) Source # | |
(Functor f, FContravariant g) => FContravariant (Compose f g :: (k -> Type) -> Type) Source # | |
FContravariant Logarithm Source # | |
Foldable
class FFoldable (t :: (k -> Type) -> Type) where Source #
ffoldMap :: Monoid m => (forall a. f a -> m) -> t f -> m Source #
flengthAcc :: Int -> t f -> Int Source #
Instances
FFoldable (Some :: (k -> Type) -> Type) Source # | |
FFoldable (Some :: (k -> Type) -> Type) Source # | |
FFoldable (Some :: (k -> Type) -> Type) Source # | |
FFoldable (U1 :: (k -> Type) -> Type) Source # | |
FFoldable (V1 :: (k -> Type) -> Type) Source # | |
FFoldable (Proxy :: (k -> Type) -> Type) Source # | |
FFoldable (Limit :: (k -> Type) -> Type) Source # | |
FFoldable (Const a :: (k -> Type) -> Type) Source # | |
FFoldable (Element a :: (k -> Type) -> Type) Source # | |
(FFoldable f, FFoldable g) => FFoldable (f :+: g :: (k -> Type) -> Type) Source # | |
(FFoldable f, FFoldable g) => FFoldable (f :*: g :: (k -> Type) -> Type) Source # | |
FFoldable (K1 i a :: (k -> Type) -> Type) Source # | |
(FFoldable f, FFoldable g) => FFoldable (Sum f g :: (k -> Type) -> Type) Source # | |
(FFoldable f, FFoldable g) => FFoldable (Product f g :: (k -> Type) -> Type) Source # | |
(Foldable f, FFoldable g) => FFoldable (f :.: g :: (k -> Type) -> Type) Source # | |
(Foldable f, FFoldable g) => FFoldable (Compose f g :: (k -> Type) -> Type) Source # | |
ftraverse_ :: (FFoldable t, Applicative m) => (forall a. f a -> m b) -> t f -> m () Source #
ffor_ :: (FFoldable t, Applicative m) => t f -> (forall a. f a -> m b) -> m () Source #
Traversable
class (FFoldable t, FFunctor t) => FTraversable (t :: (k -> Type) -> Type) where Source #
ftraverse :: Applicative m => (forall a. f a -> m (g a)) -> t f -> m (t g) Source #
Instances
ffmapDefault :: FTraversable t => (f ~> g) -> t f -> t g Source #
ffoldMapDefault :: (FTraversable t, Monoid m) => (forall a. f a -> m) -> t f -> m Source #
ffor :: (FTraversable t, Applicative m) => t f -> (forall a. f a -> m (g a)) -> m (t g) Source #
fsequence :: (FTraversable t, Applicative f) => t f -> f (t Identity) Source #
Generic derivation
gftraverse :: forall t (f :: Type -> Type) (g :: Type -> Type) m. (Applicative m, Generic (t f), Generic (t g), GFTraversable (Curried (Yoneda m)) f g (Rep (t f)) (Rep (t g))) => (forall a. f a -> m (g a)) -> t f -> m (t g) Source #
Generically derive ftraverse
.
Simple usage:
data Record f = Record { fieldInt :: f Int , fieldString :: f String , fieldSome ::Some
f } deriving (Generic
) instanceFFunctor
Record whereffmap
=ffmapDefault
instanceFFoldable
Record whereffoldMap
=ffoldMapDefault
instanceFTraversable
Record whereftraverse
=gftraverse
Zip & Repeat
class FFunctor t => FZip t where Source #
Instances
FZip (V1 :: (k -> Type) -> Type) Source # | |
FZip (U1 :: (k -> Type) -> Type) Source # | |
FZip (Proxy :: (k -> Type) -> Type) Source # | |
FZip (Limit :: (k -> Type) -> Type) Source # | |
Semigroup a => FZip (Const a :: (k -> Type) -> Type) Source # | |
FZip (Element a :: (k -> Type) -> Type) Source # | |
FZip (NT f :: (k -> Type) -> Type) Source # | |
(FZip f, FZip g) => FZip (f :*: g :: (k -> Type) -> Type) Source # | |
Semigroup a => FZip (K1 i a :: (k -> Type) -> Type) Source # | |
(FZip f, FZip g) => FZip (Product f g :: (k -> Type) -> Type) Source # | |
(Applicative f, FZip g) => FZip (f :.: g :: (k -> Type) -> Type) Source # | We only need an |
(Applicative f, FZip g) => FZip (Compose f g :: (k -> Type) -> Type) Source # | We only need an |
class FZip t => FRepeat t where Source #
Instances
FRepeat (U1 :: (k -> Type) -> Type) Source # | |
FRepeat (Proxy :: (k -> Type) -> Type) Source # | |
FRepeat (Limit :: (k -> Type) -> Type) Source # | |
(Monoid a, Semigroup a) => FRepeat (Const a :: (k -> Type) -> Type) Source # | |
FRepeat (Element a :: (k -> Type) -> Type) Source # | |
FRepeat (NT a :: (k -> Type) -> Type) Source # | |
(FRepeat f, FRepeat g) => FRepeat (f :*: g :: (k -> Type) -> Type) Source # | |
(Monoid a, Semigroup a) => FRepeat (K1 i a :: (k -> Type) -> Type) Source # | |
(FRepeat f, FRepeat g) => FRepeat (Product f g :: (k -> Type) -> Type) Source # | |
(Applicative f, FRepeat g) => FRepeat (f :.: g :: (k -> Type) -> Type) Source # | |
(Applicative f, FRepeat g) => FRepeat (Compose f g :: (k -> Type) -> Type) Source # | |
Generic derivation
gfzipWith :: forall t (f :: Type -> Type) (g :: Type -> Type) (h :: Type -> Type). (Generic (t f), Generic (t g), Generic (t h), GFZip f g h (Rep (t f)) (Rep (t g)) (Rep (t h))) => (forall a. f a -> g a -> h a) -> t f -> t g -> t h Source #
gfrepeat :: forall t (f :: Type -> Type). (Generic (t f), GFRepeat f (Rep (t f))) => (forall x. f x) -> t f Source #
Higher kinded data
See also Data.Some in some
package. hkd
provides instances for it.
A logarithm.
Recall that function arrow, ->
is an exponential object. If we take f = (->) r
, then
Logarithm
((->) r) ≅ forall a. (r -> a) -> a ≅ r
and this works for all Distributive
/ Representable
functors.
Logarithm | |
|
Tabulation.
indexLogarithm :: f a -> Logarithm f -> a Source #
Element in f
Element | |
|
Newtyped "natural" transformation