netwire 3.0.1 → 3.1.0
raw patch · 6 files changed
+90/−48 lines, 6 filesdep +lifted-basedep −MonadRandomdep −forkable-monaddep ~monad-control
Dependencies added: lifted-base
Dependencies removed: MonadRandom, forkable-monad
Dependency ranges changed: monad-control
Files
- Control/Wire/Classes.hs +32/−17
- Control/Wire/Prefab/Execute.hs +3/−3
- Control/Wire/Prefab/Random.hs +1/−1
- Control/Wire/Trans/Fork.hs +7/−7
- Control/Wire/Types.hs +44/−15
- netwire.cabal +3/−5
Control/Wire/Classes.hs view
@@ -8,9 +8,10 @@ module Control.Wire.Classes ( -- * Various effects- -- ** Time+ -- ** Monadic MonadClock(..),- -- ** Underlying monad+ MonadRandom(..),+ -- ** Arrows ArrowKleisli(..), arrIO )@@ -28,20 +29,7 @@ import Control.Monad.Trans (MonadIO(..)) import Data.Monoid import Data.Time.Clock.POSIX----- | Monads with a clock.--class Monad m => MonadClock t m | m -> t where- -- | Current time in some monad-specific frame of reference.- getTime :: m t----- | Instance for the system time. This is intentionally specific to--- allow you to define better instances with custom monads.--instance MonadClock Double IO where- getTime = fmap realToFrac getPOSIXTime+import System.Random -- | Arrows which support running monadic computations.@@ -72,7 +60,34 @@ arrM = lift arrM --- | Arrows, which have 'IO' at their base.+-- | Monads with a clock.++class Monad m => MonadClock t m | m -> t where+ -- | Current time in some monad-specific frame of reference.+ getTime :: m t++-- | Instance for the system time. This is intentionally specific to+-- allow you to define better instances with custom monads.++instance MonadClock Double IO where+ getTime = fmap realToFrac getPOSIXTime+++-- | Monads supporting random number generation.++class Monad m => MonadRandom m where+ -- | Returns a random number for the given type.+ getRandom :: Random a => m a++ -- | Returns a random number in the given range.+ getRandomR :: Random a => (a, a) -> m a++instance MonadRandom IO where+ getRandom = randomIO+ getRandomR = randomRIO+++-- | Kleisli arrows, which have 'IO' at their base. arrIO :: (ArrowKleisli m (>~), MonadIO m) => IO b >~ b arrIO = arrM <<^ liftIO
Control/Wire/Prefab/Execute.hs view
@@ -16,9 +16,9 @@ import Control.Applicative import Control.Arrow-import Control.Exception.Control as Ex+import Control.Exception.Lifted as Ex import Control.Monad-import Control.Monad.IO.Control+import Control.Monad.Trans.Control import Control.Wire.Types @@ -41,6 +41,6 @@ -- * Inhibits: Whenever the input computation throws an exception. executeWith :: (SomeException -> e) -> Wire e (>~) (m b) b -instance MonadControlIO m => WExecute m (Kleisli m) where+instance MonadBaseControl IO m => WExecute m (Kleisli m) where executeWith fromEx = mkFixM $ liftM (either (Left . fromEx) Right) . Ex.try
Control/Wire/Prefab/Random.hs view
@@ -20,7 +20,7 @@ import Control.Arrow import Control.Monad-import Control.Monad.Random.Class+import Control.Wire.Classes import Control.Wire.Types import System.Random
Control/Wire/Trans/Fork.hs view
@@ -34,12 +34,12 @@ import qualified Data.Map as M import Control.Applicative import Control.Arrow-import Control.Concurrent.Forkable+import Control.Concurrent.Lifted import Control.Concurrent.STM-import Control.Exception.Control+import Control.Exception.Lifted import Control.Monad import Control.Monad.Fix-import Control.Monad.IO.Control+import Control.Monad.Trans.Control import Control.Monad.Trans import Control.Wire.Types import Data.Map (Map)@@ -74,7 +74,7 @@ -- * Inhibits: When there is no data. queryWire :: Monoid e => Wire e (>~) (WireChan a b) b -instance (ForkableMonad m, MonadControlIO m) => WFork (Kleisli m) where+instance (MonadBaseControl IO m, MonadIO m) => WFork (Kleisli m) where -- feedWire feedWire = mkFixM $ \(wc, x') -> do@@ -94,7 +94,7 @@ wcOutputChan = ochan } mgrOp mgr $ do- tid <- forkIO (thread ichan ochan quitVar doneVar thrW)+ tid <- fork (thread ichan ochan quitVar doneVar thrW) let wt = WireThread { wtDoneVar = doneVar, wtThreadId = tid,@@ -183,7 +183,7 @@ -- | Perform a manager operation safely. -mgrOp :: MonadControlIO m => WireMgr -> m a -> m a+mgrOp :: (MonadBaseControl IO m, MonadIO m) => WireMgr -> m a -> m a mgrOp mgr c = do let freeVar = wmFreeVar mgr liftIO . atomically $ do@@ -226,7 +226,7 @@ -- | Convenient wrapper around 'startWireMgr' and 'stopWireMgr'. -withWireMgr :: MonadControlIO m => (WireMgr -> m a) -> m a+withWireMgr :: (MonadBaseControl IO m, MonadIO m) => (WireMgr -> m a) -> m a withWireMgr k = do mgr <- liftIO startWireMgr k mgr `finally` liftIO (stopWireMgr mgr)
Control/Wire/Types.hs view
@@ -40,7 +40,6 @@ import Control.Monad.State.Class import Control.Monad.Writer.Class import Control.Wire.Classes-import Control.Wire.Tools import Data.Monoid import Prelude hiding ((.), id) @@ -59,6 +58,50 @@ WmPure :: (a -> (Either e b, Wire e (Kleisli m) a b)) -> Wire e (Kleisli m) a b +-- | Choice at the functor level.++instance (Monad m, Monoid e) => Alternative (Wire e (Kleisli m) a) where+ empty = zeroArrow+ (<|>) = (<+>)+++-- | Map a function signal over the output signal.++instance Monad m => Applicative (Wire e (Kleisli m) a) where+ pure = mkPureFix . const . Right++ WmPure ff <*> wx'@(WmPure fx) =+ WmPure $ \x' ->+ case ff x' of+ (Left ex, wf) -> (Left ex, wf <*> wx')+ (Right f, wf) ->+ let (mx, wx) = fx x'+ in (fmap f mx, wf <*> wx)++ WmPure ff <*> wx'@(WmGen fx) =+ WmGen $ \x' ->+ case ff x' of+ (Left ex, wf) -> return (Left ex, wf <*> wx')+ (Right f, wf) -> liftM (fmap f *** (wf <*>)) (fx x')++ WmGen ff <*> wx'@(WmPure fx) =+ WmGen $ \x' -> do+ (mf, wf) <- ff x'+ return $+ case mf of+ Left ex -> (Left ex, wf <*> wx')+ Right f ->+ let (mx, wx) = fx x'+ in (fmap f mx, wf <*> wx)++ WmGen ff <*> wx'@(WmGen fx) =+ WmGen $ \x' -> do+ (mf, wf) <- ff x'+ case mf of+ Left ex -> return (Left ex, wf <*> wx')+ Right f -> liftM (fmap f *** (wf <*>)) (fx x')++ -- | Wire side channels. instance Monad m => Arrow (Wire e (Kleisli m)) where@@ -406,20 +449,6 @@ instance Monad m => Functor (Wire e (Kleisli m) a) where fmap f (WmGen g) = WmGen (liftM (fmap f *** fmap f) . g) fmap f (WmPure g) = WmPure ((fmap f *** fmap f) . g)----- | Choice at the functor level.--instance (Monad m, Monoid e) => Alternative (Wire e (Kleisli m) a) where- empty = zeroArrow- (<|>) = (<+>)----- | Map a function signal over the output signal.--instance Monad m => Applicative (Wire e (Kleisli m) a) where- pure = mkPureFix . const . Right- wf <*> wx = uncurry ($) ^<< (wf *** wx) <<^ dup -- | Create a wire from the given transformation computation.
netwire.cabal view
@@ -1,5 +1,5 @@ Name: netwire-Version: 3.0.1+Version: 3.1.0 Category: Control, FRP Synopsis: Fast generic automaton arrow transformer for AFRP Maintainer: Ertugrul Söylemez <es@ertes.de>@@ -21,9 +21,8 @@ base >= 4 && < 5, containers >= 0.4.0, deepseq >= 1.1.0,- forkable-monad >= 0.1.1,- monad-control >= 0.2.0,- MonadRandom >= 0.1.6,+ lifted-base >= 0.1.0,+ monad-control >= 0.3.0, random >= 1.0.0, time >= 1.2.0, mtl >= 2.0.1,@@ -81,7 +80,6 @@ -- base >= 4 && < 5, -- containers, -- logict,--- MonadRandom, -- mtl, -- netwire, -- random,