From c790672cc244ac4caba1bda3572829a6c6862891 Mon Sep 17 00:00:00 2001
From: Ben Sima <ben@bsima.me>
Date: Sun, 27 Oct 2019 09:48:52 -0700
Subject: move everything to namespace directories

---
 com/simatime/go.hs | 100 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 100 insertions(+)
 create mode 100644 com/simatime/go.hs

(limited to 'com/simatime/go.hs')

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
+-}
-- 
cgit v1.2.3