objective-0.5.2.1: Extensible objects

Copyright(c) Fumiaki Kinoshita 2014
LicenseBSD3
MaintainerFumiaki Kinoshita <fumiexcel@gmail.com>
Stabilityexperimental
Portabilitynon-portable
Safe HaskellNone
LanguageHaskell2010

Control.Object

Contents

Description

Stateful effect transducer: The Mealy machine for effects.

Synopsis

Construction

newtype Object e m Source

The type 'Object e m' represents objects which can handle messages e, perform actions in the environment m. It can be thought of as an automaton that converts effects. Objects can be composed just like functions using .>>.; the identity element is echo.

Constructors

Object 

Fields

runObject :: forall x. e x -> m (x, Object e m)
 

Instances

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

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

Lift a natural transformation into an object.

echo :: Functor e => Object e e Source

Parrots messages given.

oneshot :: (Functor e, Monad m) => (forall a. e (m a) -> m a) -> Object e m Source

Build an object using continuation passing style.

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

Build a stateful object.

variable :: Applicative f => s -> Object (State s) f Source

A mutable variable.

Composition

(.>>.) :: Functor n => Object e m -> Object m n -> Object e n infixr 4 Source

Compose two objects (aka Dependency Injection).

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

Change the workspace of the object.

adaptObject :: Functor m => (forall x. e x -> f x) -> Object f m -> Object e m Source

Apply a function to the messages coming into the object.

sequential :: Monad m => Object e m -> Object (ReifiedProgram e) m Source

Let object handle sequential methods.

runSequential :: Monad m => Object e m -> ReifiedProgram e a -> m (a, Object e m) Source

Multifunctional objects

loner :: Functor m => Object Nil m Source

An object that won't accept any messages.

(.|>.) :: Functor m => Object f m -> Object (Union s) m -> Object (f |> Union s) m infixr 3 Source

Extend an object by adding another independent object.

sharing :: Monad m => (forall a. e a -> StateT s m a) -> s -> Object (State s |> (e |> Nil)) m Source

Build a stateful object, sharing out the state.

Patterns

flyweight :: Monad m => Ord k => (k -> m a) -> Object (Request k a) m Source

The flyweight pattern.

newtype Process m a b Source

An object which is specialized to be a Mealy machine

Constructors

Process 

Fields

unProcess :: Object (Request a b) m
 

Instances

Monad m => Category * (Process m) 
Monad m => Arrow (Process m) 
Monad m => ArrowChoice (Process m) 
Monad m => Strong (Process m) 
Monad m => Choice (Process m) 
Monad m => Profunctor (Process m) 
Functor f => Functor (Process f a) 
Applicative f => Applicative (Process f a) 
(Applicative m, Fractional o) => Fractional (Process m i o) 
(Applicative m, Num o) => Num (Process m i o) 
(Applicative f, Monoid b) => Monoid (Process f a b) 

_Process :: (Profunctor p, Functor f) => p (Process m a b) (f (Process m a b)) -> p (Object (Request a b) m) (f (Object (Request a b) m)) Source

_Process :: Iso' (Object (Request a b) m) (Process m a b)