summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Flow.hs23
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