transient 0.1.0.0 → 0.1.0.1

raw patch · 3 files changed

+79/−11 lines, 3 files

Files

• Main.hs +9/−9
• src/Transient/EVars.hs +68/−0
• transient.cabal +2/−2

@@ -34,7 +34,7 @@ 
       nonDeterminsm <|> trans <|>
              colors <|> app   <|>
-            futures <|> server <|> 
+            futures <|> server <|>
             distributed <|> pubSub
 
 solveConstraint=  do
@@ -320,24 +320,24 @@ pubSub=  do
   option "pubs" "an example of publish-subscribe using Event Vars (EVars)"
   v <- newEVar  :: TransIO (EVar String)
-  v' <- newEVar 
+  v' <- newEVar
   suscribe v v' <|> publish v v'
-  where 
-      
+  where
+
   publish v v'= do
     liftIO $ putStrLn "Enter a message to publish"
-    msg <- input(const True)
+    msg <-  input(const True)
     writeEVar v msg
     liftIO $ putStrLn "after writing first EVar\n"
     writeEVar v' $ "second " ++ msg
     liftIO $ putStrLn "after writing second EVar\n"
     publish v v'
-    
+
   suscribe :: EVar String -> EVar String -> TransIO ()
   suscribe v v'= do
        r <- (,) <$> proc1 v  <*>  proc2 v'
        liftIO $ do
-             putStr $ "applicative result= " 
+             putStr "applicative result= "
              print r
 
   suscribe2 ::  EVar String -> EVar String -> TransIO ()
@@ -349,10 +349,10 @@                  print (x,y)
 
   proc1 v=  do
-    msg <- readEVar v 
+    msg <- readEVar v
     liftIO $ putStrLn $  "proc1 readed var: " ++ show msg
     return msg
-    
+
   proc2 v= do
     msg <- readEVar v
     liftIO $ putStrLn $ "proc2 readed var: " ++ show msg

@@ -0,0 +1,68 @@+{-# LANGUAGE DeriveDataTypeable #-}
+module Transient.EVars where
+
+import Transient.Base
+import qualified Data.Map as M
+import Data.Typeable
+
+import Control.Concurrent
+import Control.Applicative
+import Data.IORef
+import Control.Monad.IO.Class
+import Control.Monad.State
+
+newtype EVars= EVars  (IORef (M.Map Int [EventF]))  deriving Typeable
+
+data EVar a= EVar Int (IORef (Maybe a))
+
+-- * Evars are event vars. `writeEVar` trigger the execution of all the continuations associated to the  `readEVar` of this variable
+-- (the code that is after them) as  stack: the most recent reads are executed first.
+--
+-- It is like the publish-subscribe pattern but without inversion of control, since a readEVar can be inserted at any place in the
+-- Transient flow.
+--
+-- EVars are created upstream and can be used to communicate two sub-threads of the monad. Following the Transient philosophy they 
+-- do not block his own thread if used with alternative operators, unlike the IORefs and TVars. And unlike STM vars, that are composable,
+-- they wait for their respective events, while TVars execute the whole expression when any variable is modified.
+-- 
+-- The execution continues after the writeEVar when all subscribers have been executed.
+--
+-- see https://www.fpcomplete.com/user/agocorona/publish-subscribe-variables-transient-effects-v
+-- 
+
+
+newEVar ::  TransientIO (EVar a)
+newEVar  = Transient $ do
+   EVars ref <- getSessionData `onNothing`  do
+                            ref <- liftIO $ newIORef M.empty
+                            setSData $ EVars ref
+                            return  (EVars ref) 
+   id <- genNewId
+   ref <- liftIO $ newIORef Nothing
+   return . Just $ EVar id ref
+
+readEVar :: EVar a -> TransIO a
+readEVar (EVar id ref1)= Transient $ do 
+   mr <- liftIO $ readIORef ref1
+   case mr of
+     Just _ -> return mr
+     Nothing -> do
+         cont <- getCont
+         EVars ref <- getSessionData `onNothing` error "No Events context"
+         map <- liftIO $ readIORef ref
+         let Just conts=  M.lookup  id map <|> Just []
+         liftIO $ writeIORef ref $  M.insert id (cont:conts) map
+         return Nothing
+         
+writeEVar (EVar id ref1) x= Transient $ do
+   EVars ref <- getSessionData `onNothing`  error "No Events context" 
+   liftIO $ writeIORef ref1 $ Just x
+   map <- liftIO $ readIORef ref
+   let Just conts= M.lookup id map <|> Just []
+   mapM runCont conts 
+   liftIO $ writeIORef ref1 Nothing
+   return $ Just ()
+ 
+
+
+

@@ -2,7 +2,7 @@ synopsis: A monad for extensible effects and primitives for unrestricted composability of applications
 homepage: http://www.fpcomplete.com/user/agocorona
 bug-reports: https://github.com/agocorona/transient/issues
-version: 0.1.0.0
+version: 0.1.0.1
 cabal-version: >=1.10
 build-type: Simple
 license: GPL-3
@@ -20,7 +20,7 @@                    directory -any, filepath -any, stm -any, HTTP -any, network -any,
                    transformers -any, process -any, network-info -any
 
-    exposed-modules: Transient.Indeterminism Transient.Base
+    exposed-modules: Transient.Indeterminism Transient.Base Transient.EVars
                      Transient.Backtrack Transient.Move Transient.Logged
     exposed: True
     buildable: True