MonadCompose 0.5.0.0 → 0.6.0.0

raw patch · 4 files changed

+130/−85 lines, 4 files

Files

Control/Monad/IOT.hs +52/−15
Control/Monad/Plus.hs +0/−67
Control/Monad/PlusMonad.hs +67/−0
MonadCompose.cabal +11/−3

Control/Monad/IOT.hs view

@@ -1,14 +1,15 @@-{-# LANGUAGE MagicHash, UnboxedTuples, Rank2Types #-}
+{-# LANGUAGE MagicHash, UnboxedTuples, Rank2Types, GADTs #-}
 
 module Control.Monad.IOT (IOT, run) where
 
 import GHC.IO hiding (liftIO)
 import GHC.Prim
-import Control.Monad.Trans (MonadIO(..))
+import Control.Monad.Trans -- (MonadIO(..))
 import Control.Monad.Identity
-import Control.Monad.Morph
+-- import Control.Monad.Morph
 import Control.Monad
 import Control.Applicative
+import Unsafe.Coerce
 
 data St = St { unSt :: !(State# RealWorld) }
 
@@ -23,12 +24,34 @@ --
 -- Should be integrated with STT.
 
-newtype IOT m t = IOT (St -> m (St, t))
+class MFunctor t where
+    {-| Lift a monad morphism from @m@ to @n@ into a monad morphism from
+        @(t m)@ to @(t n)@
+    -}
+    hoist :: (Monad m) => (forall a . m a -> n a) -> t m b -> t n b
 
+class (MFunctor t, MonadTrans t) => MMonad t where
+    {-| Embed a newly created 'MMonad' layer within an existing layer
+
+        'embed' is analogous to ('=<<')
+    -}
+    embed :: (Monad n) => (forall a . m a -> t n a) -> t m b -> t n b
+
+data Sequence m where
+	None :: Sequence m
+	Seq :: (Monad m) => IO St -> Sequence (IOT m)
+
+{-#  INLINE runSequence #-}
+runSequence :: (Monad m) => Sequence m -> St -> m St
+runSequence None = return
+runSequence (Seq io) = \_ -> liftIO io
+
+newtype IOT m t = IOT (Sequence m -> St -> m (St, t))
+
 instance (Monad m) => Monad (IOT m) where
-	return x = IOT (\s -> return (s, x))
-	IOT f >>= g = IOT (\s -> f s >>= \(s2, x) -> case g x of
-		IOT h -> h s2)
+	return x = IOT (\_ s -> return (s, x))
+	IOT f >>= g = IOT (\i s -> f i s >>= \(s2, x) -> case g x of
+		IOT h -> h i s2)
 
 instance (Monad m) => Applicative (IOT m) where
 	pure = return
@@ -38,22 +61,36 @@ 	fmap f m = m >>= return . f
 
 instance (Monad m) => MonadIO (IOT m) where
-	liftIO (IO f) = IOT (\s -> case f (unSt s) of
+	liftIO (IO f) = IOT (\_ s -> case f (unSt s) of
 		(# s2, x #) -> return (St s2, x))
 
 instance MonadTrans IOT where
-	lift m = IOT (\s -> liftM ((,) s) m)
-
-instance MFunctor IOT where
-	hoist f (IOT g) = IOT (f . g)
+	lift m = IOT (\i s -> m >>= \x -> liftM (\s -> (s, x)) (runSequence i s))
 
 -- Flatten two layers into one. mmorph exports 'squash'.
-_squash (IOT f) = IOT (\s -> let IOT g = f s in g s >>= return . snd)
+--
+-- Unsafely interleave actions in the outer monad, but sequence with the
+-- inner monad using a sequencing fn.
+_squash (IOT f) = IOT (\i s -> let IOT g = f (Seq $ IO $ \s -> (# s, St s #)) s in g i s >>= return . snd)
 
+_hoist :: (forall t. m t -> n t) -> IOT m t -> IOT n t
+_hoist f (IOT g) = IOT (\i -> f . g (unsafeCoerce i))
+-- Type safety proof: the datum i is either in None or Seq.
+--   * If it is in None, it is valid at all types.
+--   * If it is in Seq, the only way it can be projected is from IOT m to IO
+--   and back again. liftIO is valid at both. So 'runSequence' will
+--   certainly be used at a valid type.
+--
+--   Here is the test of where things can go wrong:
+test = run $ _squash $ hoist (liftIO . run) $ liftIO (print "A") >> lift (liftIO (print "B"))
+
 instance MMonad IOT where
-	embed f (IOT g) = _squash $ IOT (f . g)
+	embed f = _squash . _hoist f
 
+instance MFunctor IOT where
+	hoist = _hoist
+
 -- | Run an IOT.
 run :: IOT Identity t -> IO t
-run (IOT f) = IO (\s -> case runIdentity (f (St s)) of
+run (IOT f) = IO (\s -> case runIdentity (f None (St s)) of
 	(s2, x) -> (# unSt s2, x #))

− Control/Monad/Plus.hs

@@ -1,67 +0,0 @@-{-# LANGUAGE RankNTypes, TypeOperators #-}
-
--- | The Plus monad - a free combination of monads. This is very similar to coproducts, but not quite the same.
---
---   Coproducts are due to Luth and Ghani, "Composing Monads Using Coproducts," http://www.informatik.uni-bremen.de/~cxl/papers/icfp02.pdf
-module Control.Monad.Plus where
-
-import Control.Monad.Trans
-import Control.Monad.Identity
-import Control.Monad.Product
-import Control.Monad.Morph
-import Control.Applicative
-import Control.Arrow
-
-newtype (m ::+ n) t = Plus { unPlus :: forall x. (MonadPlus x) => (forall u. m u -> x u) -> (forall u. n u -> x u) -> x t }
-
-instance Monad (m ::+ n) where
-	return x = Plus (\_ _ -> return x)
-	Plus f >>= g = Plus (\h i -> f h i >>= \x -> unPlus (g x) h i)
-
-instance Functor (m ::+ n) where
-	fmap f m = m >>= return . f
-
-instance Applicative (m ::+ n) where
-	pure = return
-	(<*>) = ap
-
-instance MonadPlus (m ::+ n) where
-	mzero = Plus (\_ _ -> mzero)
-	mplus (Plus f) (Plus g) = Plus (\h i -> mplus (f h i) (g h i))
-
-instance Alternative (m ::+ n) where
-	empty = mzero
-	(<|>) = mplus
-
-inl m = Plus (\h _ -> h m)
-
-inr m = Plus (\_ i -> i m)
-
-instance MonadTrans ((::+) m) where
-	lift = inr
-
-mapPlus :: (forall t. m t -> m1 t) -> (forall t. n t -> n1 t) -> (m ::+ n) t -> (m1 ::+ n1) t
-mapPlus f g (Plus x) = Plus (\h i -> x (h . f) (i . g))
-
-instance MFunctor ((::+) m) where
-	hoist = mapPlus id
-
-comm :: (m ::+ n) t -> (n ::+ m) t
-comm (Plus f) = Plus (\h i -> f i h)
-
-assoc (Plus f) = Plus (\h i -> f (\m -> unPlus m h (i . inl)) (i . inr))
-
-assoc1 (Plus f) = Plus (\h i -> f (h . inl) (\m -> unPlus m (h . inr) i))
-
-cancelLeft (Plus f) = f (return . runIdentity) id
-
-cancelRight (Plus f) = f id (return . runIdentity)
-
-refl (Plus f) = f id id
-
-instance (MonadPlus m) => MMonad ((::+) m) where
-	embed f = mapPlus refl id . assoc1 . mapPlus id f
-
--- | Distributivity with monad products.
-distr pls = Product (mapPlus (fst . runProduct) (fst . runProduct) pls, mapPlus (snd . runProduct) (snd . runProduct) pls)
-

+ Control/Monad/PlusMonad.hs view

@@ -0,0 +1,67 @@+{-# LANGUAGE RankNTypes, TypeOperators #-}
+
+-- | The Plus monad - a free combination of monads. This is very similar to coproducts, but not quite the same.
+--
+--   Coproducts are due to Luth and Ghani, "Composing Monads Using Coproducts," http://www.informatik.uni-bremen.de/~cxl/papers/icfp02.pdf
+module Control.Monad.PlusMonad where
+
+import Control.Monad.Trans
+import Control.Monad.Identity
+import Control.Monad.Product
+import Control.Monad.Morph
+import Control.Applicative
+import Control.Arrow
+
+newtype (m ::+ n) t = Plus { unPlus :: forall x. (MonadPlus x) => (forall u. m u -> x u) -> (forall u. n u -> x u) -> x t }
+
+instance Monad (m ::+ n) where
+	return x = Plus (\_ _ -> return x)
+	Plus f >>= g = Plus (\h i -> f h i >>= \x -> unPlus (g x) h i)
+
+instance Functor (m ::+ n) where
+	fmap f m = m >>= return . f
+
+instance Applicative (m ::+ n) where
+	pure = return
+	(<*>) = ap
+
+instance MonadPlus (m ::+ n) where
+	mzero = Plus (\_ _ -> mzero)
+	mplus (Plus f) (Plus g) = Plus (\h i -> mplus (f h i) (g h i))
+
+instance Alternative (m ::+ n) where
+	empty = mzero
+	(<|>) = mplus
+
+inl m = Plus (\h _ -> h m)
+
+inr m = Plus (\_ i -> i m)
+
+instance MonadTrans ((::+) m) where
+	lift = inr
+
+mapPlus :: (forall t. m t -> m1 t) -> (forall t. n t -> n1 t) -> (m ::+ n) t -> (m1 ::+ n1) t
+mapPlus f g (Plus x) = Plus (\h i -> x (h . f) (i . g))
+
+instance MFunctor ((::+) m) where
+	hoist = mapPlus id
+
+comm :: (m ::+ n) t -> (n ::+ m) t
+comm (Plus f) = Plus (\h i -> f i h)
+
+assoc (Plus f) = Plus (\h i -> f (\m -> unPlus m h (i . inl)) (i . inr))
+
+assoc1 (Plus f) = Plus (\h i -> f (h . inl) (\m -> unPlus m (h . inr) i))
+
+cancelLeft (Plus f) = f (return . runIdentity) id
+
+cancelRight (Plus f) = f id (return . runIdentity)
+
+refl (Plus f) = f id id
+
+instance (MonadPlus m) => MMonad ((::+) m) where
+	embed f = mapPlus refl id . assoc1 . mapPlus id f
+
+-- | Distributivity with monad products.
+distr pls = Product (mapPlus (fst . runProduct) (fst . runProduct) pls, mapPlus (snd . runProduct) (snd . runProduct) pls)
+

MonadCompose.cabal view

@@ -1,7 +1,15 @@ name:                MonadCompose
-version:             0.5.0.0
+version:             0.6.0.0
 synopsis:            Methods for composing monads.
-description:         Methods for composing monads, including an IO monad transformer.
+description:         Methods for composing monads.
+
+  The IO monad transformer solves the problem of combining two IO-performing monad transformers, so that neither one needs to provide a MonadIO interface, and both can be transformed separately.
+
+  Most known monads have a distributive law. The Distributive module implements distributivity for monad transformers.
+
+  A monad transformer can transform another monad, but if you have two monads both lacking a transformer, there is little you can do in general. However, you can compose them in a coproduct construction. The PlusMonad module implements a similar plan, but differs from coproducts in that it doesn't compress together contiguous uses of a monad. Another mystery is how to get the other distributive law (m(x + y) -> mx + my).
+
+  I would like the auto-lifter and the Plus monad to work together, but I can't figure out how to coax IncoherentInstances to support it.
 homepage:            http://alkalisoftware.net
 license:             BSD3
 license-file:        LICENSE
@@ -13,6 +21,6 @@ cabal-version:       >=1.8
 
 library
-  exposed-modules:     Control.Monad.IOT, Control.Monad.Distributive, Control.Monad.Plus, Control.Monad.Lifter
+  exposed-modules:     Control.Monad.IOT, Control.Monad.Distributive, Control.Monad.PlusMonad, Control.Monad.Lifter
   -- other-modules: 
   build-depends:       base >=4 && <=5, ghc-prim ==0.3.*, mtl ==2.1.*, mmorph ==1.0.*, monad-products, transformers, MaybeT