monad-classes 0.3.1.1 → 0.3.2.0

raw patch · 6 files changed

+102/−5 lines, 6 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Control/Monad/Classes/ReadState.hs +49/−0
• Control/Monad/Classes/Reader.hs +8/−0
• Control/Monad/Classes/Run.hs +4/−0
• Control/Monad/Classes/Writer.hs +1/−1
• monad-classes.cabal +3/−2
• tests/test.hs +37/−2

@@ -0,0 +1,49 @@+module Control.Monad.Classes.ReadState where++import Control.Monad.Classes.Core+import Control.Monad.Classes.Effects+import Control.Monad.Classes.Reader+import Control.Monad.Classes.State+import Control.Monad.Trans.Identity+import Control.Monad.Trans.Class+import Control.Applicative+import Control.Monad.Base+import Control.Monad.Trans.Control+import Data.Peano+import Data.Proxy++-- | 'ReadState' is used to translate reader effects into state effects.+--+-- If you run a computation with 'StateT', this handler is not needed,+-- since 'StateT' already handles read requests.+--+-- This is useful in cases when you work in an abstract 'MonadState' monad+-- and thus have no guarantee that its handler will also accept reader+-- requests.+newtype ReadStateT s m a = ReadStateT (IdentityT m a)+  deriving (Functor, Applicative, Monad, MonadTrans)++runReadState :: Proxy s -> ReadStateT s m a -> m a+runReadState _ (ReadStateT (IdentityT a)) = a++type instance CanDo (ReadStateT s m) eff = ReadStateCanDo s eff++type family ReadStateCanDo s eff where+  ReadStateCanDo s (EffReader s) = True+  ReadStateCanDo s eff = False++instance MonadState s m => MonadReaderN Zero s (ReadStateT s m) where+  askN _ = ReadStateT (IdentityT get)++instance MonadBase b m => MonadBase b (ReadStateT x m) where+  liftBase = lift . liftBase++instance MonadTransControl (ReadStateT x) where+  type StT (ReadStateT s) a = StT IdentityT a+  liftWith = defaultLiftWith ReadStateT (\(ReadStateT a) -> a)+  restoreT = defaultRestoreT ReadStateT++instance MonadBaseControl b m => MonadBaseControl b (ReadStateT s m) where+  type StM (ReadStateT s m) a = StM m a+  liftBaseWith     = defaultLiftBaseWith+  restoreM         = defaultRestoreM

@@ -11,6 +11,8 @@  type instance CanDo (R.ReaderT e m) eff = ReaderCanDo e eff +type instance CanDo ((->) e) eff = ReaderCanDo e eff+ type family ReaderCanDo e eff where   ReaderCanDo e (EffReader e) = True   ReaderCanDo e (EffLocal e) = True@@ -28,6 +30,9 @@ instance Monad m => MonadReaderN Zero r (SS.StateT r m) where   askN _ = SS.get +instance MonadReaderN Zero r ((->) r) where+  askN _ = id+ instance (MonadTrans t, Monad (t m), MonadReaderN n r m, Monad m)   => MonadReaderN (Succ n) r (t m)   where@@ -52,6 +57,9 @@  instance (Monad m) => MonadLocalN Zero r (SS.StateT r m) where   localN _ = stateLocal SS.put SS.get++instance MonadLocalN Zero r ((->) r) where+  localN _ = flip (.)  instance (MonadTrans t, Monad (t m), MFunctor t, MonadLocalN n r m, Monad m)   => MonadLocalN (Succ n) r (t m)

@@ -34,6 +34,9 @@     -- * Zoom   , runZoom   , ZoomT(..)+    -- * ReadState+  , ReadStateT(..)+  , runReadState   ) where  import Data.Functor.Identity@@ -42,6 +45,7 @@ import Control.Monad.Classes.Writer import Control.Monad.Classes.Reader import Control.Monad.Classes.Except+import Control.Monad.Classes.ReadState  run :: Identity a -> a run = runIdentity

@@ -80,7 +80,7 @@ -- the MonadTransControl instance newtype CustomWriterT' w n m a = CustomWriterT (Proxied (w -> n ()) m a)   deriving (Functor, Applicative, Monad, Alternative, MonadPlus, MonadBase b, MonadIO)-type CustomWriterT w m a = CustomWriterT' w m m a+type CustomWriterT w m = CustomWriterT' w m m  instance MonadTrans (CustomWriterT' w n) where   lift a = CustomWriterT $ Proxied $ \_ -> a

@@ -1,5 +1,5 @@ name:                monad-classes-version:             0.3.1.1+version:             0.3.2.0 synopsis:            more flexible mtl -- description: homepage:            https://github.com/strake/monad-classes.hs@@ -27,7 +27,8 @@     Control.Monad.Classes.Exec,     Control.Monad.Classes.Zoom,     Control.Monad.Classes.Core,-    Control.Monad.Classes.Effects+    Control.Monad.Classes.Effects,+    Control.Monad.Classes.ReadState   build-depends:     base >=4.7 && <5,     peano >=0.1,

@@ -1,6 +1,6 @@ {-# LANGUAGE GeneralizedNewtypeDeriving, NoMonomorphismRestriction,              DataKinds, TypeFamilies, TemplateHaskell, ScopedTypeVariables,-             MagicHash #-}+             MagicHash, FlexibleContexts #-} import Test.Tasty import Test.Tasty.HUnit import Control.Monad.Trans.Class@@ -12,6 +12,7 @@ import Control.Applicative import Control.Exception hiding (throw) import Data.Lens.Light+import Data.Proxy import GHC.Prim (Proxy#, proxy#)  -- for IO tests@@ -35,7 +36,8 @@  tests :: TestTree tests = testGroup "Tests"-  [ simpleStateTests+  [ readerTests+  , simpleStateTests   , twoStatesTests   , liftingTest   , localState@@ -45,8 +47,31 @@   , liftNTests   , liftConduitTest   , mapWriterTest+  , readStateTest   ] +readerTests = testGroup "Reader Tests"+  [ testCase "ask" $+      let base = 5 :: Integer+          power = 3 :: Int+          expected = 125 :: Integer+      in (runReader power action) base @?= expected+  , testCase "local ask" $+      let base = 5 :: Integer+          power = 2 :: Int+          altBase = 7 :: Integer+          altPower = 3 :: Int+          expected = 174 :: Integer+          action' = do+            x <- local (const altBase) action+            y <- local (const altPower) action+            pure (x + y)+      in (runReader power action') base @?= expected+  ]+  where+    f = (^) :: Integer -> Int -> Integer+    action = f <$> ask <*> ask+ simpleStateTests = testGroup "Simple State"   [ testCase "get" $       (run $ runStateLazy (0 :: Int) get) @?= (0 :: Int, 0 :: Int)@@ -154,3 +179,13 @@  mapWriterTest = testCase "mapWriter" $ do   run (execWriterStrict $ mapWriter (\(w :: Char) -> [w]) $ do { tell 'a'; tell 'b'; tell 'c' }) @?= "abc"++readStateTest = testCase "ReadState" $ do+  let+    a1 :: MonadReader Char m => m Char+    a1 = ask++    a2 :: MonadState Char m => m Char+    a2 = runReadState (Proxy :: Proxy Char) a1++  run (evalStateStrict 'w' a2) @?= 'w'