summaryrefslogtreecommitdiff
path: root/Com
diff options
context:
space:
mode:
Diffstat (limited to 'Com')
-rw-r--r--Com/Simatime/Go.hs125
1 files changed, 48 insertions, 77 deletions
diff --git a/Com/Simatime/Go.hs b/Com/Simatime/Go.hs
index 1b32230..0eef38d 100644
--- a/Com/Simatime/Go.hs
+++ b/Com/Simatime/Go.hs
@@ -1,100 +1,71 @@
--- 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
+{- | A Go-like EDSL to make working with concurrent in-process code a bit
+ easier to read.
+This module is expected to be imported qualified as `Go`.
+
+$example
+-}
+{-# LANGUAGE NoImplicitPrelude #-}
module Com.Simatime.Go
- ( chan
- , readCh
- , (-<-)
- , writeCh
- , (->-)
- , go
+ (
+ -- * Running and forking
+ Go
+ , run
+ , fork
+ -- * Channels
+ , Channel
+ , chan
+ , read
+ , write
)
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
+import GHC.Conc ( STM
+ , atomically
+ )
+import Protolude ( IO()
+ , MonadIO(liftIO)
+ , flip
+ , (.)
+ )
+type Go = STM
+type Channel = TChan
--- | Alias for 'writeCh', but flipped to make it read better.
---
--- >>> c <- chan
--- >>> "val" ->- c
--- >>> readCh c
--- "val"
-(->-) :: TChan a -> a -> IO ()
-(->-) = flip writeCh
+-- | Runs a Go command in IO.
+run :: Go a -> IO a
+run = atomically
-- | Starts a background process.
-go :: IO () -> IO ThreadId
-go = forkIO
+fork :: IO () -> IO ThreadId
+fork = forkIO
+-- | Make a new channel.
+chan :: Go (Channel a)
+chan = newTChan
-{- Example: (TODO: move to module-level docs)
+-- | Take from a channel. Blocks until a value is received.
+read :: Channel a -> Go a
+read = readTChan
--- 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)
+-- | Write to a channel.
+write :: Channel a -> a -> Go ()
+write = writeTChan
-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
+{- $example
-printData :: TChan (Maybe Int) -> IO ()
-printData c = do
- forRange c (print :: Int -> IO ())
- return ()
+A simple example from ghci:
-main :: IO ()
-main = do
- ch <- chan
- go $ feedData ch
- printData ch
+>>> import qualified Com.Simatime.Go as Go
+>>> c <- Go.run Go.chan :: IO (Go.Channel Text)
+>>> Go.run $ Go.write c "test"
+>>> Go.run $ Go.read c
+"test"
-}