free-concurrent 0.1.0.0 → 0.1.0.1

raw patch · 2 files changed

+28/−16 lines, 2 filesdep +type-alignedPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: type-aligned

API changes (from Hackage documentation)

Files

• free-concurrent.cabal +3/−2
• src/Control/Concurrent/Free.hs +25/−14

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                free-concurrent-version:             0.1.0.0+version:             0.1.0.1 synopsis:            Free monads suitable for concurrent computation -- description:          homepage:            https://github.com/srijs/haskell-free-concurrent@@ -20,6 +20,7 @@   exposed-modules:     Control.Concurrent.Free   -- other-modules:          -- other-extensions:    -  build-depends:       base >=4.8 && <4.9+  build-depends:       base >=4.8 && <4.9,+                       type-aligned >=0.9   hs-source-dirs:      src   default-language:    Haskell2010

@@ -1,8 +1,16 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE RankNTypes #-} -module Control.Concurrent.Free where+module Control.Concurrent.Free+  ( F, liftF+  , hoist+  , retractA, retractM+  , foldA, foldM+  , foldConcurrentM+  , retractConcurrentIO, foldConcurrentIO+  ) where +import Control.Applicative (liftA2) import Control.Concurrent import Control.Concurrent.MVar import Control.Exception (SomeException(..), try, throwIO)@@ -20,19 +28,20 @@ --   monadic 'join' sits. data F f a where   Pure :: a -> F f a-  Ap   :: f x -> (x -> a) -> F f (a -> b) -> F f b+  Lift :: f x -> (x -> a) -> F f a+  Ap   :: F f a -> F f (a -> b) -> F f b   Join :: F f (F f a) -> F f a  instance Functor (F f) where   fmap f (Pure a) = Pure (f a)-  fmap f (Ap x g y) = Ap x g (fmap f <$> y)+  fmap f (Lift x g) = Lift x (f . g)+  fmap f (Ap x y) = Ap x (fmap f <$> y)   fmap f (Join x) = Join (fmap f <$> x)  instance Applicative (F f) where   pure = Pure   Pure f <*> y = fmap f y-  Ap x g y <*> z = Ap x g (flip <$> y <*> z)-  Join x <*> y = Join ((\z -> z <*> y) <$> x)+  x <*> y = Ap y x  instance Monad (F f) where   return = pure@@ -42,24 +51,27 @@  -- | Lifts an @f a@ into a @F f a@. liftF :: f a -> F f a-liftF x = Ap x id (Pure id)+liftF x = Lift x id  -- | Given a natural transformation from @f@ to @g@ this gives a monoidal natural transformation from @F f@ to @F g@. hoist :: (forall a. f a -> g a) -> F f a -> F g a hoist f (Pure a) = Pure a-hoist f (Ap x g y) = Ap (f x) g (hoist f y)+hoist f (Lift x g) = Lift (f x) g+hoist f (Ap x y) = Ap (hoist f x) (hoist f y) hoist f (Join x) = Join (hoist f (fmap (hoist f) x))  -- | Partially interprets the free monad over @f@ using the semantics for 'pure' and '<*>' given by the 'Applicative' instance for @f@. If it encounters a monadic join, the result is 'Nothing'. retractA :: Applicative f => F f a -> Maybe (f a) retractA (Pure a) = Just (pure a)-retractA (Ap x g y) = (\z -> z <*> fmap g x) <$> retractA y+retractA (Lift x g) = Just (fmap g x)+retractA (Ap x y) = liftA2 (<*>) (retractA y) (retractA x) retractA (Join x) = Nothing  -- | Interprets the free monad over @f@ using the semantics for 'return' and '>>=' given by the 'Monad' instance for @f@. retractM :: Monad f => F f a -> f a retractM (Pure a) = pure a-retractM (Ap x g y) = retractM y >>= \z -> z <$> g <$> x+retractM (Lift x g) = fmap g x+retractM (Ap x y) = retractM y <*> retractM x retractM (Join x) = join . retractM $ fmap retractM x  -- | Interprets the free monad over @f@ using the@@ -71,11 +83,10 @@ --   and reveal the second layer, which should block --   until the spawned action has returned with a result. foldConcurrentM :: Monad m => (forall x. f x -> m (m x)) -> F f a -> m a-foldConcurrentM run (Pure x) = return x-foldConcurrentM run (Ap x g y) = do-  v <- run x-  f <- foldConcurrentM run y-  f . g <$> v+foldConcurrentM run (Pure a) = return a+foldConcurrentM run (Lift x g) = run x >>= fmap g+foldConcurrentM run (Ap x y) =+  foldConcurrentM run y <*> foldConcurrentM run x foldConcurrentM run (Join x) = do   y <- foldConcurrentM run x   foldConcurrentM run y