MonadCompose (empty) → 0.1.0.0

raw patch · 6 files changed

+232/−0 lines, 6 filesdep +basedep +ghc-primdep +mmorphsetup-changed

Dependencies added: base, ghc-prim, mmorph, monad-products, mtl, transformers

Files

Control/Monad/Distributive.hs +60/−0
Control/Monad/IOT.hs +59/−0
Control/Monad/Plus.hs +63/−0
LICENSE +30/−0
MonadCompose.cabal +18/−0
Setup.hs +2/−0

+ Control/Monad/Distributive.hs view

@@ -0,0 +1,60 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts #-}
+
+module Control.Monad.Distributive (Distributive(dist)) where
+
+import qualified Control.Monad.State.Strict as Strict
+import Control.Monad.State
+import Control.Monad.Writer
+import Control.Monad.Reader
+import Control.Monad.Identity
+import Data.Functor.Compose
+
+-- | Monads that distribute over one another.
+class (Monad m, Monad n) => Distributive m n where
+	dist :: m (n t) -> n (m t)
+
+instance (Monad n) => Distributive Maybe n where
+	dist (Just m) = liftM Just m
+	dist Nothing = return Nothing
+
+instance (Monad n) => Distributive (Either t) n where
+	dist (Left x) = return (Left x)
+	dist (Right m) = liftM Right m
+
+instance (Monad n, Monoid x) => Distributive (WriterT x Identity) n where
+	dist wr = let (m, w) = runWriter wr in m >>= \x -> return (tell w >> return x)
+
+instance (Monad n) => Distributive [] n where
+	dist = sequence
+
+instance (Monad m) => Distributive m (Strict.StateT v Identity) where
+	dist m = get >>= \x -> return (m >>= \st -> return $ Strict.evalState st x)
+
+instance (Monad m) => Distributive m (StateT v Identity) where
+	dist m = get >>= \x -> return (m >>= \st -> return $ evalState st x)
+
+instance (Monad m) => Distributive m (ReaderT v Identity) where
+	dist m = ask >>= \x -> return (m >>= \rd -> return $ runReader rd x)
+
+instance (Monad m) => Distributive m Identity where
+	dist m = Identity (m >>= return . runIdentity)
+
+instance (Monad n) => Distributive Identity n where
+	dist (Identity m) = m >>= return . Identity
+
+instance (Distributive n2 n, Distributive m n2, Distributive m n) => Distributive m (Compose n n2) where
+	dist = Compose . liftM dist . dist . liftM getCompose
+
+instance (Distributive m n, Distributive m2 m, Distributive m2 n) => Distributive (Compose m m2) n where
+	dist = liftM Compose . dist . liftM dist . getCompose
+
+join' m = Compose $ join $ liftM (liftM join . dist) m
+
+-- | Monads with a distributive law compose to give another monad.
+instance (Distributive n m) => Monad (Compose m n) where
+	return = Compose . return . return
+	Compose m >>= f = join' (liftM (liftM (getCompose . f)) m)
+
+instance (Monad m) => MonadTrans (Compose m) where
+	lift = Compose . return
+

+ Control/Monad/IOT.hs view

@@ -0,0 +1,59 @@+{-# LANGUAGE MagicHash, UnboxedTuples, Rank2Types #-}
+
+module Control.Monad.IOT (IOT, run) where
+
+import GHC.IO hiding (liftIO)
+import GHC.Prim
+import Control.Monad.Trans (MonadIO(..))
+import Control.Monad.Identity
+import Control.Monad.Morph
+import Control.Monad
+import Control.Applicative
+
+data St = St { unSt :: !(State# RealWorld) }
+
+-- | An IO monad transformer.
+--
+-- I can't run 'IOT'. Instead, I run the monad inside it.
+-- This is done using 'run', and 'hoist' from mmorph.
+--
+-- The combination is only a monad if the parameter monad
+-- isn't nondeterministic. IOT Maybe and IOT State are
+-- monads, but IOT [] and IOT Cont are not.
+--
+-- Should be integrated with STT.
+
+newtype IOT m t = IOT (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)
+
+instance (Monad m) => Applicative (IOT m) where
+	pure = return
+	(<*>) = ap
+
+instance (Monad m) => Functor (IOT m) where
+	fmap f m = m >>= return . f
+
+instance (Monad m) => MonadIO (IOT m) where
+	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)
+
+-- Flatten two layers into one. mmorph exports 'squash'.
+_squash (IOT f) = IOT (\s -> let IOT g = f s in g s >>= return . snd)
+
+instance MMonad IOT where
+	embed f (IOT g) = _squash $ IOT (f . g)
+
+-- | Run an IOT.
+run :: IOT Identity t -> IO t
+run (IOT f) = IO (\s -> case runIdentity (f (St s)) of
+	(s2, x) -> (# unSt s2, x #))

+ Control/Monad/Plus.hs view

@@ -0,0 +1,63 @@+{-# 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))
+
+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 (flip f)
+
+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)
+

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (c) 2015, James Candyu
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of James Candyu nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ MonadCompose.cabal view

@@ -0,0 +1,18 @@+name:                MonadCompose
+version:             0.1.0.0
+synopsis:            An IO monad transformer
+description:         Methods for composing monads. See also Control.Monad.Trans.Adjoint.
+homepage:            http://alkalisoftware.net
+license:             BSD3
+license-file:        LICENSE
+author:              James Candy
+maintainer:          info@alkalisoftware.net
+-- copyright:           
+category:            Monad
+build-type:          Simple
+cabal-version:       >=1.8
+
+library
+  exposed-modules:     Control.Monad.IOT, Control.Monad.Distributive, Control.Monad.Plus
+  -- other-modules: 
+  build-depends:       base ==4.6.*, ghc-prim ==0.3.*, mtl ==2.1.*, mmorph ==1.0.*, monad-products, transformers

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple
+main = defaultMain