packages feed

mtl-unleashed 0.3 → 0.3.1

raw patch · 3 files changed

+139/−17 lines, 3 filesdep +tagged

Dependencies added: tagged

Files

Control/Monad/Readers.hs view
@@ -1,21 +1,29 @@ -- | MonadState without the function dependency @m -> s@. {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE GADTs #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} module Control.Monad.Readers     ( module Control.Monad.Reader+    , magnify'     , MonadReaders(ask, local)     , asks     , view, views, iview, iviews+    , preview, previews, ipreview, ipreviews+    , review, reviews+    , Magnify(magnify)     ) where -import Control.Lens as Lens hiding (view, iview, views, uses, iviews)+import Control.Lens as Lens hiding (view, iview, views, uses, iviews, preview, previews, ipreview, ipreviews, review, reviews, Magnify)+import Control.Lens.Internal.Zoom (Magnified) import Control.Monad.Reader hiding (MonadReader(ask, local, reader), asks) import qualified Control.Monad.Reader as MTL (ask, local) import Control.Monad.State (mapStateT, StateT) import Control.Monad.Writer (WriterT, mapWriterT)-+import Data.Monoid import Data.Profunctor.Unsafe+import Data.Tagged  -- | Version of MonadReader modified to remove the functional dependency. class Monad m => MonadReaders r m where@@ -69,3 +77,40 @@  iviews :: MonadReaders s m => IndexedGetting i r s a -> (i -> a -> r) -> m r iviews l = views l .# Indexed++review :: MonadReaders b m => AReview t b -> m t+review p = asks (runIdentity #. unTagged #. p .# Tagged .# Identity)++reviews :: MonadReaders b m => AReview t b -> (t -> r) -> m r+reviews p tr = asks (tr . runIdentity #. unTagged #. p .# Tagged .# Identity)++instance MonadReaders s (ReifiedGetter s) where+  ask = Getter id+  {-# INLINE ask #-}+  local f m = Getter (to f . runGetter m)+  {-# INLINE local #-}++instance MonadReaders s (ReifiedFold s) where+  ask = Fold id+  {-# INLINE ask #-}+  local f m = Fold (to f . runFold m)+  {-# INLINE local #-}++preview :: MonadReaders s m => Getting (First a) s a -> m (Maybe a)+preview l = asks (getFirst #. foldMapOf l (First #. Just))++ipreview :: MonadReaders s m => IndexedGetting i (First (i, a)) s a -> m (Maybe (i, a))+ipreview l = asks (getFirst #. ifoldMapOf l (\i a -> First (Just (i, a))))++previews :: MonadReaders s m => Getting (First r) s a -> (a -> r) -> m (Maybe r)+previews l f = asks (getFirst . foldMapOf l (First #. Just . f))++ipreviews :: MonadReaders s m => IndexedGetting i (First r) s a -> (i -> a -> r) -> m (Maybe r)+ipreviews l f = asks (getFirst . ifoldMapOf l (\i -> First #. Just . f i))++class (Magnified m ~ Magnified n, MonadReaders b m, MonadReaders a n) => Magnify m n b a | m -> b, n -> a, m a -> n, n b -> m where+  magnify :: LensLike' (Magnified m c) a b -> m c -> n c++-- | I don't know why Control.Lens.magnify isn't working for me.+magnify' :: forall r s m b. MonadReaders s m => Getting r s r -> ReaderT r m b -> m b+magnify' lns action = view lns >>= runReaderT action
Tests/Main.hs view
@@ -1,28 +1,105 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-} module Main where -import Control.Lens-import Control.Monad.Reader (runReader)-import Control.Monad.State (evalState)+import Control.Lens as Lens+import Control.Monad.Readers as Readers+import Control.Monad.States as States+import qualified Control.Monad.Reader as MTL+import qualified Control.Monad.State as MTL import Test.Hspec hiding (runIO) import Test.Hspec.Core.Spec (SpecM)-import Types -main :: IO ()-main = hspec $ tests+data S = S {+      _s1 :: Float,+      _s2 :: Bool+    } +data T = T {+      _t1 :: Int,+      _t2 :: Char+    }++data R = R {+      _s :: S+    , _t :: T+    }++$(makeLenses ''S)+$(makeLenses ''T)+$(makeLenses ''R)++runBoth action = runReader (runReaderT action (T 5 'x')) (S 2.5 True)++runR action = runReader action (R (S 2.5 True) (T 5 'x'))++instance Monad m => MonadReaders S (ReaderT R m) where+    ask = {-Readers.magnify-} Readers.magnify' s ask+    local f action = ask >>= \(r :: R) -> runReaderT (lift action) (set s (f (Lens.view s r)) r)++instance Monad m => MonadReaders T (ReaderT R m) where+    ask = {-Readers.magnify-} Readers.magnify' t ask+    local f action = ask >>= \(r :: R) -> runReaderT (lift action) (set t (f (Lens.view t r)) r)++instance MonadReaders S m => MonadReaders S (ReaderT T m) where+    ask = lift ask+    local f action = MTL.ask >>= MTL.runReaderT (local f (lift action))++-- This is where the advantages of MonadReaders start to appear:+-- use two different MonadReaders instances for the same monad.+s1t1 :: (MonadReaders S m, MonadReaders T m) => m (Float, Int)+s1t1 = (,) <$> Readers.view s1 <*> Readers.view t1+ tests :: SpecM () () tests = do   it "runs a test" $ do      1 `shouldBe` 1 -  it "sees some state" $ do-     evalState (use foo) (T 5 'r') `shouldBe` 5+  it "Can read a value out of Reader using Lens.view" $ do+     runReader (Lens.view t1) (T 3 'x') `shouldBe` 3 -  it "sees T using MonadReaders class and lens" $ do-     runReader monadReaders1 (T 5 'r') `shouldBe` 5+  it "Can read a value out of Reader using Readers.view" $ do+     runReader (Lens.view t1) (T 3 'x') `shouldBe` 3 +  it "Can read a pure value using Lens.view" $ do+     Lens.view t1 (T 3 'x') `shouldBe` 3++#if 0+  -- Something that makes this work for Lens is missing.  I have a+  -- feeling inserting a type signature somewhere would help.+  it "Can read a pure value Readers.view" $ do+     Readers.view t1 (T 3 'x') `shouldBe` (3 :: Int)+#endif+   it "sees T using MonadReaders class and modified lens" $ do-     runReader monadReaders2 (T 5 'r') `shouldBe` 5+     runReader (Readers.view t1) (T 3 'x') `shouldBe` 3 -  it "sees T using MonadStates class" $ do-     evalState monadStates1 (T 5 'r') `shouldBe` 5+  it "Can use state using Lens" $ do+     evalState (Lens.use t1) (T 5 'r') `shouldBe` 5++  it "Can use state using States" $ do+     evalState (States.use t1) (T 3 'x') `shouldBe` 3+#if 0+  -- These two won't compile due to functional dependency+  it "sees T using MonadReader class and lens" $ do+     runBoth (Lens.view t1) `shouldBe` 5++  it "sees S using MonadReader class and lens" $ do+     runBoth (Lens.view s1) `shouldBe` 2.5+#endif++  it "sees T using MonadReaders class and lens" $ do+     runBoth (Readers.view t1) `shouldBe` 5++  it "sees S using MonadReaders class and lens" $ do+     runBoth (Readers.view s1) `shouldBe` 2.5++  it "Can read two different types out of the same monad" $ do+     runR s1t1 `shouldBe` (2.5, 5)++main :: IO ()+main = hspec $ tests
mtl-unleashed.cabal view
@@ -1,5 +1,5 @@ name:               mtl-unleashed-version:            0.3+version:            0.3.1 cabal-version:      >= 1.10 build-type:         Simple license:            BSD3@@ -19,7 +19,7 @@   extra type signatures.  library-  build-depends: base < 5, lens, mtl, contravariant, profunctors+  build-depends: base < 5, lens, mtl, contravariant, profunctors, tagged   ghc-options: -Wall -O2   exposed-modules:     Control.Monad.Readers