objective-1.0.5: Composable objects

Copyright(c) Fumiaki Kinoshita 2015
LicenseBSD3
MaintainerFumiaki Kinoshita <fumiexcel@gmail.com>
Stabilityprovisional
PortabilityGADTs, Rank2Types
Safe HaskellSafe
LanguageHaskell2010

Control.Object.Object

Contents

Description

 

Synopsis

Documentation

newtype Object f g Source

The type Object f g represents objects which can handle messages f, perform actions in the environment g. It can be thought of as an automaton that transforms effects. Objects can be composed just like functions using @>>@; the identity element is echo. Objects are morphisms of the category of actions.

Naturality
runObject obj . fmap f ≡ fmap f . runObject obj

Constructors

Object 

Fields

runObject :: forall x. f x -> g (x, Object f g)
 

Instances

HProfunctor Object 
Typeable ((* -> *) -> (* -> *) -> *) Object 

echo :: Functor f => Object f f Source

The trivial object

(@>>@) :: Functor h => Object f g -> Object g h -> Object f h infixr 1 Source

The categorical composition of objects.

(@<<@) :: Functor h => Object g h -> Object f g -> Object f h infixl 1 Source

Reversed '(>>)'

liftO :: Functor g => (forall x. f x -> g x) -> Object f g Source

Lift a natural transformation into an object.

class HProfunctor k where Source

Higher-order profunctors

Methods

(^>>@) :: Functor h => (forall x. f x -> g x) -> k g h -> k f h infixr 1 Source

(@>>^) :: Functor h => k f g -> (forall x. g x -> h x) -> k f h infixr 1 Source

(@||@) :: Functor h => Object f h -> Object g h -> Object (f `Sum` g) h Source

Combine objects so as to handle a Sum of interfaces.

Stateful construction

unfoldO :: Functor g => (forall a. r -> f a -> g (a, r)) -> r -> Object f g Source

An unwrapped analog of stateful id = unfoldO runObject iterative = unfoldO iterObject cascading = unfoldO cascadeObject

unfoldOM :: Monad m => (forall a. r -> f a -> m (a, r)) -> r -> Object f m Source

Same as unfoldO but requires Monad instead

stateful :: Monad m => (forall a. t a -> StateT s m a) -> s -> Object t m Source

Build a stateful object.

stateful t s = t ^>>@ variable s

(@~) :: Monad m => s -> (forall a. t a -> StateT s m a) -> Object t m infix 1 Source

Flipped stateful. it is super convenient to use with the LambdaCase extension.

variable :: Monad m => s -> Object (StateT s m) m Source

A mutable variable.

variable = stateful id

Method cascading

(@-) :: Object f g -> f x -> g (x, Object f g) infixr 3 Source

An infix alias for runObject

iterObject :: Monad m => Object f m -> Free f a -> m (a, Object f m) Source

Cascading

iterative :: Monad m => Object f m -> Object (Free f) m Source

Objects can consume free monads. cascading is more preferred.

cascadeObject :: Monad m => Object t m -> Skeleton t a -> m (a, Object t m) Source

Pass zero or more messages to an object.

cascading :: Monad m => Object t m -> Object (Skeleton t) m Source

Add capability to handle multiple messages at once.

Filtering

data Fallible t a where Source

Constructors

Fallible :: t a -> Fallible t (Maybe a) 

filteredO :: Monad m => (forall x. t x -> Bool) -> Object t m -> Object (Fallible t) m Source

filterO :: (forall x. t x -> Bool) -> Object (Fallible t) (Skeleton t) Source

Manipulation on StateT

invokesOf :: Monad m => ((Object t m -> WriterT r m (Object t m)) -> s -> WriterT r m s) -> t a -> (a -> r) -> StateT s m r Source

Send a message to an object through a lens.

invokes :: (Traversable t, Monad m, Monoid r) => f a -> (a -> r) -> StateT (t (Object f m)) m r Source

(@!=) :: Monad m => ((Object t m -> WriterT a m (Object t m)) -> s -> WriterT a m s) -> t a -> StateT s m a Source

A method invocation operator on StateT.

announce :: (Traversable t, Monad m) => f a -> StateT (t (Object f m)) m [a] Source

Send a message to objects in a traversable container.

announce = withBuilder . invokesOf traverse

withBuilder :: Functor f => ((a -> Endo [a]) -> f (Endo [a])) -> f [a] Source