contstuff 1.2.4 → 1.2.6

raw patch · 3 files changed

+50/−50 lines, 3 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Control/ContStuff/Classes.hs +6/−10
• Control/ContStuff/Trans.hs +43/−39
• contstuff.cabal +1/−1

@@ -70,6 +70,8 @@     callCC :: ((a -> m b) -> m a) -> m a  +-- | A jump label for 'labelCC' and 'goto'.+ newtype Label m a = Label (a -> Label m a -> m ())  @@ -93,21 +95,15 @@  class Monad m => Forkable m where     -- | Generalization of 'Conc.forkIO'.-    forkIO :: m a -> m ThreadId+    forkIO :: m () -> m ThreadId      -- | Generalization of 'Conc.forkOS'.-    forkOS :: m a -> m ThreadId--    -- Generalization of 'Conc.runInBoundThread'.-    -- runInBoundThread :: m a -> m a--    -- Generalization of 'Conc.runInUnboundThread'.-    -- runInUnboundThread :: m a -> m a+    forkOS :: m () -> m ThreadId   instance Forkable IO where-    forkIO = Conc.forkIO . (() <$)-    forkOS = Conc.forkOS . (() <$)+    forkIO = Conc.forkIO+    forkOS = Conc.forkOS   ----------------

@@ -37,6 +37,7 @@        -- ** State       ReaderT,+      forkReaderT,       runReaderT,        StateT(..),@@ -53,6 +54,7 @@  import Control.Applicative import Control.Arrow+import Control.Concurrent hiding (forkIO, forkOS) import Control.ContStuff.Classes import Control.Monad import Control.Monad.IO.Class@@ -92,9 +94,9 @@         ChoiceT $ \fold z k ->             cx (\xx yx kx -> cf (\xf yf kf -> fold xf (yf yx) kf) xx kx) z k -instance Forkable m => Forkable (ChoiceT r i m) where-    forkIO = lift . forkIO . findAll'-    forkOS = lift . forkOS . findAll'+instance (Applicative m, Forkable m) => Forkable (ChoiceT r i m) where+    forkIO = lift . forkIO . findAll_+    forkOS = lift . forkOS . findAll_  instance Functor (ChoiceT r i m) where     fmap f (ChoiceT c) =@@ -153,14 +155,7 @@ findAll_ :: Applicative m => ChoiceT r i m a -> m () findAll_ =     (() <$) .-    runChoiceT (\_ _ k -> k undefined) undefined (const $ pure undefined)----- | Find all solutions and ignore them.  Internal utility function.--findAll' :: Monad m => ChoiceT r i m a -> m r-findAll' =-    runChoiceT (\_ _ k -> k undefined) undefined (const $ return undefined)+    runChoiceT (\_ _ k -> k undef) undef (const $ pure undef)   -- | Find the first solution.@@ -174,7 +169,7 @@ findFirst_ :: Applicative m => ChoiceT r i m a -> m () findFirst_ =     (() <$) .-    runChoiceT (\_ _ _ -> pure undefined) undefined (const $ pure undefined)+    runChoiceT (\_ _ _ -> pure undef) undef (const $ pure undef)   -- | Turn a list into a computation with alternatives.@@ -222,13 +217,9 @@ instance CallCC (ContT r m) where     callCC f = ContT $ \k -> getContT (f (ContT . const . k)) k -instance Forkable m => Forkable (ContT r m) where-    forkIO (ContT c) =-        ContT $ \k ->-            forkIO (c (return . const undefined)) >>= k-    forkOS (ContT c) =-        ContT $ \k ->-            forkOS (c (return . const undefined)) >>= k+instance Forkable m => Forkable (ContT () m) where+    forkIO (ContT c) = ContT $ \k -> forkIO (c toUnitM) >>= k+    forkOS (ContT c) = ContT $ \k -> forkOS (c toUnitM) >>= k  instance Functor (ContT r m) where     fmap f (ContT c) = ContT $ \k -> c (\x -> k (f x))@@ -302,9 +293,9 @@         EitherT $ \k expk ->             getEitherT (f (\x -> EitherT $ \_ _ -> k x)) k expk -instance Forkable m => Forkable (EitherT r e m) where-    forkIO (EitherT c) = lift . forkIO $ c deReturn deReturn-    forkOS (EitherT c) = lift . forkOS $ c deReturn deReturn+instance Forkable m => Forkable (EitherT () e m) where+    forkIO (EitherT c) = lift . forkIO $ c toUnitM toUnitM+    forkOS (EitherT c) = lift . forkOS $ c toUnitM toUnitM  instance Functor (EitherT r e m) where     fmap f (EitherT c) =@@ -370,13 +361,6 @@     in runEitherT (pc True) (pc False)  --- | Helper function: Turn an arbitrary pure value into a monadic--- 'bottom'.--deReturn :: Monad m => a -> m b-deReturn = const (return undefined)-- ------------ -- MaybeT -- ------------@@ -407,9 +391,9 @@         MaybeT $ \just noth ->             getMaybeT (f (\x -> MaybeT $ \_ _ -> just x)) just noth -instance Forkable m => Forkable (MaybeT r m) where-    forkIO (MaybeT c) = lift . forkIO $ c deReturn (return undefined)-    forkOS (MaybeT c) = lift . forkOS $ c deReturn (return undefined)+instance Forkable m => Forkable (MaybeT () m) where+    forkIO (MaybeT c) = lift . forkIO $ c toUnitM (return ())+    forkOS (MaybeT c) = lift . forkOS $ c toUnitM (return ())  instance HasExceptions (MaybeT r m) where     type Exception (MaybeT r m) = ()@@ -516,10 +500,6 @@     pure = return     ReaderT cf <*> ReaderT cx = ReaderT (cf <*> cx) -instance Forkable m => Forkable (ReaderT e m) where-    forkIO (ReaderT c) = ReaderT (forkIO c)-    forkOS (ReaderT c) = ReaderT (forkOS c)- instance Functor (ReaderT e m) where     fmap f (ReaderT c) = ReaderT (fmap f c) @@ -539,6 +519,14 @@     lift c = ReaderT (lift c)  +-- | Fork a concurrent thread for a computation with environment.++forkReaderT :: (Applicative m, Forkable m) => ReaderT e m () -> ReaderT e m ThreadId+forkReaderT c = do+    env <- get+    lift $ forkIO (runReaderT env c)++ -- | Run a computation with environment.  runReaderT :: Applicative m => e -> ReaderT e m a -> m a@@ -570,9 +558,9 @@ instance CallCC (StateT r s m) where     callCC f = StateT $ \k -> getStateT (f (\x -> StateT $ \_ -> k x)) k -instance Forkable m => Forkable (StateT r s m) where-    forkIO (StateT c) = StateT $ \k s0 -> forkIO (c deReturn s0) >>= flip k s0-    forkOS (StateT c) = StateT $ \k s0 -> forkOS (c deReturn s0) >>= flip k s0+instance Forkable m => Forkable (StateT () s m) where+    forkIO (StateT c) = StateT $ \k s0 -> forkIO (c (\_ _ -> return ()) s0) >>= flip k s0+    forkOS (StateT c) = StateT $ \k s0 -> forkOS (c (\_ _ -> return ()) s0) >>= flip k s0  instance Functor (StateT r s m) where     fmap f (StateT c) = StateT $ \k -> c (k . f)@@ -637,3 +625,19 @@  runWriterT :: Alternative m => WriterT r m a -> m r runWriterT (ContT c) = c (const empty)+++----------------------+-- Helper functions --+----------------------++-- | Turn an arbitrary pure value into a monadic bottom.++toUnitM :: Monad m => a -> m ()+toUnitM = return . const undef+++-- | The undefined value with a more descriptive error message.++undef :: a+undef = error "contstuff: Undefined value evaluated. This is a bug!"

@@ -1,5 +1,5 @@ Name:          contstuff-Version:       1.2.4+Version:       1.2.6 Category:      Control, Monads Synopsis:      Fast, easy to use CPS-based monad transformers Maintainer:    Ertugrul Söylemez <es@ertes.de>