mtl-c (empty) → 0

raw patch · 6 files changed

+230/−0 lines, 6 filesdep +basedep +mtlsetup-changed

Dependencies added: base, mtl

Files

Control/Monad/Reader/CPS.hs +49/−0
Control/Monad/State/CPS.hs +65/−0
Control/Monad/Writer/CPS.hs +62/−0
LICENSE +30/−0
Setup.hs +2/−0
mtl-c.cabal +22/−0

+ Control/Monad/Reader/CPS.hs view

@@ -0,0 +1,49 @@+{-# LANGUAGE Trustworthy, Rank2Types, FlexibleInstances, FlexibleContexts, MultiParamTypeClasses #-}
+module Control.Monad.Reader.CPS where
+import Control.Monad.Reader.Class
+import Control.Applicative
+import Control.Monad.Identity
+import Control.Monad.Trans
+
+newtype ReaderT r m a = ReaderT { unReaderT :: forall b. r -> (a -> m b) -> m b }
+
+runReaderT :: Monad m => ReaderT r m a -> r -> m a
+runReaderT m r = unReaderT m r return
+{-# INLINE runReaderT #-}
+
+mapReaderT :: (Monad m, Monad n) => (m a -> n b) -> ReaderT r m a -> ReaderT r n b
+mapReaderT t m = ReaderT $ \r c -> t (unReaderT m r return) >>= c
+
+instance Functor (ReaderT r m) where
+    fmap f m = ReaderT $ \r c -> unReaderT m r (c . f)
+    {-# INLINABLE fmap #-}
+
+instance Applicative (ReaderT r m) where
+    pure x = ReaderT $ \_ c -> c x
+    {-# INLINABLE pure #-}
+    mf <*> ma = ReaderT $ \r c -> unReaderT mf r $ \f -> unReaderT ma r (c . f)
+    {-# INLINABLE (<*>) #-}
+
+instance Monad (ReaderT r m) where
+    return x = ReaderT $ \_ c -> c x
+    {-# INLINABLE return #-}
+    m >>= k = ReaderT $ \r c -> unReaderT m r (\a -> unReaderT (k a) r c)
+    {-# INLINABLE (>>=) #-}
+
+instance MonadReader r (ReaderT r m) where
+    ask = ReaderT $ \r c -> c r
+    {-# INLINABLE ask #-}
+    local f m = ReaderT $ \r c -> unReaderT m (f r) c
+    {-# INLINABLE local #-}
+    reader f = ReaderT $ \r c -> c (f r)
+    {-# INLINABLE reader #-}
+
+instance MonadTrans (ReaderT r) where
+    lift m = ReaderT $ const (m >>=)
+    {-# INLINABLE lift #-}
+
+type Reader r = ReaderT r Identity
+
+runReader :: Reader r a -> r -> a
+runReader m r = runIdentity (runReaderT m r)
+{-# INLINABLE runReader #-}

+ Control/Monad/State/CPS.hs view

@@ -0,0 +1,65 @@+{-# LANGUAGE Trustworthy, Rank2Types, FlexibleInstances, FlexibleContexts, MultiParamTypeClasses #-}
+module Control.Monad.State.CPS where
+import Control.Monad.State.Class
+import Control.Applicative
+import Control.Monad.Identity
+import Control.Monad.Trans
+import Unsafe.Coerce
+
+newtype StateT s m a = StateT { unStateT :: forall r. s -> (a -> s -> m r) -> m r }
+
+runStateT :: Monad m => StateT s m a -> s -> m (a, s)
+runStateT m s = unStateT m s (\a s -> return (a, s))
+{-# INLINABLE runStateT #-}
+
+evalStateT :: Monad m => StateT s m a -> s -> m a
+evalStateT m s = unStateT m s $ \a _ -> return a
+{-# INLINABLE evalStateT #-}
+
+execStateT :: Monad m => StateT s m a -> s -> m s
+execStateT m s = unStateT m s $ \_ s -> return s
+{-# INLINABLE execStateT #-}
+
+mapStateT :: (Monad m, Monad n) => (m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
+mapStateT t m = StateT $ \s c -> t (unStateT m s (\a s -> return (a, s))) >>= \(b, s') -> c b s'
+
+instance Functor (StateT s m) where
+    fmap f m = StateT $ \s c -> unStateT m s (c . f)
+    {-# INLINABLE fmap #-}
+
+instance Applicative (StateT s m) where
+    pure x = StateT $ \s c -> c x s
+    {-# INLINABLE pure #-}
+    mf <*> ma = StateT $ \s c -> unStateT mf s (\f s' -> unStateT ma s' (c . f))
+    {-# INLINABLE (<*>) #-}
+
+instance Monad (StateT s m) where
+    return x = StateT $ \s c -> c x s
+    {-# INLINABLE return #-}
+    m >>= k = StateT $ \s c -> unStateT m s (\a s' -> unStateT (k a) s' c)
+
+instance MonadState s (StateT s m) where
+    get = StateT $ \s c -> c s s
+    {-# INLINABLE get #-}
+    put s = StateT $ \_ c -> c () s
+    {-# INLINABLE put #-}
+    state f = StateT $ \s c -> uncurry c (f s)
+    {-# INLINABLE state #-}
+
+instance MonadTrans (StateT s) where
+    lift m = StateT $ \s c -> m >>= \a -> c a s
+    {-# INLINABLE lift #-}
+
+type State s = StateT s Identity
+
+runState :: State s a -> s -> (a, s)
+runState = (unsafeCoerce `asTypeOf` (runIdentity.)) . runStateT
+{-# INLINABLE runState #-}
+
+evalState :: State s a -> s -> a
+evalState = (unsafeCoerce `asTypeOf` (runIdentity.)) . evalStateT
+{-# INLINABLE evalState #-}
+
+execState :: State s a -> s -> s
+execState = (unsafeCoerce `asTypeOf` (runIdentity.)) . execStateT
+{-# INLINABLE execState #-}

+ Control/Monad/Writer/CPS.hs view

@@ -0,0 +1,62 @@+{-# LANGUAGE Trustworthy, Rank2Types, FlexibleInstances, FlexibleContexts, MultiParamTypeClasses #-}
+module Control.Monad.Writer.CPS where
+
+import Control.Monad.Writer.Class
+import Control.Applicative
+import Control.Monad.Identity
+import Data.Monoid
+import Control.Monad.Trans
+import Unsafe.Coerce
+
+newtype WriterT w m a = WriterT { unWriterT :: forall r. (a -> w -> m r) -> m r }
+
+runWriterT :: Monad m => WriterT w m a -> m (a, w)
+runWriterT m = unWriterT m (\a w -> return (a, w))
+{-# INLINABLE runWriterT #-}
+
+execWriterT :: Monad m => WriterT w m a -> m w
+execWriterT m = unWriterT m (const return)
+{-# INLINABLE execWriterT #-}
+
+mapWriterT :: (Monad m, Monad n) => (m (a, w) -> n (b, w)) -> WriterT w m a -> WriterT w n b
+mapWriterT t m = WriterT $ \c -> t (unWriterT m (\a w -> return (a, w))) >>= \(b, w') -> c b w'
+
+instance Functor (WriterT w m) where
+    fmap f m = WriterT $ \c -> unWriterT m (c . f)
+    {-# INLINABLE fmap #-}
+
+instance Monoid w => Applicative (WriterT w m) where
+    pure x = WriterT $ \c -> c x mempty
+    {-# INLINABLE pure #-}
+    mf <*> ma = WriterT $ \c -> unWriterT mf $ \f w -> unWriterT ma $ \a w' -> c (f a) (mappend w w')
+    {-# INLINABLE (<*>) #-}
+
+instance Monoid w => Monad (WriterT w m) where
+    return x = WriterT $ \c -> c x mempty
+    {-# INLINABLE return #-}
+    m >>= k = WriterT $ \c -> unWriterT m $ \a w -> unWriterT (k a) $ \b w' -> c b (mappend w w')
+    {-# INLINABLE (>>=) #-}
+
+instance Monoid w => MonadWriter w (WriterT w m) where
+    writer (a, w) = WriterT $ \c -> c a w
+    {-# INLINABLE writer #-}
+    tell w = WriterT $ \c -> c () w
+    {-# INLINABLE tell #-}
+    listen m = WriterT $ \c -> unWriterT m (\a w -> c (a, w) w)
+    {-# INLINABLE listen #-}
+    pass m = WriterT $ \c -> unWriterT m (\(a, f) w -> c a (f w))
+    {-# INLINABLE pass #-}
+
+instance Monoid w => MonadTrans (WriterT w) where
+    lift m = WriterT $ \c -> m >>= \a -> c a mempty
+    {-# INLINABLE lift #-}
+
+type Writer w = WriterT w Identity
+
+runWriter :: Writer w a -> (a, w)
+runWriter = (unsafeCoerce `asTypeOf` (runIdentity.)) runWriterT
+{-# INLINABLE runWriter #-}
+
+execWriter :: Writer w a -> w
+execWriter = (unsafeCoerce `asTypeOf` (runIdentity.)) execWriterT
+{-# INLINABLE execWriter #-}

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (c) 2013, Fumiaki Kinoshita
+
+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 Fumiaki Kinoshita 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.

+ Setup.hs view

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

+ mtl-c.cabal view

@@ -0,0 +1,22 @@+name:                mtl-c
+version:             0
+synopsis:            Monad transformers using continuation passing style
+description:         Monad transformers in CPS
+homepage:            https://github.com/fumieval/mtl-c
+license:             BSD3
+license-file:        LICENSE
+author:              Fumiaki Kinoshita
+maintainer:          Fumiaki Kinoshita <fumiexcel@gmail.com>
+copyright:           Copyright (C) 2013 Fumiaki Kinoshita
+category:            Monads
+build-type:          Simple
+cabal-version:       >=1.8
+
+source-repository head
+  type: git
+  location: https://github.com/fumieval/objective.git
+
+library
+  exposed-modules:     Control.Monad.Reader.CPS, Control.Monad.Writer.CPS, Control.Monad.State.CPS
+  -- other-modules:
+  build-depends:       base ==4.*, mtl ==2.*