freer-0.2.4.0: Implementation of the Freer Monad

CopyrightAllele Dev 2016
LicenseBSD-3
Maintainerallele.dev@gmail.com
Stabilityexperimental
PortabilityPOSIX
Safe HaskellNone
LanguageHaskell2010

Data.Open.Union

Description

This implementation relies on _closed_ type families added to GHC 7.8. It has NO overlapping instances and NO Typeable. Alas, the absence of Typeable means the projections and injections generally take linear time. The code illustrate how to use closed type families to disambiguate otherwise overlapping instances.

The data constructors of Union are not exported. Essentially, the nested Either data type.

Using http://okmij.org/ftp/Haskell/extensible/OpenUnion41.hs as a starting point.

Synopsis

Documentation

type family Members m r :: Constraint where ... Source #

Equations

Members (t ': c) r = (Member t r, Members c r) 
Members '[] r = () 

data Union r v Source #

Instances

(Functor f1, Functor (Union ((:) (* -> *) f2 fs))) => Functor (Union ((:) (* -> *) f1 ((:) (* -> *) f2 fs))) Source # 

Methods

fmap :: (a -> b) -> Union (((* -> *) ': f1) (((* -> *) ': f2) fs)) a -> Union (((* -> *) ': f1) (((* -> *) ': f2) fs)) b #

(<$) :: a -> Union (((* -> *) ': f1) (((* -> *) ': f2) fs)) b -> Union (((* -> *) ': f1) (((* -> *) ': f2) fs)) a #

Functor f => Functor (Union ((:) (* -> *) f ([] (* -> *)))) Source # 

Methods

fmap :: (a -> b) -> Union (((* -> *) ': f) [* -> *]) a -> Union (((* -> *) ': f) [* -> *]) b #

(<$) :: a -> Union (((* -> *) ': f) [* -> *]) b -> Union (((* -> *) ': f) [* -> *]) a #

class Member' t r (FindElem t r) => Member t r where Source #

Minimal complete definition

inj, prj

Methods

inj :: t v -> Union r v Source #

prj :: Union r v -> Maybe (t v) Source #

Instances

Member' t r (FindElem t r) => Member t r Source # 

Methods

inj :: t v -> Union r v Source #

prj :: Union r v -> Maybe (t v) Source #

decomp :: Union (t ': r) v -> Either (Union r v) (t v) Source #

weaken :: Union (t ': r) w -> Union (any ': (t ': r)) w Source #

extract :: Union '[t] v -> t v Source #

class Functor f where #

The Functor class is used for types that can be mapped over. Instances of Functor should satisfy the following laws:

fmap id  ==  id
fmap (f . g)  ==  fmap f . fmap g

The instances of Functor for lists, Maybe and IO satisfy these laws.

Minimal complete definition

fmap

Methods

fmap :: (a -> b) -> f a -> f b #

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

Replace all locations in the input with the same value. The default definition is fmap . const, but this may be overridden with a more efficient version.

Instances

Functor [] 

Methods

fmap :: (a -> b) -> [a] -> [b] #

(<$) :: a -> [b] -> [a] #

Functor Maybe 

Methods

fmap :: (a -> b) -> Maybe a -> Maybe b #

(<$) :: a -> Maybe b -> Maybe a #

Functor IO 

Methods

fmap :: (a -> b) -> IO a -> IO b #

(<$) :: a -> IO b -> IO a #

Functor V1 

Methods

fmap :: (a -> b) -> V1 a -> V1 b #

(<$) :: a -> V1 b -> V1 a #

Functor U1 

Methods

fmap :: (a -> b) -> U1 a -> U1 b #

(<$) :: a -> U1 b -> U1 a #

Functor Par1 

Methods

fmap :: (a -> b) -> Par1 a -> Par1 b #

(<$) :: a -> Par1 b -> Par1 a #

Functor ZipList 

Methods

fmap :: (a -> b) -> ZipList a -> ZipList b #

(<$) :: a -> ZipList b -> ZipList a #

Functor Dual 

Methods

fmap :: (a -> b) -> Dual a -> Dual b #

(<$) :: a -> Dual b -> Dual a #

Functor Sum 

Methods

fmap :: (a -> b) -> Sum a -> Sum b #

(<$) :: a -> Sum b -> Sum a #

Functor Product 

Methods

fmap :: (a -> b) -> Product a -> Product b #

(<$) :: a -> Product b -> Product a #

Functor First 

Methods

fmap :: (a -> b) -> First a -> First b #

(<$) :: a -> First b -> First a #

Functor Last 

Methods

fmap :: (a -> b) -> Last a -> Last b #

(<$) :: a -> Last b -> Last a #

Functor ((->) r) 

Methods

fmap :: (a -> b) -> (r -> a) -> r -> b #

(<$) :: a -> (r -> b) -> r -> a #

Functor (Either a) 

Methods

fmap :: (a -> b) -> Either a a -> Either a b #

(<$) :: a -> Either a b -> Either a a #

Functor f => Functor (Rec1 f) 

Methods

fmap :: (a -> b) -> Rec1 f a -> Rec1 f b #

(<$) :: a -> Rec1 f b -> Rec1 f a #

Functor (URec Char) 

Methods

fmap :: (a -> b) -> URec Char a -> URec Char b #

(<$) :: a -> URec Char b -> URec Char a #

Functor (URec Double) 

Methods

fmap :: (a -> b) -> URec Double a -> URec Double b #

(<$) :: a -> URec Double b -> URec Double a #

Functor (URec Float) 

Methods

fmap :: (a -> b) -> URec Float a -> URec Float b #

(<$) :: a -> URec Float b -> URec Float a #

Functor (URec Int) 

Methods

fmap :: (a -> b) -> URec Int a -> URec Int b #

(<$) :: a -> URec Int b -> URec Int a #

Functor (URec Word) 

Methods

fmap :: (a -> b) -> URec Word a -> URec Word b #

(<$) :: a -> URec Word b -> URec Word a #

Functor (URec (Ptr ())) 

Methods

fmap :: (a -> b) -> URec (Ptr ()) a -> URec (Ptr ()) b #

(<$) :: a -> URec (Ptr ()) b -> URec (Ptr ()) a #

Functor ((,) a) 

Methods

fmap :: (a -> b) -> (a, a) -> (a, b) #

(<$) :: a -> (a, b) -> (a, a) #

Functor (Array i) 

Methods

fmap :: (a -> b) -> Array i a -> Array i b #

(<$) :: a -> Array i b -> Array i a #

Monad m => Functor (WrappedMonad m) 

Methods

fmap :: (a -> b) -> WrappedMonad m a -> WrappedMonad m b #

(<$) :: a -> WrappedMonad m b -> WrappedMonad m a #

Arrow a => Functor (ArrowMonad a) 

Methods

fmap :: (a -> b) -> ArrowMonad a a -> ArrowMonad a b #

(<$) :: a -> ArrowMonad a b -> ArrowMonad a a #

Functor (Proxy *) 

Methods

fmap :: (a -> b) -> Proxy * a -> Proxy * b #

(<$) :: a -> Proxy * b -> Proxy * a #

(Functor f1, Functor (Union ((:) (* -> *) f2 fs))) => Functor (Union ((:) (* -> *) f1 ((:) (* -> *) f2 fs))) # 

Methods

fmap :: (a -> b) -> Union (((* -> *) ': f1) (((* -> *) ': f2) fs)) a -> Union (((* -> *) ': f1) (((* -> *) ': f2) fs)) b #

(<$) :: a -> Union (((* -> *) ': f1) (((* -> *) ': f2) fs)) b -> Union (((* -> *) ': f1) (((* -> *) ': f2) fs)) a #

Functor f => Functor (Union ((:) (* -> *) f ([] (* -> *)))) # 

Methods

fmap :: (a -> b) -> Union (((* -> *) ': f) [* -> *]) a -> Union (((* -> *) ': f) [* -> *]) b #

(<$) :: a -> Union (((* -> *) ': f) [* -> *]) b -> Union (((* -> *) ': f) [* -> *]) a #

Functor (Eff r) # 

Methods

fmap :: (a -> b) -> Eff r a -> Eff r b #

(<$) :: a -> Eff r b -> Eff r a #

Functor (K1 i c) 

Methods

fmap :: (a -> b) -> K1 i c a -> K1 i c b #

(<$) :: a -> K1 i c b -> K1 i c a #

(Functor g, Functor f) => Functor ((:+:) f g) 

Methods

fmap :: (a -> b) -> (f :+: g) a -> (f :+: g) b #

(<$) :: a -> (f :+: g) b -> (f :+: g) a #

(Functor g, Functor f) => Functor ((:*:) f g) 

Methods

fmap :: (a -> b) -> (f :*: g) a -> (f :*: g) b #

(<$) :: a -> (f :*: g) b -> (f :*: g) a #

(Functor g, Functor f) => Functor ((:.:) f g) 

Methods

fmap :: (a -> b) -> (f :.: g) a -> (f :.: g) b #

(<$) :: a -> (f :.: g) b -> (f :.: g) a #

Arrow a => Functor (WrappedArrow a b) 

Methods

fmap :: (a -> b) -> WrappedArrow a b a -> WrappedArrow a b b #

(<$) :: a -> WrappedArrow a b b -> WrappedArrow a b a #

Functor (Const * m) 

Methods

fmap :: (a -> b) -> Const * m a -> Const * m b #

(<$) :: a -> Const * m b -> Const * m a #

Functor f => Functor (Alt * f) 

Methods

fmap :: (a -> b) -> Alt * f a -> Alt * f b #

(<$) :: a -> Alt * f b -> Alt * f a #

Functor (Yield a b) # 

Methods

fmap :: (a -> b) -> Yield a b a -> Yield a b b #

(<$) :: a -> Yield a b b -> Yield a b a #

Functor f => Functor (M1 i c f) 

Methods

fmap :: (a -> b) -> M1 i c f a -> M1 i c f b #

(<$) :: a -> M1 i c f b -> M1 i c f a #