summaryrefslogtreecommitdiff
path: root/com/simatime/go.hs
diff options
context:
space:
mode:
authorBen Sima <ben@bsima.me>2019-10-27 09:48:52 -0700
committerBen Sima <ben@bsima.me>2019-10-27 12:14:40 -0700
commitc790672cc244ac4caba1bda3572829a6c6862891 (patch)
tree2706bb8044f7b14840c5f90f215b79b433e81045 /com/simatime/go.hs
parent44df4ba39f65c3afd84bee6b03f47d9b061e9038 (diff)
move everything to namespace directories
Diffstat (limited to 'com/simatime/go.hs')
-rw-r--r--com/simatime/go.hs100
1 files changed, 100 insertions, 0 deletions
diff --git a/com/simatime/go.hs b/com/simatime/go.hs
new file mode 100644
index 0000000..1b32230
--- /dev/null
+++ b/com/simatime/go.hs
@@ -0,0 +1,100 @@
+-- based on
+-- https://stackoverflow.com/questions/4522387/how-can-i-emulate-gos-channels-with-haskell
+-- but this version encodes end-of-stream on the communication channel, as a Nothing
+
+module Com.Simatime.Go
+ ( chan
+ , readCh
+ , (-<-)
+ , writeCh
+ , (->-)
+ , go
+ )
+where
+
+import Control.Concurrent ( forkIO
+ , ThreadId
+ , threadDelay
+ )
+import Control.Concurrent.STM.TChan ( newTChan
+ , readTChan
+ , writeTChan
+ , isEmptyTChan
+ , TChan
+ )
+import Control.Monad ( forM_ )
+import GHC.Conc ( atomically )
+
+-- | Make a new channel.
+chan :: _
+chan = atomically . newTChan
+
+-- | Take from a channel.
+readCh :: TChan a -> IO a
+readCh = atomically . readTChan
+
+-- | Alias for 'readCh'.
+--
+-- >>> c <- chan
+-- >>> writeCh c "val"
+-- >>> -<- c
+-- "val"
+--
+-- I don't think this looks terrible with do-notation:
+--
+-- >>> c <- chan
+-- >>> writeCh c "val"
+-- >>> result <- -<- c
+-- >>> print result
+-- "val"
+(-<-) :: TChan a -> IO a
+(-<-) = readCh
+
+-- | Write to a channel.
+writeCh :: TChan a -> a -> IO ()
+writeCh ch v = atomically $ writeTChan ch v
+
+-- | Alias for 'writeCh', but flipped to make it read better.
+--
+-- >>> c <- chan
+-- >>> "val" ->- c
+-- >>> readCh c
+-- "val"
+(->-) :: TChan a -> a -> IO ()
+(->-) = flip writeCh
+
+-- | Starts a background process.
+go :: IO () -> IO ThreadId
+go = forkIO
+
+
+{- Example: (TODO: move to module-level docs)
+
+-- can I just implement forM/Traversable over the channel?
+forRange :: TChan (Maybe a) -> (a -> IO b) -> IO [b]
+forRange ch fn = helper fn [] where
+ -- helper :: (a -> IO b) -> [b] -> IO [b]
+ helper fn acc = do
+ jv <- readCh ch
+ case jv of
+ Nothing -> return $ reverse acc
+ Just v -> do
+ b <- fn v
+ helper fn (b : acc)
+
+feedData :: (Num a, Enum a) => TChan (Maybe a) -> IO ()
+feedData ch = do
+ forM_ [1 .. 9999] (\x -> writeCh ch (Just x))
+ writeQ ch Nothing -- EOF value
+
+printData :: TChan (Maybe Int) -> IO ()
+printData c = do
+ forRange c (print :: Int -> IO ())
+ return ()
+
+main :: IO ()
+main = do
+ ch <- chan
+ go $ feedData ch
+ printData ch
+-}