chan-split 0.4.0 → 0.5.0

raw patch · 3 files changed

+266/−10 lines, 3 filesdep +stmPVP ok

version bump matches the API change (PVP)

Dependencies added: stm

API changes (from Hackage documentation)

Files

• Control/Concurrent/STM/TChan/Class.hs +63/−0
• Control/Concurrent/STM/TChan/Split.hs +192/−0
• chan-split.cabal +11/−10

@@ -0,0 +1,63 @@+{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}+module Control.Concurrent.STM.TChan.Class +    where++import qualified Control.Concurrent.STM.TChan as C+import Control.Concurrent.STM+++-- | A class capturing Chan operations in STM.+class SplitTChan i o | i -> o, o -> i where+    -- | Write a value to the in chan.+    writeTChan :: i a -> a -> STM ()+    -- | Read the next value from the out chan.+    readTChan :: o a -> STM a+    -- | Get the next value from the @TChan@ without removing it,+    -- retrying if the channel is empty.+    peekTChan :: o a -> STM a+    -- | A version of 'peekTChan' which does not retry. Instead it+    -- returns @Nothing@ if no value is available.+    tryPeekTChan :: o a -> STM (Maybe a)+    -- | A version of 'readTChan' which does not retry. Instead it+    -- returns @Nothing@ if no value is available.+    tryReadTChan :: o a -> STM (Maybe a)+    -- |Returns 'True' if the supplied 'TChan' is empty.+    isEmptyTChan :: o a -> STM Bool++++-- | A class for 'SplitTChan' types that can be instantiated without programmer+-- input. /e.g./ the standard haskell @TChan@ is a member of this class, however+-- a bounded chan type that took an @Int@ to define the buffer size would not.+class (SplitTChan i o)=> NewSplitTChan i o where+    newSplitTChan :: STM (i a, o a)++++-- instances -- +++-- one-bounded chan:+instance SplitTChan TMVar TMVar where+    readTChan = takeTMVar+    writeTChan = putTMVar+    peekTChan = readTMVar+    tryReadTChan = tryTakeTMVar+    tryPeekTChan = tryReadTMVar+    isEmptyTChan = isEmptyTMVar++instance SplitTChan C.TChan C.TChan where+    writeTChan = C.writeTChan+    readTChan = C.readTChan+    peekTChan = C.peekTChan+    tryReadTChan = C.tryReadTChan+    tryPeekTChan = C.tryPeekTChan+    isEmptyTChan = C.isEmptyTChan++instance NewSplitTChan TMVar TMVar where+    newSplitTChan = do v <- newEmptyTMVar+                       return (v,v)++instance NewSplitTChan TChan TChan where+    newSplitTChan = do v <- C.newTChan+                       return (v,v)

@@ -0,0 +1,192 @@+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# LANGUAGE DeriveDataTypeable #-}++module Control.Concurrent.STM.TChan.Split (+    -- | Much of the STM chan functionality exists in the 'SplitTChan' and class,+    -- which you should see for documentation.+	+	-- * TChan pairs+	InTChan,+	OutTChan,++    -- ** Construction+    -- | See also the 'NewSplitTChan' class.+	+	--newBroadcastTChan, --replaced by...+	newInTChan,+	-- *** In IO+	newSplitTChanIO,+	--newBroadcastTChanIO, --replaced by...+	newInTChanIO,++    -- ** Putting values back+    unGetTChan,+    +    -- ** Duplication+    dupTChan,+    cloneTChan+  ) where++import GHC.Conc++import Data.Typeable (Typeable)++import Control.Concurrent.STM.TChan.Class++-- | The input side of an unbounded FIFO channel.+newtype InTChan a = InTChan (TVar (TVarList a))+  deriving (Eq, Typeable)++-- | The output side of an unbounded FIFO channel.+newtype OutTChan a = OutTChan (TVar (TVarList a))+  deriving (Eq, Typeable)++type TVarList a = TVar (TList a)+data TList a = TNil | TCons a {-# UNPACK #-} !(TVarList a)++instance NewSplitTChan InTChan OutTChan where +    newSplitTChan = do+      hole <- newTVar TNil+      read <- newTVar hole+      write <- newTVar hole+      return (InTChan write, OutTChan read)++instance SplitTChan InTChan OutTChan where+    writeTChan (InTChan write) a = do+      listend <- readTVar write -- listend == TVar pointing to TNil+      new_listend <- newTVar TNil+      writeTVar listend (TCons a new_listend)+      writeTVar write new_listend++    readTChan (OutTChan read) = do+      listhead <- readTVar read+      head <- readTVar listhead+      case head of+        TNil -> retry+        TCons a tail -> do+        writeTVar read tail+        return a++    tryReadTChan (OutTChan read) = do+      listhead <- readTVar read+      head <- readTVar listhead+      case head of+        TNil       -> return Nothing+        TCons a tl -> do+          writeTVar read tl+          return (Just a)++    peekTChan (OutTChan read) = do+      listhead <- readTVar read+      head <- readTVar listhead+      case head of+        TNil      -> retry+        TCons a _ -> return a++    tryPeekTChan (OutTChan read) = do+      listhead <- readTVar read+      head <- readTVar listhead+      case head of+        TNil      -> return Nothing+        TCons a _ -> return (Just a)++    isEmptyTChan (OutTChan read) = do+      listhead <- readTVar read+      head <- readTVar listhead+      case head of+        TNil -> return True+        TCons _ _ -> return False+++-- |@IO@ version of 'newTChan'.  This is useful for creating top-level+-- 'TChan's using 'System.IO.Unsafe.unsafePerformIO', because using+-- 'atomically' inside 'System.IO.Unsafe.unsafePerformIO' isn't+-- possible.+newSplitTChanIO :: IO (OutTChan a, InTChan a)+newSplitTChanIO = do+  hole <- newTVarIO TNil+  read <- newTVarIO hole+  write <- newTVarIO hole+  return (OutTChan read, InTChan write)+++-- -- | Create a write-only 'TChan'.  More precisely, 'readTChan' will 'retry'+-- -- even after items have been written to the channel.  The only way to read+-- -- a broadcast channel is to duplicate it with 'dupTChan'.+-- --+-- -- Consider a server that broadcasts messages to clients:+-- --+-- -- >serve :: TChan Message -> Client -> IO loop+-- -- >serve broadcastChan client = do+-- -- >    myChan <- dupTChan broadcastChan+-- -- >    forever $ do+-- -- >        message <- readTChan myChan+-- -- >        send client message+-- --+-- -- The problem with using 'newTChan' to create the broadcast channel is that if+-- -- it is only written to and never read, items will pile up in memory.  By+-- -- using 'newBroadcastTChan' to create the broadcast channel, items can be+-- -- garbage collected after clients have seen them.+-- newBroadcastTChan :: STM (TChan a)+-- newBroadcastTChan = do+--     dummy_hole <- newTVar TNil+--     write_hole <- newTVar TNil+--     read <- newTVar dummy_hole+--     write <- newTVar write_hole+--     return (TChan read write)++-- -- | @IO@ version of 'newBroadcastTChan'.+-- newBroadcastTChanIO :: IO (TChan a)+-- newBroadcastTChanIO = do+--     dummy_hole <- newTVarIO TNil+--     write_hole <- newTVarIO TNil+--     read <- newTVarIO dummy_hole+--     write <- newTVarIO write_hole+--     return (TChan read write)++-- ------------------------------+-- NOTE: functions above are useful, but description of usage isn't relevant I don't +-- think; messages should be garbage collected once the read end is GC'd (i.e.+-- in the scenarion where there are only writers and no readers.+--+-- The equivalent functions are still useful to have though:+-- ------------------------------++-- | Create a new write end of a TChan. Use 'dupTChan' to get an 'OutChan' that+-- values can be read from.+newInTChan :: STM (InTChan a)+newInTChan = do+    write_hole <- newTVar TNil+    write <- newTVar write_hole+    return (InTChan write)+++-- | @IO@ version of 'newInTChan'.+newInTChanIO :: IO (InTChan a)+newInTChanIO = do+    write_hole <- newTVarIO TNil+    write <- newTVarIO write_hole+    return (InTChan write)++-- |Create a duplicate 'OutChan' from an 'InChan'. The 'OutChan' starts +-- empty but will receive a copy of all subsequent values written.+dupTChan :: InTChan a -> STM (OutTChan a)+dupTChan (InTChan write) = do+  hole <- readTVar write  +  new_read <- newTVar hole+  return (OutTChan new_read)++-- |Put a data item back onto a channel, where it will be the next item read.+unGetTChan :: OutTChan a -> a -> STM ()+unGetTChan (OutTChan read) a = do+   listhead <- readTVar read+   newhead <- newTVar (TCons a listhead)+   writeTVar read newhead++-- |Clone a 'TChan': similar to dupTChan, but the cloned channel starts with the+-- same content available as the original channel.+cloneTChan :: OutTChan a -> STM (OutTChan a)+cloneTChan (OutTChan read) = do+  readpos <- readTVar read+  new_read <- newTVar readpos+  return (OutTChan new_read)

@@ -3,12 +3,12 @@ -- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr. -- The name of the package. Name:                chan-split-Homepage:            http://coder.bsimmons.name/blog/2011/07/module-chan-split-released/+Homepage:            http://brandon.si/code/module-chan-split-released/  -- The package version. See the Haskell package versioning policy -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for -- standards guiding when and how versions should be incremented.-Version:             0.4.0+Version:             0.5.0  -- A short (one-line) description of the package. Synopsis:            Concurrent Chans as read/write pairs. Also provides generic@@ -51,13 +51,13 @@                      .                      This module is used internally by the "simple-actors" package.                      .-                     /CHANGES/: 0.3.0 -> 0.4.0  -                     . -                     - In\/OutChans now implemented from scratch (after Leon P Smith's implementation)-                     . -                     - no longer implement Functor\/Contravariant instances; drop contravariant dependency+                     /CHANGES/: 0.4.0 -> 0.5.0                        . -                     - implement Eq and Typeable instances+                     - modify TChan v2.4 code into split version+                     .+                     - depend on STM+                     .+                     - clean up Extensions section and broken links                      .   @@ -97,13 +97,14 @@                      -- for the split chan class:   Extensions:          MultiParamTypeClasses                      , FunctionalDependencies -                     -- for Functor / Contravariant instances:-                     , GADTs    Exposed-modules:     Control.Concurrent.Chan.Split                      , Control.Concurrent.Chan.Class+                     , Control.Concurrent.STM.TChan.Class+                     , Control.Concurrent.STM.TChan.Split      Build-depends:       base >= 4 && < 5+                     , stm > 2 && < 3      ghc-options:        -Wall