Flow: try variants and checks for read and write

1 files changed, 22 insertions, 1 deletions

diff --git a/src/Flow.hs b/src/Flow.hs
index 657eafb..b52712d 100644
--- a/src/Flow.hs
+++ b/src/Flow.hs
@@ -1,7 +1,8 @@
 module Flow (
     Flow, SymFlow,
     newFlow, newFlowIO,
-    readFlow, writeFlow, writeFlowBulk,
+    readFlow, tryReadFlow, canReadFlow,
+    writeFlow, writeFlowBulk, tryWriteFlow, canWriteFlow,
     readFlowIO, writeFlowIO,
 
     mapFlow,
@@ -31,6 +32,18 @@ readFlow (Flow rvar _) = takeTMVar rvar >>= \case
     [] -> error "Flow: empty list"
 readFlow (MappedFlow f _ up) = f <$> readFlow up
 
+tryReadFlow :: Flow r w -> STM (Maybe r)
+tryReadFlow (Flow rvar _) = tryTakeTMVar rvar >>= \case
+    Just (x:[]) -> return (Just x)
+    Just (x:xs) -> putTMVar rvar xs >> return (Just x)
+    Just [] -> error "Flow: empty list"
+    Nothing -> return Nothing
+tryReadFlow (MappedFlow f _ up) = fmap f <$> tryReadFlow up
+
+canReadFlow :: Flow r w -> STM Bool
+canReadFlow (Flow rvar _) = not <$> isEmptyTMVar rvar
+canReadFlow (MappedFlow _ _ up) = canReadFlow up
+
 writeFlow :: Flow r w -> w -> STM ()
 writeFlow (Flow _ wvar) = putTMVar wvar . (:[])
 writeFlow (MappedFlow _ f up) = writeFlow up . f
@@ -40,6 +53,14 @@ writeFlowBulk _ [] = return ()
 writeFlowBulk (Flow _ wvar) xs = putTMVar wvar xs
 writeFlowBulk (MappedFlow _ f up) xs = writeFlowBulk up $ map f xs
 
+tryWriteFlow :: Flow r w -> w -> STM Bool
+tryWriteFlow (Flow _ wvar) = tryPutTMVar wvar . (:[])
+tryWriteFlow (MappedFlow _ f up) = tryWriteFlow up . f
+
+canWriteFlow :: Flow r w -> STM Bool
+canWriteFlow (Flow _ wvar) = isEmptyTMVar wvar
+canWriteFlow (MappedFlow _ _ up) = canWriteFlow up
+
 readFlowIO :: Flow r w -> IO r
 readFlowIO path = atomically $ readFlow path