git.iko.soy/typeable/ether
on master help sign in
Some updates
commitbd5c1c9d0524dab0d1f168bbe93da479c3478e19 authorIndex Int <vlad.z.4096@gmail.com> dateThu 11 Jun 2015, 11:29 (11 years ago) parentb297d44
8 files changed+102−32
compare with master
unifiedsplit
ether.cabal+1−1 src/Control/Ether/Core.hs → src/Control/Ether/Tags.hs+1−1 src/Control/Ether/Wrapped.hs+6 src/Control/Monad/Ether/Reader.hs+10−10 src/Control/Monad/Ether/State.hs+2−2 src/Control/Monad/Trans/Ether/Reader.hs+32−9 src/Control/Monad/Trans/Ether/State.hs+4−4 test/Regression.hs+46−5
ether.cabal+1−1
@@ -23,7 +23,7 @@ source-repository head
2323
2424library
2525
26− exposed-modules: Control.Ether.Core
26+ exposed-modules: Control.Ether.Tags
2727 Control.Ether.TH
2828 Control.Ether.Wrapped
2929 Control.Monad.Trans.Ether.Reader
src/Control/Ether/Core.hs → src/Control/Ether/Tags.hsrenamed+1−1
@@ -4,7 +4,7 @@
44{-# LANGUAGE ConstraintKinds #-}
55{-# LANGUAGE TypeOperators #-}
66{-# LANGUAGE UndecidableInstances #-}
7−module Control.Ether.Core
7+module Control.Ether.Tags
88 ( Tags
99 , UniqueTag
1010 , UniqueTags
src/Control/Ether/Wrapped.hs+6
@@ -12,8 +12,10 @@ import Control.Monad (MonadPlus)
1212import Control.Monad.Fix (MonadFix)
1313import Control.Monad.IO.Class (MonadIO)
1414import Control.Monad.Ether.Reader
15+import Control.Monad.Ether.State
1516
1617import qualified Control.Monad.Reader as Class
18+import qualified Control.Monad.State as Class
1719
1820newtype WrappedEther tag m a = WrapEther { unwrapEther :: m a }
1921 deriving ( Functor, Applicative, Alternative, Monad, MonadPlus
@@ -23,5 +25,9 @@ instance MonadReader tag r m => Class.MonadReader r (WrappedEther tag m) where
2325 ask = WrapEther $ ask (Proxy :: Proxy tag)
2426 local f = WrapEther . local (Proxy :: Proxy tag) f . unwrapEther
2527
28+instance MonadState tag s m => Class.MonadState s (WrappedEther tag m) where
29+ get = WrapEther $ get (Proxy :: Proxy tag)
30+ put = WrapEther . put (Proxy :: Proxy tag)
31+
2632ethered :: proxy tag -> WrappedEther tag m a -> m a
2733ethered _proxy = unwrapEther
src/Control/Monad/Ether/Reader.hs+10−10
@@ -11,16 +11,16 @@
1111{-# LANGUAGE RankNTypes #-}
1212{-# LANGUAGE GeneralizedNewtypeDeriving #-}
1313module Control.Monad.Ether.Reader
14− ( ReaderT
14+ (
15+ -- * MonadReader class
16+ MonadReader(..)
17+ , asks
18+ -- * The Reader monad
1519 , Reader
16− , runReaderT
1720 , runReader
18− --
19− , MonadReader
20− , local
21− , ask
22− , reader
23− , asks
21+ -- * The ReaderT monad transformer
22+ , ReaderT
23+ , runReaderT
2424 ) where
2525
2626import Data.Proxy (Proxy(Proxy))
@@ -76,8 +76,8 @@ asks
7676asks = reader
7777
7878instance {-# OVERLAPPING #-} Monad m => MonadReader tag r (ReaderT tag r m) where
79− ask proxy = etherReaderT proxy return
80− local proxy f m = etherReaderT proxy (runReaderT proxy m . f)
79+ ask proxy = readerT proxy return
80+ local proxy f m = readerT proxy (runReaderT proxy m . f)
8181
8282instance (MonadReader tag r m) => MonadReader tag r (ReaderT tag' r' m) where
8383 ask proxy = lift (ask proxy)
src/Control/Monad/Ether/State.hs+2−2
@@ -69,8 +69,8 @@ modify :: MonadState tag s m => proxy tag -> (s -> s) -> m ()
6969modify proxy f = state proxy $ \ s -> ((), f s)
7070
7171instance {-# OVERLAPPING #-} Monad m => MonadState tag s (StateT tag s m) where
72− get proxy = etherStateT proxy (\s -> return (s, s))
73− put proxy s = etherStateT proxy (\_ -> return ((), s))
72+ get proxy = stateT proxy (\s -> return (s, s))
73+ put proxy s = stateT proxy (\_ -> return ((), s))
7474
7575instance (MonadState tag s m) => MonadState tag s (StateT tag' s' m) where
7676 get proxy = lift (get proxy)
src/Control/Monad/Trans/Ether/Reader.hs+32−9
@@ -7,12 +7,16 @@
77{-# LANGUAGE TypeOperators #-}
88{-# LANGUAGE GeneralizedNewtypeDeriving #-}
99module Control.Monad.Trans.Ether.Reader
10− ( ReaderT
11− , Reader
12− , runReaderT
10+ (
11+ -- * The Reader monad
12+ Reader
1313 , runReader
14− , etherReaderT
14+ -- * The ReaderT monad transformer
15+ , ReaderT
16+ , readerT
17+ , runReaderT
1518 , mapReaderT
19+ -- * Lifting other operations
1620 , liftCatch
1721 , liftCallCC
1822 ) where
@@ -25,7 +29,7 @@ import Control.Monad (MonadPlus)
2529import Control.Monad.Fix (MonadFix)
2630import Control.Monad.Trans.Class (MonadTrans, lift)
2731import Control.Monad.IO.Class (MonadIO)
28−import Control.Ether.Core
32+import Control.Ether.Tags (Tags)
2933
3034import qualified Control.Monad.Signatures as Sig
3135import qualified Control.Monad.Trans.Reader as Trans
@@ -36,29 +40,48 @@ import qualified Control.Monad.State.Class as Class
3640import qualified Control.Monad.Writer.Class as Class
3741import qualified Control.Monad.Error.Class as Class
3842
43+-- | The parameterizable reader monad.
44+--
45+-- Computations are functions of a shared environment.
46+--
47+-- The 'return' function ignores the environment, while '>>=' passes
48+-- the inherited environment to both subcomputations.
49+type Reader tag r = ReaderT tag r Identity
50+
51+-- | The reader monad transformer,
52+-- which adds a read-only environment to the given monad.
53+--
54+-- The 'return' function ignores the environment, while '>>=' passes
55+-- the inherited environment to both subcomputations.
3956newtype ReaderT tag r m a = ReaderT (Trans.ReaderT r m a)
4057 deriving ( Functor, Applicative, Alternative, Monad, MonadPlus
4158 , MonadFix, MonadTrans, MonadIO )
4259
4360type instance Tags (ReaderT tag r m) = tag ': Tags m
4461
45−type Reader tag r = ReaderT tag r Identity
46−
47−etherReaderT :: proxy tag -> (r -> m a) -> ReaderT tag r m a
48−etherReaderT _proxy = ReaderT . Trans.ReaderT
62+-- | Constructor for computations in the reader monad transformer.
63+readerT :: proxy tag -> (r -> m a) -> ReaderT tag r m a
64+readerT _proxy = ReaderT . Trans.ReaderT
4965
66+-- | Runs a 'Reader' and extracts the final value from it.
5067runReaderT :: proxy tag -> ReaderT tag r m a -> r -> m a
5168runReaderT _proxy (ReaderT (Trans.ReaderT f)) = f
5269
70+-- | Runs a 'Reader' and extracts the final value from it.
5371runReader :: proxy tag -> Reader tag r a -> r -> a
5472runReader proxy m r = runIdentity (runReaderT proxy m r)
5573
74+-- | Transform the computation inside a @ReaderT@.
75+--
76+-- * @'runReaderT' tag ('mapReaderT' tag f m) = f . 'runReaderT' tag m@
5677mapReaderT :: proxy tag -> (m a -> n b) -> ReaderT tag r m a -> ReaderT tag r n b
5778mapReaderT _proxy f m = ReaderT $ Trans.mapReaderT f (coerce m)
5879
80+-- | Lift a @catchE@ operation to the new monad.
5981liftCatch :: proxy tag -> Sig.Catch e m a -> Sig.Catch e (ReaderT tag r m) a
6082liftCatch _proxy f m h = ReaderT $ Trans.liftCatch f (coerce m) (coerce h)
6183
84+-- | Lift a @callCC@ operation to the new monad.
6285liftCallCC :: proxy tag -> Sig.CallCC m a b -> Sig.CallCC (ReaderT tag r m) a b
6386liftCallCC _proxy callCC f = ReaderT $ Trans.liftCallCC callCC (coerce f)
6487
src/Control/Monad/Trans/Ether/State.hs+4−4
@@ -15,7 +15,7 @@ module Control.Monad.Trans.Ether.State
1515 , evalState
1616 , execStateT
1717 , execState
18− , etherStateT
18+ , stateT
1919 , mapStateT
2020 , liftCatch
2121 , liftCallCC'
@@ -31,7 +31,7 @@ import Control.Monad (MonadPlus)
3131import Control.Monad.Fix (MonadFix)
3232import Control.Monad.Trans.Class (MonadTrans, lift)
3333import Control.Monad.IO.Class (MonadIO)
34−import Control.Ether.Core
34+import Control.Ether.Tags (Tags)
3535
3636import qualified Control.Monad.Signatures as Sig
3737import qualified Control.Monad.Trans.State.Lazy as Trans
@@ -50,8 +50,8 @@ type instance Tags (StateT tag r m) = tag ': Tags m
5050
5151type State tag r = StateT tag r Identity
5252
53−etherStateT :: proxy tag -> (s -> m (a, s)) -> StateT tag s m a
54−etherStateT _proxy = StateT . Trans.StateT
53+stateT :: proxy tag -> (s -> m (a, s)) -> StateT tag s m a
54+stateT _proxy = StateT . Trans.StateT
5555
5656runStateT :: proxy tag -> StateT tag s m a -> s -> m (a, s)
5757runStateT _proxy (StateT (Trans.StateT f)) = f
test/Regression.hs+46−5
@@ -6,13 +6,15 @@
66{-# LANGUAGE ScopedTypeVariables #-}
77module Main where
88
9−import Control.Ether.Core
9+import Control.Ether.Tags
1010import Control.Ether.TH
1111import Control.Ether.Wrapped
1212import Control.Monad.Ether.Reader
1313import Control.Monad.Ether.State
1414import qualified Control.Monad.Ether.Implicit.Reader as I
15−import qualified Control.Monad.Reader as Tagless
15+import qualified Control.Monad.Ether.Implicit.State as I
16+import qualified Control.Monad.Reader as T
17+import qualified Control.Monad.State as T
1618
1719import Test.Tasty
1820import Test.Tasty.QuickCheck
@@ -72,9 +74,28 @@ implicitCore = I.local (succ :: Int -> Int) $ do
7274 b <- I.local not I.ask
7375 return (if b then "" else show n)
7476
75−wrapCore :: MonadReader R1 Int m => m Int
76−wrapCore = ethered r1 Tagless.ask
77+wrapCore
78+ :: ( T.MonadReader Int m
79+ , T.MonadState Int m
80+ ) => m Int
81+wrapCore = do
82+ b <- T.get
83+ a <- T.ask
84+ T.put (a + b)
85+ return (a * b)
7786
87+wrapCore'
88+ :: ( MonadReader S1 Int m
89+ , MonadState S1 Int m
90+ , MonadReader R1 Int m
91+ ) => m Int
92+wrapCore' = do
93+ a <- ethered s1 wrapCore
94+ c <- ask r1
95+ return (a + c)
96+
97+wrapCore'' :: Int -> (Int, Int)
98+wrapCore'' a = runReader r1 (runStateT s1 (runReaderT s1 wrapCore' a) a) (-1)
7899
79100-- Should not compile with `ensureUniqueTags`
80101uniqueTagsCore :: IO ()
@@ -87,7 +108,7 @@ uniqueTagsCore = flip (runReaderT r1) (1 :: Int)
87108 a :: Integer <- ask r1
88109 b :: Int <- ask r1
89110 c :: Bool <- ask r1
90− Tagless.liftIO $ do
111+ T.liftIO $ do
91112 print a
92113 print b
93114 print c
@@ -99,3 +120,23 @@ stateCore = do
99120 a <- ask r1
100121 n <- get s1
101122 put s1 (n * a)
123+ modify s1 (subtract 1)
124+
125+recurseCore :: (Num a, Ord a) => (I.MonadReader a m, I.MonadState Int m) => m a
126+recurseCore = do
127+ a <- I.ask
128+ if (a <= 0)
129+ then do
130+ I.put (0 :: Int)
131+ return 1
132+ else do
133+ I.modify (succ :: Int -> Int)
134+ b <- I.runReaderT recurseCore (a - 1)
135+ I.modify (succ :: Int -> Int)
136+ return (a * b)
137+
138+factorial :: (Num a, Ord a) => a -> (a, Int)
139+factorial a = I.runState (I.runReaderT recurseCore a) (0 :: Int)
140+
141+factorial' :: Int -> (Int, Int)
142+factorial' a = factorial (a :: Int)