transient 0.5.3 → 0.5.4
raw patch · 4 files changed
+85/−103 lines, 4 filesdep ~base
Dependency ranges changed: base
Files
- README.md +22/−5
- src/Transient/Internals.hs +43/−84
- src/Transient/Logged.hs +13/−11
- transient.cabal +7/−3
README.md view
@@ -1,12 +1,29 @@- + +========= +[](http://hackage.haskell.org/package/transient) +[](http://stackage.org/lts/package/transient) +[](http://stackage.org/nightly/package/transient) +[](https://travis-ci.org/transient-haskell/transient) +[](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) -transient -========= -One of the biggest dreams of software engineering is unrestricted composability. +## 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. @@ -22,7 +39,7 @@ Transient does exactly that. -The operators `<|>` and `<>` can be used for concurrency, the operator `<|>` can be used for parallelism and `>>=` for sequencing of threads and/or distributed processes. So even in the presence of these effects and others, everything is composable. +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.
src/Transient/Internals.hs view
@@ -47,15 +47,15 @@ import System.IO import System.Exit -import qualified Data.ByteString.Lazy.Char8 as BS -import Data.ByteString.Builder +import qualified Data.ByteString.Char8 as BS -{-# INLINE (!>) #-} -(!>) :: Show a => b -> a -> b -(!>) x y= trace (show y) x -infixr 0 !> +-- {-# INLINE (!>) #-} +--(!>) :: Show a => b -> a -> b +--(!>) x y= trace (show y) x +--infixr 0 !> + -- (!>) x y= x @@ -287,75 +287,34 @@ readsPrec' _= unsafePerformIO . readWithErr ---class (Show a, Read a, Typeable a) => Loggable a where - -class Typeable a => Loggable a where - serialize :: a -> Builder - safeDeserialize :: BS.ByteString -> Maybe a - -deserialize str = r - where - r= case safeDeserialize str of - Just x -> x - Nothing -> error $ "deserialization failure for (string,to type): " ++ show (BS.unpack str,typeOf r) +class (Show a, Read a, Typeable a) => Loggable a where ---instance (Show a, Read a,Typeable a) => Loggable a where +instance (Show a, Read a,Typeable a) => Loggable a where -- | Dynamic serializable data for logging -data IDynamic= IDyns BS.ByteString | forall a.Loggable a => IDynamic a - -instance Loggable IDynamic where - serialize (IDynamic x)= serialize x - serialize (IDyns s)= lazyByteString s - safeDeserialize str= Just $ IDyns str - -comma= BS.pack "," +data IDynamic= IDyns String | forall a.Loggable a => IDynamic a instance Show IDynamic where - show = BS.unpack . toLazyByteString . serialize + show (IDynamic x)= show $ show x + show (IDyns s)= show s -instance Show Builder where - show = show . toLazyByteString +instance Read IDynamic where + readsPrec n str= map (\(x,s) -> (IDyns x,s)) $ readsPrec' n str + type Recover= Bool type CurrentPointer= [LogElem] type LogEntries= [LogElem] -data LogElem= Wait | Exec | Var IDynamic deriving (Show) +data LogElem= Wait | Exec | Var IDynamic deriving (Read,Show) +data Log= Log Recover CurrentPointer LogEntries deriving (Typeable, Show) ---instance (Read a,Show a , Typeable a) => Loggable a where --- serialize = BS.pack . show --- deserialize= read . BS.unpack -instance Loggable LogElem where - serialize Wait= lazyByteString $ BS.pack "Wait" - serialize Exec= lazyByteString $ BS.pack "Exec" - serialize (Var dyn)= serialize dyn - safeDeserialize str - | str== BS.pack "Wait" = Just Wait - | str== BS.pack "Exec" = Just Exec - | otherwise= Just . Var $ deserialize str - -instance Loggable [LogElem] where - serialize xs= mconcat $ map serialize' xs - where serialize' x= (serialize'' x) <> lazyByteString comma - serialize'' :: LogElem -> Builder - serialize'' x= let serx= toLazyByteString $ serialize x in lazyByteString $ (BS.pack . show $ BS.length serx) <> comma <> serx - - safeDeserialize str - | BS.null str= Just [] - | otherwise = case BS.readInt str of - Just(n,str') -> let (str'', str''')= BS.splitAt (fromIntegral n+1) str' - in Just $ deserialize (BS.tail str'') : if BS.null str''' then [] else deserialize (BS.tail str''') - Nothing -> Nothing - instance Alternative TransIO where empty = Transient $ return Nothing (<|>) = mplus -data Log= Log Recover CurrentPointer LogEntries deriving (Typeable) - data RemoteStatus= WasRemote | WasParallel | NoRemote deriving (Typeable, Eq, Show) instance MonadPlus TransIO where @@ -1083,8 +1042,6 @@ -- -- it configures the event handler by calling the setter of the event -- handler with the current continuation --- --- react is composable with applicative and alternative operators too react :: Typeable eventdata => ((eventdata -> IO response) -> IO ()) @@ -1109,27 +1066,26 @@ -- -- Useful for executing alternative computations -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 +abduce = 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 @@ -1357,12 +1313,10 @@ {-# NOINLINE onBack #-} onBack :: (Typeable b, Show b) => TransientIO a -> ( b -> TransientIO a) -> TransientIO a onBack ac bac = registerBack (typeof bac) $ Transient $ do - Backtrack mreason stack <- getData `onNothing` backStateOf (typeof bac) + Backtrack mreason _ <- getData `onNothing` backStateOf (typeof bac) runTrans $ case mreason of Nothing -> ac - Just reason -> do - setState $ Backtrack mreason $ tail stack -- to avoid recursive call tot he same handler - bac reason + Just reason -> bac reason where typeof :: (b -> TransIO a) -> b typeof = undefined @@ -1371,7 +1325,7 @@ onUndo x y= onBack x (\() -> y) --- | Register an action that will be executed when backtracking of a given type +-- | Register an action that will be executed when backtracking {-# NOINLINE registerUndo #-} registerBack :: (Typeable b, Show b) => b -> TransientIO a -> TransientIO a registerBack witness f = Transient $ do @@ -1421,12 +1375,17 @@ goBackt (Backtrack _ [] )= return Nothing -- !!> "END" goBackt (Backtrack b (stack@(first : bs)) )= do - setData $ Backtrack (Just reason) stack + (setData $ Backtrack (Just reason) stack) mr <- runClosure first -- !> "RUNCLOSURE" Backtrack back _ <- getData `onNothing` backStateOf reason -- !> "END RUNCLOSURE" +-- case back of +-- Nothing -> case mr of +-- Nothing -> return empty -- !> "FORWARD END" +-- Just x -> runContinuation first x -- !> "FORWARD EXEC" +-- justreason -> goBackt $ Backtrack justreason bs -- !> ("BACK AGAIN",back) case mr of Nothing -> return empty -- !> "END EXECUTION"
src/Transient/Logged.hs view
@@ -22,7 +22,8 @@ import Data.Typeable import Unsafe.Coerce -import Transient.Internals +import Transient.Base +import Transient.Internals(Loggable) import Transient.Indeterminism(choose) import Transient.Internals(onNothing,reads1,IDynamic(..),Log(..),LogElem(..),RemoteStatus(..),StateIO) import Control.Applicative @@ -30,9 +31,9 @@ import System.Directory import Control.Exception import Control.Monad -import qualified Data.ByteString as BS + #ifndef ghcjs_HOST_OS import System.Random #endif @@ -70,14 +71,15 @@ let list'= filter ((/=) '.' . head) list file <- choose list' -- !> list' - logstr <- liftIO $ BS.readFile (logs++file) - let log= BS.length logstr `seq` deserialize logstr + logstr <- liftIO $ readFile (logs++file) + let log= length logstr `seq` read' logstr log `seq` setData (Log True (reverse log) log) liftIO $ remove $ logs ++ file proc - where + read'= fst . head . reads1 + remove f= removeFile f `catch` (\(e::SomeException) -> remove f) @@ -112,7 +114,7 @@ fromIDyn :: Loggable a => IDynamic -> a fromIDyn (IDynamic x)=r where r= unsafeCoerce x -- !> "coerce" ++ " to type "++ show (typeOf r) -fromIDyn (IDyns s)=r `seq`r where r= deserialize s -- !> "read " ++ s ++ " to type "++ show (typeOf r) +fromIDyn (IDyns s)=r `seq`r where r= read s -- !> "read " ++ s ++ " to type "++ show (typeOf r) @@ -199,7 +201,7 @@ else return Nothing _ -> return Nothing where - show1 x= serialize x + show1 x= if typeOf x == typeOf "" then unsafeCoerce x else show x param :: Loggable a => TransIO a param= res where @@ -211,15 +213,15 @@ setData $ Log recover t full return $ cast v Var (IDyns s):t -> do - let mr = safeDeserialize s `asTypeOf` type1 res + let mr = reads1 s `asTypeOf` type1 res case mr of - Nothing -> return Nothing - Just v -> do + [] -> return Nothing + (v,r):_ -> do setData $ Log recover t full return $ Just v _ -> return Nothing where - type1 :: TransIO a -> Maybe a + type1 :: TransIO a -> [(a,String)] type1= error "type1: typelevel"
transient.cabal view
@@ -1,19 +1,23 @@ name: transient -version: 0.5.3 +version: 0.5.4 + author: Alberto G. Corona + extra-source-files: ChangeLog.md README.md +maintainer: agocorona@gmail.com + cabal-version: >=1.10 + build-type: Simple license: MIT license-file: LICENSE -maintainer: agocorona@gmail.com homepage: http://www.fpcomplete.com/user/agocorona bug-reports: https://github.com/agocorona/transient/issues @@ -21,6 +25,7 @@ description: See <http://github.com/agocorona/transient> In this release distributed primitives have been moved to the transient-universe package, and web primitives have been moved to the ghcjs-hplay package. category: Control + data-dir: "" @@ -48,7 +53,6 @@ exposed: True default-language: Haskell2010 hs-source-dirs: src . - source-repository head type: git