functor-combo-0.0.4: Functor combinators with tries & zippers

Stabilityexperimental
Maintainerconal@conal.net

FunctorCombo.Functor

Description

Standard building blocks for functors

Synopsis

Documentation

newtype Const a b

Constructors

Const 

Fields

getConst :: a
 

Instances

Functor (Const m) 
Monoid m => Applicative (Const m) 
Holey (Const z) 
Holey (Const x) 
Monoid o => Monoid (Const o a) 
HasTrie x => HasTrie (Const x a) 
HasTrie x => HasTrie (Const x a) 

data Void a Source

Empty/zero type constructor (no inhabitants)

Instances

voidF :: Void a -> bSource

type Unit = Const ()Source

Unit type constructor (one inhabitant)

unit :: Unit ()Source

The unit value

newtype Id a

Identity type constructor. Until there's a better place to find it. I'd use Control.Monad.Identity, but I don't want to introduce a dependency on mtl just for Id.

Constructors

Id a 

Instances

unId :: Id a -> a

inId :: (a -> b) -> Id a -> Id b

inId2 :: (a -> b -> c) -> Id a -> Id b -> Id c

data (f :+: g) a Source

Sum on unary type constructors

Constructors

InL (f a) 
InR (g a) 

Instances

(Functor f, Functor g) => Functor (:+: f g) 
(Holey f, Holey g) => Holey (:+: f g) 
(Holey f, Holey g) => Holey (:+: f g) 
(Show (f a), Show (g a)) => Show (:+: f g a) 
(HasTrie (f a), HasTrie (g a)) => HasTrie (:+: f g a) 
(HasTrie (f a), HasTrie (g a)) => HasTrie (:+: f g a) 

eitherF :: (f a -> b) -> (g a -> b) -> (f :+: g) a -> bSource

data (f :*: g) a Source

Product on unary type constructors

Constructors

(f a) :*: (g a) 

Instances

(Functor f, Functor g) => Functor (:*: f g) 
(Applicative f, Applicative g) => Applicative (:*: f g) 
(HasLubF f, HasLubF g) => HasLubF (:*: f g) 
(Holey f, Holey g) => Holey (:*: f g) 
(Holey f, Holey g) => Holey (:*: f g) 
(Show (f a), Show (g a)) => Show (:*: f g a) 
(HasTrie (f a), Functor (Trie (f a)), HasTrie (g a)) => HasTrie (:*: f g a) 
(HasTrie (f a), HasTrie (g a)) => HasTrie (:*: f g a) 

newtype (g :. f) a

Composition of unary type constructors

There are (at least) two useful Monoid instances, so you'll have to pick one and type-specialize it (filling in all or parts of g and/or f).

     -- standard Monoid instance for Applicative applied to Monoid
     instance (Applicative (g :. f), Monoid a) => Monoid ((g :. f) a) where
       { mempty = pure mempty; mappend = liftA2 mappend }
     -- Especially handy when g is a Monoid_f.
     instance Monoid (g (f a)) => Monoid ((g :. f) a) where
       { mempty = O mempty; mappend = inO2 mappend }

Corresponding to the first and second definitions above,

     instance (Applicative g, Monoid_f f) => Monoid_f (g :. f) where
       { mempty_f = O (pure mempty_f); mappend_f = inO2 (liftA2 mappend_f) }
     instance Monoid_f g => Monoid_f (g :. f) where
       { mempty_f = O mempty_f; mappend_f = inO2 mappend_f }

Similarly, there are two useful Functor instances and two useful Cofunctor instances.

     instance (  Functor g,   Functor f) => Functor (g :. f) where fmap = fmapFF
     instance (Cofunctor g, Cofunctor f) => Functor (g :. f) where fmap = fmapCC
 
     instance (Functor g, Cofunctor f) => Cofunctor (g :. f) where cofmap = cofmapFC
     instance (Cofunctor g, Functor f) => Cofunctor (g :. f) where cofmap = cofmapCF

However, it's such a bother to define the Functor instances per composition type, I've left the fmapFF case in. If you want the fmapCC one, you're out of luck for now. I'd love to hear a good solution. Maybe someday Haskell will do Prolog-style search for instances, subgoaling the constraints, rather than just matching instance heads.

Constructors

O (g (f a)) 

Instances

(Functor g, Functor f) => Functor (:. g f) 
(Applicative g, Applicative f) => Applicative (:. g f) 
(Foldable g, Foldable f, Functor g) => Foldable (:. g f) 
(Traversable g, Traversable f) => Traversable (:. g f) 
(Holey f, Holey g) => Holey (:. g f) 
(Holey f, Holey g) => Holey (:. g f) 
Show (g (f a)) => Show (:. g f a) 
HasTrie (g (f a)) => HasTrie (:. g f a) 
HasTrie (g (f a)) => HasTrie (:. g f a) 

unO :: :. g f a -> g (f a)

Unwrap a '(:.)'.

inO :: (g (f a) -> g' (f' a')) -> :. g f a -> :. g' f' a'

Apply a unary function within the O constructor.

inO2 :: (g (f a) -> g' (f' a') -> g'' (f'' a'')) -> :. g f a -> :. g' f' a' -> :. g'' f'' a''

Apply a binary function within the O constructor.

(~>) :: (a' -> a) -> (b -> b') -> (a -> b) -> a' -> b'

Add pre- and post processing

pairF :: (f a, g a) -> (f :*: g) aSource

unPairF :: (f :*: g) a -> (f a, g a)Source

inProd :: ((f a, g a) -> (h b, i b)) -> (f :*: g) a -> (h :*: i) bSource

inProd2 :: ((f a, g a) -> (h b, i b) -> (j c, k c)) -> (f :*: g) a -> (h :*: i) b -> (j :*: k) cSource