Many improvements

[Lucu.git] / Network / HTTP / Lucu / Interaction.hs

diff --git a/Network/HTTP/Lucu/Interaction.hs b/Network/HTTP/Lucu/Interaction.hs
index 44f4243b6ebe2abb5b02cb0891d783bd60f60655..6b872ca5ff24a38ab16b74fb32d4df7d40e06abd 100644 (file)
--- a/Network/HTTP/Lucu/Interaction.hs
+++ b/Network/HTTP/Lucu/Interaction.hs
@@ -4,6 +4,12 @@ module Network.HTTP.Lucu.Interaction
     , InteractionQueue
     , newInteractionQueue -- IO InteractionQueue
     , newInteraction      -- HostName -> Maybe Request -> IO Interaction
+
+    , writeItr   -- Interaction -> (Interaction -> TVar a) -> a -> STM ()
+    , readItr    -- Interaction -> (Interaction -> TVar a) -> (a -> b) -> STM b
+    , readItrF   -- (Functor f) => Interaction -> (Interaction -> TVar (f a)) -> (a -> b) -> STM (f b)
+    , updateItr  -- Interaction -> (Interaction -> TVar a) -> (a -> a) -> STM ()
+    , updateItrF -- (Functor f) => Interaction -> (Interaction -> TVar (f a)) -> (a -> a) -> STM ()
     )
     where
 
@@ -99,3 +105,29 @@ newInteraction host req
                     , itrWroteContinue = wroteContinue
                     , itrWroteHeader   = wroteHeader
                     }
+
+
+writeItr :: Interaction -> (Interaction -> TVar a) -> a -> STM ()
+writeItr itr accessor value
+    = writeTVar (accessor itr) value
+
+
+readItr :: Interaction -> (Interaction -> TVar a) -> (a -> b) -> STM b
+readItr itr accessor reader
+    = readTVar (accessor itr) >>= return . reader
+
+
+readItrF :: (Functor f) => Interaction -> (Interaction -> TVar (f a)) -> (a -> b) -> STM (f b)
+readItrF itr accessor reader
+    = readItr itr accessor (fmap reader)
+
+
+updateItr :: Interaction -> (Interaction -> TVar a) -> (a -> a) -> STM ()
+updateItr itr accessor updator
+    = do old <- readItr itr accessor id
+         writeItr itr accessor (updator old)
+
+
+updateItrF :: (Functor f) => Interaction -> (Interaction -> TVar (f a)) -> (a -> a) -> STM ()
+updateItrF itr accessor updator
+    = updateItr itr accessor (fmap updator)