diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,62 +1,62 @@ -![Transient logo](https://github.com/transient-haskell/transient/raw/master/logo.png) -========= - -[![Hackage](https://img.shields.io/hackage/v/transient.svg)](http://hackage.haskell.org/package/transient) -[![Stackage LTS](http://stackage.org/package/transient/badge/lts)](http://stackage.org/lts/package/transient) -[![Stackage Nightly](http://stackage.org/package/transient/badge/nightly)](http://stackage.org/nightly/package/transient) -[![Build Status](https://api.travis-ci.org/transient-haskell/transient.png?branch=master)](https://travis-ci.org/transient-haskell/transient) -[![Gitter](https://badges.gitter.im/theam/haskell-do.svg)](https://gitter.im/Transient-Transient-Universe-HPlay/Lobby?utm_source=share-link&utm_medium=link&utm_campaign=share-link) - -NOTE: distributed computing and web primitives have been moved to [transient-universe](https://github.com/agocorona/transient-universe) and [ghcjs-hplay](https://github.com/agocorona/ghcjs-hplay) - - -## Some feedback on `transient`: - -1. Rahul Muttineni @rahulmutt nov. 09 2016 03:40 Lead developper of ETA (the JVM Haskell compiler) - - *It's a bit mind bending in that it's like using a higher-level list monad, but it's very, very cool. For beginning Haskellers, what would be really useful is a visualisation of what happens when you do various distributed/parallel stuff.* **It's almost shocking how effortlessly you can run computations across threads/nodes.** - - *The cool part is the composability in the distributed setting. *You can make higher-order monadic functions that allow you to compose & reuse a long chain of distributed transactions via `wormhole` and `teleport`*. Another benefit is that the transaction becomes first class and* **you can see exactly what's going on in one place** *instead of distributing the logic across actors making the code equivalent to event callbacks, as you've stated.* - - https://gitter.im/Transient-Transient-Universe-HPlay/Lobby?at=58228caa35e6cf054773303b - -## What is Transient? - -One of the dreams of software engineering is unrestricted composability. - -This may be put in these terms: - -let `ap1` and `ap2` two applications with arbitrary complexity, with all effects including multiple threads, asynchronous IO, indeterminism, events and perhaps, distributed computing. - -Then the combinations: - - - ap1 <|> ap2 -- Alternative expression - - ap1 >>= \x -> ap2 -- monadic sequence - - ap1 <> ap2 -- monoidal expression - - (,) <$> ap1 <*> ap2 -- Applicative expression - -are possible if the types match, and generate new applications that are composable as well. - -Transient does exactly that. - -The operators `<$>` `<*>` and `<>` express concurrency, the operator `<|>` express parallelism and `>>=` for sequencing of threads and/or distributed processes. So even in the presence of these effects and others, everything is composable. - -For this purpose transient is an extensible effects monad with all major effects and primitives for parallelism, events, asynchronous IO, early termination, non-determinism logging and distributed computing. Since it is possible to extend it with more effects without adding monad transformers, the composability is assured. - -Documentation -============= - -The [Wiki](https://github.com/agocorona/transient/wiki) is more user oriented - -My video sessions in [livecoding.tv](https://www.livecoding.tv/agocorona/videos/) not intended as tutorials or presentations, but show some of the latest features running. - -The articles are more technical: - -- [Philosophy, async, parallelism, thread control, events, Session state](https://www.fpcomplete.com/user/agocorona/EDSL-for-hard-working-IT-programmers?show=tutorials) -- [Backtracking and undoing IO transactions](https://www.fpcomplete.com/user/agocorona/the-hardworking-programmer-ii-practical-backtracking-to-undo-actions?show=tutorials) -- [Non-deterministic list like processing, multithreading](https://www.fpcomplete.com/user/agocorona/beautiful-parallel-non-determinism-transient-effects-iii?show=tutorials) -- [Distributed computing](https://www.fpcomplete.com/user/agocorona/moving-haskell-processes-between-nodes-transient-effects-iv?show=tutorials) -- [Publish-Subscribe variables](https://www.schoolofhaskell.com/user/agocorona/publish-subscribe-variables-transient-effects-v) -- [Distributed streaming, map-reduce](https://www.schoolofhaskell.com/user/agocorona/estimation-of-using-distributed-computing-streaming-transient-effects-vi-1) - -These articles contain executable examples (not now, since the site no longer support the execution of haskell snippets). +![Transient logo](https://github.com/transient-haskell/transient/raw/master/logo.png) +========= + +[![Hackage](https://img.shields.io/hackage/v/transient.svg)](http://hackage.haskell.org/package/transient) +[![Stackage LTS](http://stackage.org/package/transient/badge/lts)](http://stackage.org/lts/package/transient) +[![Stackage Nightly](http://stackage.org/package/transient/badge/nightly)](http://stackage.org/nightly/package/transient) +[![Build Status](https://api.travis-ci.org/transient-haskell/transient.png?branch=master)](https://travis-ci.org/transient-haskell/transient) +[![Gitter](https://badges.gitter.im/theam/haskell-do.svg)](https://gitter.im/Transient-Transient-Universe-HPlay/Lobby?utm_source=share-link&utm_medium=link&utm_campaign=share-link) + +NOTE: distributed computing and web primitives have been moved to [transient-universe](https://github.com/transient-haskell/transient-universe) and [axiom](https://github.com/transient-haskell/axiom) + + +## Some feedback on `transient`: + +1. Rahul Muttineni @rahulmutt nov. 09 2016 03:40 Lead developper of ETA (the JVM Haskell compiler) + + *It's a bit mind bending in that it's like using a higher-level list monad, but it's very, very cool. For beginning Haskellers, what would be really useful is a visualisation of what happens when you do various distributed/parallel stuff.* **It's almost shocking how effortlessly you can run computations across threads/nodes.** + + *The cool part is the composability in the distributed setting. *You can make higher-order monadic functions that allow you to compose & reuse a long chain of distributed transactions via `wormhole` and `teleport`*. Another benefit is that the transaction becomes first class and* **you can see exactly what's going on in one place** *instead of distributing the logic across actors making the code equivalent to event callbacks, as you've stated.* + + https://gitter.im/Transient-Transient-Universe-HPlay/Lobby?at=58228caa35e6cf054773303b + +## What is Transient? + +One of the dreams of software engineering is unrestricted composability. + +This may be put in these terms: + +let `ap1` and `ap2` two applications with arbitrary complexity, with all effects including multiple threads, asynchronous IO, indeterminism, events and perhaps, distributed computing. + +Then the combinations: + + - ap1 <|> ap2 -- Alternative expression + - ap1 >>= \x -> ap2 -- monadic sequence + - ap1 <> ap2 -- monoidal expression + - (,) <$> ap1 <*> ap2 -- Applicative expression + +are possible if the types match, and generate new applications that are composable as well. + +Transient does exactly that. + +The operators `<$>` `<*>` and `<>` express concurrency, the operator `<|>` express parallelism and `>>=` for sequencing of threads and/or distributed processes. So even in the presence of these effects and others, everything is composable. + +For this purpose transient is an extensible effects monad with all major effects and primitives for parallelism, events, asynchronous IO, early termination, non-determinism logging and distributed computing. Since it is possible to extend it with more effects without adding monad transformers, the composability is assured. + +Documentation +============= + +The [Wiki](https://github.com/agocorona/transient/wiki) is more user oriented + +My video sessions in [livecoding.tv](https://www.livecoding.tv/agocorona/videos/) not intended as tutorials or presentations, but show some of the latest features running. + +The articles are more technical: + +- [Philosophy, async, parallelism, thread control, events, Session state](https://www.fpcomplete.com/user/agocorona/EDSL-for-hard-working-IT-programmers?show=tutorials) +- [Backtracking and undoing IO transactions](https://www.fpcomplete.com/user/agocorona/the-hardworking-programmer-ii-practical-backtracking-to-undo-actions?show=tutorials) +- [Non-deterministic list like processing, multithreading](https://www.fpcomplete.com/user/agocorona/beautiful-parallel-non-determinism-transient-effects-iii?show=tutorials) +- [Distributed computing](https://www.fpcomplete.com/user/agocorona/moving-haskell-processes-between-nodes-transient-effects-iv?show=tutorials) +- [Publish-Subscribe variables](https://www.schoolofhaskell.com/user/agocorona/publish-subscribe-variables-transient-effects-v) +- [Distributed streaming, map-reduce](https://www.schoolofhaskell.com/user/agocorona/estimation-of-using-distributed-computing-streaming-transient-effects-vi-1) + +These articles contain executable examples (not now, since the site no longer support the execution of haskell snippets). diff --git a/src/Transient/Base.hs b/src/Transient/Base.hs --- a/src/Transient/Base.hs +++ b/src/Transient/Base.hs @@ -249,7 +249,7 @@ ,parallel, async, waitEvents, sample, spawn, react -- * State management -,setData, getSData, getData, delData, modifyData, try, setState, getState, delState, modifyState +,setData, getSData, getData, delData, modifyData, try, setState, getState, delState, getRState,setRState, modifyState -- * Thread management , threads,addThreads, freeThreads, hookedThreads,oneThread, killChilds diff --git a/src/Transient/Internals.hs b/src/Transient/Internals.hs --- a/src/Transient/Internals.hs +++ b/src/Transient/Internals.hs @@ -56,7 +56,7 @@ {-# INLINE (!>) #-} (!>) :: Show a => b -> a -> b -(!>) x y = trace (show y) x +(!>) x y = trace (show y) x infixr 0 !> #else @@ -342,11 +342,11 @@ -- ex <- liftIO' $ (mx >>= return . Right) `catch` -- (\(e :: SomeException) -> return $ Left e) -- case ex of - -- Left e -> back e -- finish $ Just e + -- Left e -> back e -- Right x -> return x -- where liftIO x = Transient $ liftIO x >>= return . Just - -- let x= liftIO io in x `seq` lift x + instance Monoid a => Monoid (TransIO a) where mappend x y = mappend <$> x <*> y @@ -796,6 +796,27 @@ delState :: (MonadState EventF m, Typeable a) => a -> m () delState = delData + +-- STRefs for the Transient monad + +newtype Ref a = Ref (IORef a) + +-- | mutable state reference that can be updated (similar to STRef in the state monad) +-- +-- Initialized the first time it is set. +setRState:: Typeable a => a -> TransIO () +setRState x= do + Ref ref <- getSData + liftIO $ atomicModifyIORef ref $ const (x,()) + <|> do + ref <- liftIO (newIORef x) + setData $ Ref ref + +getRState :: Typeable a => TransIO a +getRState= do + Ref ref <- getSData + liftIO $ readIORef ref + -- | Run an action, if the result is a void action undo any state changes -- that it might have caused. try :: TransIO a -> TransIO a @@ -803,7 +824,7 @@ sd <- gets mfData mx <|> (modify (\s -> s { mfData = sd }) >> empty) --- | Executes the computation and reset the state either if it fails or not +-- | Executes the computation and reset the state either if it fails or not. sandbox :: TransIO a -> TransIO a sandbox mx = do sd <- gets mfData @@ -885,31 +906,8 @@ v' <- readIORef prev if v /= v' then writeIORef prev v >> return v else loop' ---serial :: IO (StreamData b) -> TransIO (StreamData b) ---serial ioaction= Transient $ do --- cont <- get -- !> "PARALLEL" --- case event cont of --- j@(Just _) -> do --- put cont{event=Nothing} --- return $ unsafeCoerce j --- Nothing -> do --- liftIO $ loop cont ioaction --- return Nothing --- --- where loop cont ioaction= do --- let iocont dat= do --- runStateT (runCont cont) cont{event= Just $ unsafeCoerce dat} --- return () --- mdat <- ioaction `catch` \(e :: SomeException) -> return $ SError e --- case mdat of --- se@(SError _) -> iocont se --- SDone -> iocont SDone --- last@(SLast _) -> iocont last --- --- more@(SMore _) -> do --- iocont more --- loop cont ioaction + -- | Run an IO action one or more times to generate a stream of tasks. The IO -- action returns a 'StreamData'. When it returns an 'SMore' or 'SLast' a new -- task is triggered with the result value. If the return value is 'SMore', the @@ -980,7 +978,7 @@ label <- newIORef (Alive, BS.pack "work") let cont = parent{parent=Just parent,children= chs, labelth= label} - forkFinally1 (do + forkFinally1 (do th <- myThreadId let cont'= cont{threadId=th} when(not $ freeTh parent )$ hangThread parent cont' @@ -989,17 +987,12 @@ proc cont') $ \me -> do --- case me of -- !> "THREAD END" of --- Left e -> do ----- when (fromException e /= Just ThreadKilled)$ --- liftIO $ print e --- killChildren $ children cont ----- !> "KILL RECEIVED" ++ (show $ unsafePerformIO myThreadId) --- --- Right _ -> + case me of + Left e -> exceptBack cont e >> return () + _ -> case maxThread cont of Just sem -> signalQSemB sem -- !> "freed thread" Nothing -> when(not $ freeTh parent ) $ do -- if was not a free thread @@ -1016,7 +1009,7 @@ forkFinally1 :: IO a -> (Either SomeException a -> IO ()) -> IO ThreadId forkFinally1 action and_then = mask $ \restore -> forkIO $ Control.Exception.try (restore action) >>= and_then - + free th env= do -- return () !> ("freeing",th,"in",threadId env) let sibling= children env @@ -1113,26 +1106,9 @@ -- 'empty' in an 'Alternative' composition. abduce = async $ return () --- Transient $ do --- st <- get --- case event st of --- Just _ -> do --- put st{event=Nothing} --- return $ Just () --- Nothing -> do --- chs <- liftIO $ newMVar [] --- --- label <- liftIO $ newIORef (Alive, BS.pack "abduce") --- liftIO $ forkIO $ do --- th <- myThreadId --- let st' = st{event= Just (),parent=Just st,children= chs, threadId=th,labelth= label} --- liftIO $ hangThread st st' --- --- runCont' st' --- return() --- return Nothing + -- * non-blocking keyboard input getLineRef= unsafePerformIO $ newTVarIO Nothing @@ -1176,17 +1152,25 @@ case mr of Nothing -> STM.retry Just r -> - case reads1 r of - (s,_):_ -> if cond s -- !> show (cond s) + case reads2 r of + (s,_):_ -> if cond s !> show (cond s) then do unsafeIOToSTM $ print s - writeTVar getLineRef Nothing -- !>"match" + writeTVar getLineRef Nothing !>"match" return $ Just s else return mv - _ -> return mv + _ -> return mv !> "return " + where + reads2 s= x where + x= if typeOf(typeOfr x) == typeOf "" + then unsafeCoerce[(s,"")] + else unsafePerformIO $ return (reads s) `catch` \(e :: SomeException) -> (return []) + typeOfr :: [(a,String)] -> a + typeOfr = undefined + -- | Non blocking `getLine` with a validator getLine' cond= do atomically $ do @@ -1240,7 +1224,7 @@ in breakSlash (res++[r]) $ tail1 rest breakSlash res s= - let (r,rest) = span(/= '/') s + let (r,rest) = span(\x -> x /= '/' && x /= ' ') s in breakSlash (res++[r]) $ tail1 rest tail1 []=[] @@ -1400,7 +1384,7 @@ -- | Delete all the undo actions registered till now for the given track id. backCut :: (Typeable b, Show b) => b -> TransientIO () backCut reason= Transient $ do - delData $ Backtrack (Just reason) [] + delData $ Backtrack (Just reason) [] return $ Just () -- | 'backCut' for the default track; equivalent to @backCut ()@. @@ -1418,7 +1402,7 @@ runTrans $ case mreason of Nothing -> ac Just reason -> do - setState $ Backtrack mreason $ tail stack -- to avoid recursive call tot he same handler + -- setState $ Backtrack mreason $ tail stack -- to avoid recursive call tot he same handler bac reason where typeof :: (b -> TransIO a) -> b @@ -1442,6 +1426,7 @@ md <- getData `asTypeOf` (Just <$> backStateOf witness) case md of + Just (Backtrack _ []) -> empty Just (bss@(Backtrack b (bs@((EventF _ _ x' _ _ _ _ _ _ _ _ _):_)))) -> when (isNothing b) $ do addrx <- addr x @@ -1477,7 +1462,7 @@ -- | Abort finish. Stop executing more finish actions and resume normal -- execution. Used inside 'onFinish' actions. -- -noFinish= forward (FinishReason Nothing) +noFinish= continue -- | Start the undo process for the given undo track id. Performs all the undo -- actions registered till now in reverse order. An undo action can use @@ -1487,8 +1472,8 @@ -- back :: (Typeable b, Show b) => b -> TransientIO a back reason = Transient $ do - bs <- getData `onNothing` backStateOf reason -- !!>"GOBACK" - goBackt bs + bs <- getData `onNothing` backStateOf reason + goBackt bs -- !!>"GOBACK" where @@ -1496,16 +1481,16 @@ goBackt (Backtrack b (stack@(first : bs)) )= do setData $ Backtrack (Just reason) stack - mr <- runClosure first -- !> "RUNCLOSURE" + mr <- runClosure first -- !> ("RUNCLOSURE",length stack) Backtrack back _ <- getData `onNothing` backStateOf reason -- !> "END RUNCLOSURE" case mr of - Nothing -> return empty -- !> "END EXECUTION" + Nothing -> return empty -- !> "END EXECUTION" Just x -> case back of - Nothing -> runContinuation first x -- !> "FORWARD EXEC" - justreason -> goBackt $ Backtrack justreason bs -- !> ("BACK AGAIN",back) + Nothing -> runContinuation first x -- !> "FORWARD EXEC" + justreason -> goBackt $ Backtrack justreason bs -- !> ("BACK AGAIN",back) backStateOf :: (Monad m, Show a, Typeable a) => a -> m (Backtrack a) backStateOf reason= return $ Backtrack (Nothing `asTypeOf` (Just reason)) [] @@ -1518,35 +1503,39 @@ ------ finalization -newtype FinishReason= FinishReason (Maybe SomeException) deriving (Typeable, Show) +newtype Finish= Finish String deriving Show +instance Exception Finish + +-- newtype FinishReason= FinishReason (Maybe SomeException) deriving (Typeable, Show) + -- | Clear all finish actions registered till now. -initFinish= backCut (FinishReason Nothing) +-- initFinish= backCut (FinishReason Nothing) -- | Register an action that to be run when 'finish' is called. 'onFinish' can -- be used multiple times to register multiple actions. Actions are run in -- reverse order. Used in infix style. -- -onFinish :: ((Maybe SomeException) ->TransIO ()) -> TransIO () -onFinish f= onFinish' (return ()) f +onFinish :: (Finish ->TransIO ()) -> TransIO () +onFinish f= onException' (return ()) f -- | Run the action specified in the first parameter and register the second -- parameter as a finish action to be run when 'finish' is called. Used in -- infix style. -- -onFinish' ::TransIO a ->((Maybe SomeException) ->TransIO a) -> TransIO a -onFinish' proc f= proc `onBack` \(FinishReason reason) -> - f reason +onFinish' ::TransIO a ->(Finish ->TransIO a) -> TransIO a +onFinish' proc f= proc `onException'` f -- | Execute all the finalization actions registered up to the last -- 'initFinish', in reverse order. Either an exception or 'Nothing' can be +initFinish = cutExceptions -- passed to 'finish'. The argument passed is made available in the 'onFinish' -- actions invoked. -- -finish :: Maybe SomeException -> TransIO a -finish reason= back (FinishReason reason) +finish :: String -> TransIO a +finish reason= throwt $ Finish reason @@ -1555,15 +1544,15 @@ case v of SDone -> stop SLast x -> return x - SError e -> back e + SError e -> throwt e SMore x -> return x ------ exceptions --- -- --- | Install an exception handler. On exception, currently installed handlers --- are executed in reverse (i.e. last in first out) order. Note that multiple --- handlers can be installed for the same exception type. +-- | Install an exception handler. Handlers are executed in reverse (i.e. last in, first out) order when such exception happens in the +-- continuation. Note that multiple handlers can be installed for the same exception type. -- +-- The semantic is thus very different than the one of `Control.Exception.Base.onException` onException :: Exception e => (e -> TransIO ()) -> TransIO () onException exc= return () `onException'` exc @@ -1575,9 +1564,9 @@ Just e' -> f e' where onAnyException :: TransIO a -> (SomeException ->TransIO a) -> TransIO a - onAnyException mx f= ioexp `onBack` f - - ioexp = Transient $ do + onAnyException mx f= ioexp `onBack` f + + ioexp = Transient $ do st <- get (mx,st') <- liftIO $ (runStateT (do @@ -1586,37 +1575,83 @@ r <- runTrans mx -- !> "mx" modify $ \s -> s{event= Just $ unsafeCoerce r} - - runCont st -- !> "runcont" + + + runCont st was <- getData `onNothing` return NoRemote when (was /= WasRemote) $ setData WasParallel return Nothing + Just r -> do - modify $ \s -> s{event=Nothing} - return $ unsafeCoerce r) st) - `catch` \(e ::SomeException) -> runStateT ( runTrans $ back e ) st + modify $ \s -> s{event=Nothing} + return $ unsafeCoerce r) st) + `catch` exceptBack st put st' return mx + +exceptBack st = \(e ::SomeException) -> do -- recursive catch itself + -- return () !> "CATCH" + runStateT ( runTrans $ back e ) st + `catch` exceptBack st + + + -- | Delete all the exception handlers registered till now. -cutExceptions= backCut (undefined :: SomeException) +cutExceptions :: TransIO () +cutExceptions= backCut (undefined :: SomeException) --- | Used inside an exception handler. Stop executing any further exception +-- | Use it inside an exception handler. it stop executing any further exception -- handlers and resume normal execution from this point on. --- -continue = forward (undefined :: SomeException) - +continue :: TransIO () +continue = forward (undefined :: SomeException) !> "CONTINUE" -catcht mx exc= sandbox $ do +-- | catch an exception in a Transient block +-- +-- The semantic is the same than `catch` but the computation and the exception handler can be multirhreaded +catcht :: Exception e => TransIO b -> (e -> TransIO b) -> TransIO b +catcht mx exc= do + rpassed <- liftIO $ newIORef False + sandbox $ do cutExceptions - onException' mx exc + r <- onException' mx (\e -> do + passed <- liftIO $ readIORef rpassed + if not passed then continue >> exc e else empty) + liftIO $ writeIORef rpassed True + return r where - sandbox mx= do + sandbox mx= do exState <- getState <|> backStateOf (undefined :: SomeException) mx - <*** setState exState + <*** do setState exState +-- | throw an exception in the Transient monad throwt :: Exception e => e -> TransIO a throwt= back . toException + +-- catcht1 :: Exception e => TransIO a -> (e ->TransIO a) -> TransIO a +-- catcht1 mx exc= Transient $ do +-- st <- get + +-- case event st of +-- Nothing -> do +-- (mx,st') <- liftIO $ (runStateT(runTrans mx) st ) `catch` \(e ::SomeException) -> +-- runStateT ( runTrans $ f e ) st +-- put st' +-- modify $ \s -> s{event= Just $ unsafeCoerce mx} +-- runCont st +-- was <- getData `onNothing` return NoRemote +-- when (was /= WasRemote) $ setData WasParallel + +-- return Nothing + +-- Just r -> do +-- modify $ \s -> s{event=Nothing} +-- return $ unsafeCoerce r + +-- where +-- f e=case fromException e of +-- Nothing -> empty +-- Just e' -> exc e' diff --git a/transient.cabal b/transient.cabal --- a/transient.cabal +++ b/transient.cabal @@ -1,5 +1,5 @@ name: transient -version: 0.5.6 +version: 0.5.8 author: Alberto G. Corona extra-source-files: ChangeLog.md README.md