diff options
| -rw-r--r-- | src/Flow.hs | 23 |
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 |