objective-1.0.3: Extensible objects

Safe HaskellTrustworthy
LanguageHaskell2010

Control.Object.Object

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 converts 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 

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

An alias for runObject

class HProfunctor k where Source

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

echo :: Functor f => Object f f Source

The trivial object

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

Lift natural transformation into an object

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

Object composition

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

Reversed '(>>)'

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

The unwrapped analog of stateful unfoldO runObject = id unfoldO iterObject = iterable

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

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

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

A mutable variable.

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

Send a message to objects in a container.