Safe Haskell | None |
---|---|
Language | Haskell2010 |
See http://github.com/agocorona/transient everithing in this module is exported in order to allow extensibility.
- data TransIO x = Transient {}
- type SData = ()
- type EventId = Int
- type TransientIO = TransIO
- data LifeCycle
- data EventF = EventF {}
- type Effects = forall a b c. TransIO a -> TransIO a -> (a -> TransIO b) -> StateIO (StateIO (Maybe c) -> StateIO (Maybe c), Maybe a)
- type StateIO = StateT EventF IO
- noTrans :: StateT EventF IO x -> TransIO x
- runTransient :: TransIO x -> IO (Maybe x, EventF)
- runTransState :: EventF -> TransIO x -> IO (Maybe x, EventF)
- getCont :: TransIO EventF
- runCont :: EventF -> StateIO (Maybe a)
- runCont' :: EventF -> IO (Maybe a, EventF)
- getContinuations :: StateIO [a -> TransIO b]
- compose :: (Monad f, Alternative f) => [a1 -> f a1] -> a1 -> f a
- runClosure :: EventF -> StateIO (Maybe a)
- runContinuation :: EventF -> a -> StateIO (Maybe b)
- setContinuation :: TransIO a -> (a -> TransIO b) -> [c -> TransIO c] -> StateIO ()
- withContinuation :: t -> TransIO b -> TransIO b
- runContinuations :: [a -> TransIO b] -> c -> TransIO d
- restoreStack :: MonadState EventF m => [b -> TransIO b] -> m ()
- readWithErr :: (Read a, Typeable * a) => String -> IO [(a, String)]
- readsPrec' :: (Typeable * a, Read a) => t -> String -> [(a, String)]
- class (Show a, Read a, Typeable a) => Loggable a
- data IDynamic
- type Recover = Bool
- type CurrentPointer = [LogElem]
- type LogEntries = [LogElem]
- data LogElem
- data Log = Log Recover CurrentPointer LogEntries
- data RemoteStatus
- stop :: Alternative m => m stopped
- class AdditionalOperators m where
- (<|) :: TransIO a -> TransIO b -> TransIO a
- setEventCont :: TransIO a -> (a -> TransIO b) -> StateIO EventF
- resetEventCont :: MonadState EventF m => Maybe t1 -> t -> m (a -> a)
- tailsafe :: [t] -> [t]
- baseEffects :: Effects
- waitQSemB :: (Num a, Ord a) => IORef a -> IO Bool
- signalQSemB :: Num a => IORef a -> IO ()
- threads :: Int -> TransIO a -> TransIO a
- oneThread :: TransIO a -> TransIO a
- labelState :: (MonadIO m, MonadState EventF m) => String -> m ()
- printBlock :: MVar ()
- showThreads :: MonadIO m => EventF -> m ()
- topState :: TransIO EventF
- showState :: (Typeable a, MonadIO m, Alternative m) => String -> EventF -> m (Maybe a)
- addThreads' :: Int -> TransIO ()
- addThreads :: Int -> TransIO ()
- freeThreads :: TransIO a -> TransIO a
- hookedThreads :: TransIO a -> TransIO a
- killChilds :: TransIO ()
- killBranch :: TransIO ()
- killBranch' :: MonadIO m => EventF -> m ()
- getData :: (MonadState EventF m, Typeable a) => m (Maybe a)
- getSData :: Typeable a => TransIO a
- getState :: Typeable a => TransIO a
- setData :: (MonadState EventF m, Typeable a) => a -> m ()
- modifyData :: (MonadState EventF m, Typeable a) => (Maybe a -> Maybe a) -> m ()
- modifyState :: (MonadState EventF m, Typeable a) => (Maybe a -> Maybe a) -> m ()
- setState :: (MonadState EventF m, Typeable a) => a -> m ()
- delData :: (MonadState EventF m, Typeable a) => a -> m ()
- delState :: (MonadState EventF m, Typeable a) => a -> m ()
- genId :: MonadState EventF m => m Int
- getPrevId :: MonadState EventF m => m Int
- data StreamData a
- = SMore a
- | SLast a
- | SDone
- | SError SomeException
- waitEvents :: IO b -> TransIO b
- async :: IO b -> TransIO b
- sync :: TransIO a -> TransIO a
- spawn :: IO a -> TransIO a
- sample :: Eq a => IO a -> Int -> TransIO a
- parallel :: IO (StreamData b) -> TransIO (StreamData b)
- loop :: EventF -> IO (StreamData t) -> IO ()
- hangThread :: EventF -> EventF -> IO ()
- killChildren :: MVar [EventF] -> IO ()
- react :: Typeable eventdata => ((eventdata -> IO response) -> IO ()) -> IO response -> TransIO eventdata
- getLineRef :: TVar (Maybe a)
- roption :: MVar [t]
- option :: (Typeable b, Show b, Read b, Eq b) => b -> String -> TransIO b
- input :: (Typeable a, Read a, Show a) => (a -> Bool) -> String -> TransIO a
- getLine' :: (Read a, Typeable * a) => (a -> Bool) -> IO a
- reads1 :: (Typeable * a, Read a) => String -> [(a, String)]
- inputLoop :: IO b
- processLine :: MonadIO m => String -> m ()
- stay :: MVar (Maybe a) -> IO (Maybe a)
- newtype Exit a = Exit a
- keep :: Typeable a => TransIO a -> IO (Maybe a)
- keep' :: Typeable a => TransIO a -> IO (Maybe a)
- execCommandLine :: IO ()
- exit :: Typeable a => a -> TransIO a
- onNothing :: Monad m => m (Maybe b) -> m b -> m b
- data Backtrack b = Show b => Backtrack {
- backtracking :: Maybe b
- backStack :: [EventF]
- backCut :: (Typeable reason, Show reason) => reason -> TransientIO ()
- undoCut :: TransientIO ()
- onBack :: (Typeable b, Show b) => TransientIO a -> (b -> TransientIO a) -> TransientIO a
- onUndo :: TransientIO a -> TransientIO a -> TransientIO a
- registerBack :: (Typeable b, Show b) => b -> TransientIO a -> TransientIO a
- registerUndo :: TransientIO a -> TransientIO a
- forward :: (Typeable b, Show b) => b -> TransIO ()
- retry :: TransIO ()
- noFinish :: TransIO ()
- back :: (Typeable b, Show b) => b -> TransientIO a
- backStateOf :: (Monad m, Show a, Typeable a) => a -> m (Backtrack a)
- undo :: TransIO a
- newtype FinishReason = FinishReason (Maybe SomeException)
- initFinish :: TransientIO ()
- onFinish :: (Maybe SomeException -> TransIO ()) -> TransIO ()
- onFinish' :: TransIO a -> (Maybe SomeException -> TransIO a) -> TransIO a
- finish :: Maybe SomeException -> TransIO a
- checkFinalize :: StreamData a -> TransIO a
- onException :: Exception e => (e -> TransIO ()) -> TransIO ()
- cutExceptions :: TransientIO ()
- continue :: TransIO ()
Documentation
Monad TransIO Source # | |
Functor TransIO Source # | |
Applicative TransIO Source # | |
MonadIO TransIO Source # | |
Alternative TransIO Source # | |
MonadPlus TransIO Source # | |
AdditionalOperators TransIO Source # | |
MonadState EventF TransIO Source # | |
(Num a, Eq a) => Num (TransIO a) Source # | |
Monoid a => Monoid (TransIO a) Source # | |
type TransientIO = TransIO Source #
type Effects = forall a b c. TransIO a -> TransIO a -> (a -> TransIO b) -> StateIO (StateIO (Maybe c) -> StateIO (Maybe c), Maybe a) Source #
noTrans :: StateT EventF IO x -> TransIO x Source #
Run a "non transient" computation within the underlying state monad, so it is guaranteed that the computation neither can stop neither can trigger additional events/threads
runTransient :: TransIO x -> IO (Maybe x, EventF) Source #
Run the transient computation with a blank state
runTransState :: EventF -> TransIO x -> IO (Maybe x, EventF) Source #
Run the transient computation with an state
getCont :: TransIO EventF Source #
Get the continuation context: closure, continuation, state, child threads etc
runCont :: EventF -> StateIO (Maybe a) Source #
Run the closure and the continuation using the state data of the calling thread
runCont' :: EventF -> IO (Maybe a, EventF) Source #
Run the closure and the continuation using his own state data
getContinuations :: StateIO [a -> TransIO b] Source #
Warning: radiactive untyped stuff. handle with care
compose :: (Monad f, Alternative f) => [a1 -> f a1] -> a1 -> f a Source #
Compose a list of continuations
runClosure :: EventF -> StateIO (Maybe a) Source #
Run the closure (the x
in 'x >>= f') of the current bind operation.
runContinuation :: EventF -> a -> StateIO (Maybe b) Source #
Run the continuation (the f
in 'x >>= f') of the current bind operation with the current state
withContinuation :: t -> TransIO b -> TransIO b Source #
runContinuations :: [a -> TransIO b] -> c -> TransIO d Source #
run a chain of continuations. It is up to the programmer to assure by construction that
each continuation type-check with the next, that the parameter type match the input of the first
continuation.
Normally this makes sense if it stop the current flow with stop
after the invocation
restoreStack :: MonadState EventF m => [b -> TransIO b] -> m () Source #
Dynamic serializable data for logging
type CurrentPointer = [LogElem] Source #
type LogEntries = [LogElem] Source #
data RemoteStatus Source #
stop :: Alternative m => m stopped Source #
A sinonym of empty that can be used in a monadic expression. it stop the
computation and execute the next alternative computation (composed with <|>
)
class AdditionalOperators m where Source #
(**>) :: m a -> m b -> m b infixr 1 Source #
Executes the second operand even if the frist return empty. A normal imperative (monadic) sequence uses the operator (>>) which in the Transient monad does not execute the next operand if the previous one return empty.
(<**) :: m a -> m b -> m a infixr 1 Source #
Forces the execution of the second operand even if the first stop. It does not execute the second operand as result of internal events occuring in the first operand. Return the first result
atEnd' :: m a -> m b -> m a Source #
(<***) :: m a -> m b -> m a infixr 1 Source #
Forces the execution of the second operand even if the first stop. Return the first result. The second operand is executed also when internal events happens in the first operand and it returns something
(<|) :: TransIO a -> TransIO b -> TransIO a Source #
When the first operand is an asynchronous operation, the second operand is executed once (one single time) when the first completes his first asyncronous operation.
This is useful for spawning asynchronous or distributed tasks that are singletons and that should start when the first one is set up.
for example a streaming where the event receivers are acivated before the senders.
setEventCont :: TransIO a -> (a -> TransIO b) -> StateIO EventF Source #
Set the current closure and continuation for the current statement
resetEventCont :: MonadState EventF m => Maybe t1 -> t -> m (a -> a) Source #
Reset the closure and continuation. remove inner binds than the previous computations may have stacked in the list of continuations. resetEventCont :: Maybe a -> EventF -> StateIO (TransIO b -> TransIO b)
Threads
threads :: Int -> TransIO a -> TransIO a Source #
Set the maximun number of threads for a procedure. It is useful to limit the
parallelization of transient code that uses parallel
spawn
and waitEvents
oneThread :: TransIO a -> TransIO a Source #
Delete all the previous child threads generated by the expression taken as parameter and continue execution of the current thread.
labelState :: (MonadIO m, MonadState EventF m) => String -> m () Source #
Add a label to the current passing threads so it can be printed by debugging calls like showThreads
printBlock :: MVar () Source #
showThreads :: MonadIO m => EventF -> m () Source #
topState :: TransIO EventF Source #
Return the state of the thread that initiated the transient computation
showState :: (Typeable a, MonadIO m, Alternative m) => String -> EventF -> m (Maybe a) Source #
Return the state variable of the type desired with which a thread, identified by his number in the treee was initiated
addThreads' :: Int -> TransIO () Source #
Add n threads to the limit of threads. If there is no limit, it set it
addThreads :: Int -> TransIO () Source #
Assure that at least there are n threads available
freeThreads :: TransIO a -> TransIO a Source #
The threads generated in the process passed as parameter will not be killed by `kill*` primitives.
Since there is no thread control, the application run slightly faster.
hookedThreads :: TransIO a -> TransIO a Source #
The threads will be killed when the parent thread dies. That is the default.
This can be invoked to revert the effect of freeThreads
killChilds :: TransIO () Source #
kill all the child threads of the current thread
killBranch :: TransIO () Source #
Kill the current thread and the childs
killBranch' :: MonadIO m => EventF -> m () Source #
Kill the childs and the thread of an state
extensible state: session data management
getData :: (MonadState EventF m, Typeable a) => m (Maybe a) Source #
Get the state data for the desired type if there is any.
getSData :: Typeable a => TransIO a Source #
getData specialized for the Transient monad. if Nothing, the monadic computation does not continue.
If there is no such data, getSData
silently stop the computation.
That may or may not be the desired behaviour.
To make sure that this does not get unnoticed, use this construction:
getSData <|> error "no data"
To have the same semantics and guarantees than get
, use a default value:
getInt= getSData <|> return (0 :: Int)
The default value (0 in this case) has the same role than the initial value in a state monad.
The difference is that you can define as many get
as you need for all your data types.
To distingish two data with the same types, use newtype definitions.
setData :: (MonadState EventF m, Typeable a) => a -> m () Source #
Set session data for this type. retrieved with getData or getSData Note that this is data in a state monad, that means that the update only affect downstream in the monad execution. it is not a global state neither a per user or per thread state it is a monadic state like the one of a state monad.
modifyData :: (MonadState EventF m, Typeable a) => (Maybe a -> Maybe a) -> m () Source #
Modify state data. It accept a function that get the current state (if exist) as parameter. The state will be deleted or changed depending on function result
modifyState :: (MonadState EventF m, Typeable a) => (Maybe a -> Maybe a) -> m () Source #
Synonym for modifyData
genId :: MonadState EventF m => m Int Source #
Generator of identifiers that are unique withing the current monadic sequence They are not unique in the whole program.
data StreamData a Source #
Async calls
Read a => Read (StreamData a) Source # | |
Show a => Show (StreamData a) Source # | |
waitEvents :: IO b -> TransIO b Source #
Variant of parallel
that repeatedly executes the IO computation without end
sync :: TransIO a -> TransIO a Source #
in an alternative computation it executes an async operations synchronously. This means that the alternatives do not execute until the async operation finishes. Do not use in Applicatives.
sample :: Eq a => IO a -> Int -> TransIO a Source #
Executes an IO action each certain interval of time and return his value if it changes
parallel :: IO (StreamData b) -> TransIO (StreamData b) Source #
Return empty to the current thread and execute the IO action in a new thread. When the IO action returns, the transient computation continues with this value as the result The IO action may be re-executed or not depending on the result. So parallel can spawn any number of threads/results.
If the maximum number of threads, set with threads
has been reached parallel
perform
the work sequentially, in the current thread.
So parallel
means that 'it can be parallelized if there are thread available'
if there is a limitation of threads, when a thread finish, the counter of threads available
is increased so another parallel
can make use of it.
The behaviour of parallel
depend on StreamData
; If SMore
, parallel
will excute again the
IO action. With SLast
, SDone
and SError
, parallel
will not repeat the IO action anymore.
killChildren :: MVar [EventF] -> IO () Source #
kill all the child threads associated with the continuation context
react :: Typeable eventdata => ((eventdata -> IO response) -> IO ()) -> IO response -> TransIO eventdata Source #
De-invert an event handler.
The first parameter is the setter of the event handler to be deinverted. Usually it is the primitive provided by a framework to set an event handler
the second parameter is the value to return to the event handler. Usually it is `return()`
it configures the event handler by calling the setter of the event handler with the current continuation
non-blocking keyboard input
getLineRef :: TVar (Maybe a) Source #
option :: (Typeable b, Show b, Read b, Eq b) => b -> String -> TransIO b Source #
Install a event receiver that wait for a string and trigger the continuation when this string arrives.
input :: (Typeable a, Read a, Show a) => (a -> Bool) -> String -> TransIO a Source #
Validates an input entered in the keyboard in non blocking mode. non blocking means that
the user can enter also anything else to activate other option
unlike option
, wich watch continuously, input only wait for one valid response
getLine' :: (Read a, Typeable * a) => (a -> Bool) -> IO a Source #
Non blocking getLine
with a validator
processLine :: MonadIO m => String -> m () Source #
stay :: MVar (Maybe a) -> IO (Maybe a) Source #
Wait for the execution of exit
and return the result or the exhaustion of thread activity
execCommandLine :: IO () Source #
exit :: Typeable a => a -> TransIO a Source #
Force the finalization of the main thread and thus, all the Transient block (and the application if there is no more code)
onNothing :: Monad m => m (Maybe b) -> m b -> m b Source #
Alternative operator for maybe values. Used in infix mode
backCut :: (Typeable reason, Show reason) => reason -> TransientIO () Source #
Assures that backtracking will not go further back
undoCut :: TransientIO () Source #
onBack :: (Typeable b, Show b) => TransientIO a -> (b -> TransientIO a) -> TransientIO a Source #
The second parameter will be executed when backtracking
onUndo :: TransientIO a -> TransientIO a -> TransientIO a Source #
registerBack :: (Typeable b, Show b) => b -> TransientIO a -> TransientIO a Source #
Register an action that will be executed when backtracking
registerUndo :: TransientIO a -> TransientIO a Source #
forward :: (Typeable b, Show b) => b -> TransIO () Source #
backtracking is stopped. the exection continues forward from this point on.
back :: (Typeable b, Show b) => b -> TransientIO a Source #
Execute backtracking. It execute the registered actions in reverse order.
If the backtracking flag is changed the flow proceed forward from that point on.
If the backtrack stack is finished or undoCut executed, undo
will stop.
initFinish :: TransientIO () Source #
Initialize the event variable for finalization. all the following computations in different threads will share it it also isolate this event from other branches that may have his own finish variable
onFinish :: (Maybe SomeException -> TransIO ()) -> TransIO () Source #
Set a computation to be called when the finish event happens
onFinish' :: TransIO a -> (Maybe SomeException -> TransIO a) -> TransIO a Source #
Set a computation to be called when the finish event happens this only apply for
finish :: Maybe SomeException -> TransIO a Source #
Trigger the event, so this closes all the resources
checkFinalize :: StreamData a -> TransIO a Source #
trigger finish when the stream of data ends
onException :: Exception e => (e -> TransIO ()) -> TransIO () Source #
When a exception is produced in the continuation, the handler is executed. | handlers are executed Last in first out.
cutExceptions :: TransientIO () Source #
stop the backtracking mechanism to execute further handlers