diff options
Diffstat (limited to 'Com/Simatime/Go.hs')
-rw-r--r-- | Com/Simatime/Go.hs | 125 |
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" -} |