pipes-misc 0.2.0.1 → 0.2.1.1

raw patch · 3 files changed

+67/−6 lines, 3 filesdep +clock

Dependencies added: clock

Files

• pipes-misc.cabal +3/−1
• src/Pipes/Misc.hs +24/−5
• src/Pipes/Stopwatch.hs +40/−0

@@ -1,5 +1,5 @@ name:                pipes-misc-version:             0.2.0.1+version:             0.2.1.1 synopsis:            Miscellaneous utilities for pipes, required by glazier-tutorial description:         Please see README.md homepage:            https://github.com/louispan/pipes-misc#readme@@ -16,7 +16,9 @@ library   hs-source-dirs:      src   exposed-modules:     Pipes.Misc+                       Pipes.Stopwatch   build-depends:       base >= 4.7 && < 5+                     , clock >= 0.7 && < 1                      , lens >= 4 && < 5                      , mtl >= 2 && < 3                      , pipes >= 4 && < 5

@@ -1,23 +1,23 @@ {-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE RankNTypes #-}  -- | Miscellaneous utilities for pipes, required by glazier-tutorial module Pipes.Misc where +import Control.Applicative import Control.Arrow+import Control.Concurrent import Control.Concurrent.STM import Control.Lens import Control.Monad import Control.Monad.State.Strict import Control.Monad.Trans.Maybe+import Control.Monad.Except+import qualified Data.List.NonEmpty as NE import qualified Pipes as P import qualified Pipes.Concurrent as PC-import qualified Pipes.Shaft as PS import qualified Pipes.Prelude as PP-import qualified Data.List.NonEmpty as NE-import Control.Monad.Except-import Control.Applicative+import qualified Pipes.Shaft as PS  -- | Like Pipes.Concurrent.fromInput, but stays in STM. -- Using @hoist atomically@ to convert to IO monad seems to work.@@ -109,3 +109,22 @@   PP.map (\s -> (s, s))   P.>-> PS.runShaft (first $ PS.Shaft $ PP.map viewf P.>-> p)   P.>-> PP.map (uncurry modifyf)++-- | Do something with the state everytime there is a yield.+onState :: (MonadState s m) => (s -> m ()) -> P.Pipe a a m r+onState f = PP.mapM $ \a -> do+    s <- get+    f s+    pure a++-- | Add a delay after every yield+-- To avoid delaying the first yield use:+--+-- @+-- Pipes.pull () >> delay d+-- @+--+delay :: MonadIO io => Int -> P.Pipe a a io ()+delay i = PP.mapM $ \a -> do+    liftIO $ threadDelay i+    pure a

@@ -0,0 +1,40 @@+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TemplateHaskell #-}++module Pipes.Stopwatch where++import Control.Lens+import Control.Monad.Trans+import qualified Pipes as P+import qualified System.Clock as C++-- | Record of epoch time and elapsed time+data Stopwatch = Stopwatch+    { stopwatchEpochTime :: {-# UNPACK #-}!C.TimeSpec -- | time since application epoch+    , stopwatchLapTime :: {-# UNPACK #-}!C.TimeSpec -- | time since last frame+    } deriving (Eq, Show)++makeFields ''Stopwatch++-- | Create a stopwatch pipe using first yielded time as the application epoch+-- and previous laptime+stopwatch :: MonadIO io => P.Pipe () Stopwatch io ()+stopwatch = do+    P.await+    t <- liftIO $ C.getTime C.ThreadCPUTime+    P.yield $ Stopwatch startTime startTime+    stopwatch' t t+  where+    startTime = C.TimeSpec 0 0++-- | Create a stopwatch Pipe using a given application epoch time and previous laptime+stopwatch' :: MonadIO io => C.TimeSpec -> C.TimeSpec -> P.Pipe () Stopwatch io ()+stopwatch' epoch prev = go prev+  where+    go prev' = do+        () <- P.await+        t <- liftIO $ C.getTime C.ThreadCPUTime+        P.yield $ Stopwatch (C.diffTimeSpec t epoch) (C.diffTimeSpec t prev')+        go t