diff options
author | Ben Sima <ben@bsima.me> | 2019-11-02 15:33:13 -0700 |
---|---|---|
committer | Ben Sima <ben@bsima.me> | 2019-11-02 15:33:13 -0700 |
commit | 9d114cfc773171b0a95bd4d2c39f1bb0eb783c8d (patch) | |
tree | 20766a760ed0141cf39153565e8552f6739c632d /Com/Simatime/Go.hs | |
parent | d2a37f5de160160eadbacd7b8dc2567f78a0543d (diff) |
rename everything back to caps to appease ghc
Diffstat (limited to 'Com/Simatime/Go.hs')
-rw-r--r-- | Com/Simatime/Go.hs | 100 |
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 +-} |