microlens-mtl-0.2.0.3/0000755000000000000000000000000007346545000012630 5ustar0000000000000000microlens-mtl-0.2.0.3/CHANGELOG.md0000644000000000000000000000265207346545000014446 0ustar0000000000000000# 0.2.0.2 * Added support for mtl 2.3 and transformers 0.6 per [#152](https://github.com/stevenfontanella/microlens/issues/152). # 0.2.0.1 * No more conditional `Safe` (see [#122](https://github.com/monadfix/microlens/issues/122)). # 0.2.0 * Removed of equality constraints on `Zoom` and `Magnify`, as was done in `lens` earlier. This allows instances of `Zoom` and `Magnify` for `FreeT`. (Thanks to @treeowl.) # 0.1.11.1 * Fixed compilation on GHC 8.4. # 0.1.11.0 * Exported `Focusing`, etc. from `Lens.Micro.Mtl.Internal`. * Added `&~`. # 0.1.10.0 * Added ` family; see the readme . license: BSD3 license-file: LICENSE author: Edward Kmett, Artyom Kazak maintainer: Steven Fontanella homepage: http://github.com/monadfix/microlens bug-reports: http://github.com/monadfix/microlens/issues -- copyright: category: Data, Lenses build-type: Simple extra-source-files: CHANGELOG.md cabal-version: >=1.10 tested-with: GHC==7.6.3 GHC==7.8.4 GHC==7.10.3 GHC==8.0.2 GHC==8.2.2 GHC==8.4.4 GHC==8.6.5 GHC==8.8.4 GHC==8.10.7 GHC==9.0.2 GHC==9.2.5 GHC==9.4.3 source-repository head type: git location: git://github.com/monadfix/microlens.git library exposed-modules: Lens.Micro.Mtl Lens.Micro.Mtl.Internal -- other-extensions: build-depends: base >=4.5 && <5 , microlens >=0.4 && <0.5 , mtl >=2.0.1 && <2.4 , transformers >=0.2 && <0.7 , transformers-compat >=0.4 && <1 ghc-options: -Wall -fwarn-tabs -O2 -fdicts-cheap -funbox-strict-fields -fmax-simplifier-iterations=10 hs-source-dirs: src default-language: Haskell2010 default-extensions: TypeOperators microlens-mtl-0.2.0.3/src/Lens/Micro/0000755000000000000000000000000007346545000015371 5ustar0000000000000000microlens-mtl-0.2.0.3/src/Lens/Micro/Mtl.hs0000644000000000000000000001643007346545000016465 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE Trustworthy #-} -- This is needed because ErrorT is deprecated. {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} {- | Module : Lens.Micro.Mtl Copyright : (C) 2013-2016 Edward Kmett, 2015-2016 Artyom Kazak, 2018 Monadfix License : BSD-style (see the file LICENSE) -} module Lens.Micro.Mtl ( -- * Getting view, preview, use, preuse, -- * Setting (%=), modifying, (.=), assign, (?=), (<~), -- * Convenience (&~), -- * Specialised modifying operators -- $arith-note (+=), (-=), (*=), (//=), -- * Setting with passthrough (<%=), (<.=), (>> view _1 (1, 2) 1 When you're using 'Reader.Reader' for config and your config type has lenses generated for it, most of the time you'll be using 'view' instead of 'Reader.asks': @ doSomething :: ('MonadReader' Config m) => m Int doSomething = do thingy <- 'view' setting1 -- same as “'Reader.asks' ('^.' setting1)” anotherThingy <- 'view' setting2 ... @ -} view :: MonadReader s m => Getting a s a -> m a view l = Reader.asks (getConst #. l Const) {-# INLINE view #-} {- | 'preview' is a synonym for ('^?'), generalised for 'MonadReader' (just like 'view', which is a synonym for ('^.')). >>> preview each [1..5] Just 1 -} preview :: MonadReader s m => Getting (First a) s a -> m (Maybe a) preview l = Reader.asks (getFirst #. foldMapOf l (First #. Just)) {-# INLINE preview #-} {- | 'use' is ('^.') (or 'view') which implicitly operates on the state; for instance, if your state is a record containing a field @foo@, you can write @ x \<- 'use' foo @ to extract @foo@ from the state. In other words, 'use' is the same as 'State.gets', but for getters instead of functions. The implementation of 'use' is straightforward: @ 'use' l = 'State.gets' ('view' l) @ If you need to extract something with a fold or traversal, you need 'preuse'. -} use :: MonadState s m => Getting a s a -> m a use l = State.gets (view l) {-# INLINE use #-} {- | 'preuse' is ('^?') (or 'preview') which implicitly operates on the state – it takes the state and applies a traversal (or fold) to it to extract the 1st element the traversal points at. @ 'preuse' l = 'State.gets' ('preview' l) @ -} preuse :: MonadState s m => Getting (First a) s a -> m (Maybe a) preuse l = State.gets (preview l) {-# INLINE preuse #-} {- | This can be used to chain lens operations using @op=@ syntax rather than @op~@ syntax for simple non-type-changing cases. >>> (10,20) & _1 .~ 30 & _2 .~ 40 (30,40) >>> (10,20) &~ do _1 .= 30; _2 .= 40 (30,40) This does not support type-changing assignment, /e.g./ >>> (10,20) & _1 .~ "hello" ("hello",20) -} (&~) :: s -> State s a -> s s &~ l = execState l s {-# INLINE (&~) #-} infixl 1 &~ {- | Modify state by “assigning” a value to a part of the state. This is merely ('.~') which works in 'MonadState': @ l '.=' x = 'State.modify' (l '.~' x) @ If you also want to know the value that was replaced by ('.='), use ('<<.='). -} (.=) :: MonadState s m => ASetter s s a b -> b -> m () l .= x = State.modify (l .~ x) {-# INLINE (.=) #-} infix 4 .= {- | A synonym for ('.='). -} assign :: MonadState s m => ASetter s s a b -> b -> m () assign l x = l .= x {-# INLINE assign #-} {- | ('?=') is a version of ('.=') that wraps the value into 'Just' before setting. @ l '?=' b = l '.=' Just b @ It can be useful in combination with 'at'. -} (?=) :: MonadState s m => ASetter s s a (Maybe b) -> b -> m () l ?= b = l .= Just b {-# INLINE (?=) #-} infix 4 ?= {- | ('<~') is a version of ('.=') that takes a monadic value (and then executes it and assigns the result to the lens). @ l '<~' mb = do b <- mb l '.=' b @ -} (<~) :: MonadState s m => ASetter s s a b -> m b -> m () l <~ mb = mb >>= (l .=) {-# INLINE (<~) #-} infixr 2 <~ {- | Modify state by applying a function to a part of the state. An example: >>> execState (do _1 %= (+1); _2 %= reverse) (1,"hello") (2,"olleh") Implementation: @ l '%=' f = 'State.modify' (l '%~' f) @ If you also want to get the value before\/after the modification, use ('<<%=')\/('<%='). There are a few specialised versions of ('%=') which mimic C operators: * ('+=') for addition * ('-=') for substraction * ('*=') for multiplication * ('//=') for division -} (%=) :: (MonadState s m) => ASetter s s a b -> (a -> b) -> m () l %= f = State.modify (l %~ f) {-# INLINE (%=) #-} infix 4 %= {- | A synonym for ('%='). -} modifying :: (MonadState s m) => ASetter s s a b -> (a -> b) -> m () modifying l f = l %= f {-# INLINE modifying #-} {- $arith-note The following operators mimic well-known C operators ('+=', '-=', etc). ('//=') stands for division. They're implemented like this: @ l '+=' x = l '%=' (+x) l '-=' x = l '%=' ('subtract' x) ... @ -} (+=) :: (MonadState s m, Num a) => ASetter s s a a -> a -> m () l += x = l %= (+x) {-# INLINE (+=) #-} infix 4 += (-=) :: (MonadState s m, Num a) => ASetter s s a a -> a -> m () l -= x = l %= (subtract x) {-# INLINE (-=) #-} infix 4 -= (*=) :: (MonadState s m, Num a) => ASetter s s a a -> a -> m () l *= x = l %= (*x) {-# INLINE (*=) #-} infix 4 *= (//=) :: (MonadState s m, Fractional a) => ASetter s s a a -> a -> m () l //= x = l %= (/x) {-# INLINE (//=) #-} infix 4 //= {- | Modify state and return the modified (new) value. @ l '<%=' f = do l '%=' f 'use' l @ -} (<%=) :: MonadState s m => LensLike ((,) b) s s a b -> (a -> b) -> m b l <%= f = l %%= (\a -> (a, a)) . f {-# INLINE (<%=) #-} infix 4 <%= {- | Modify state and return the old value (i.e. as it was before the modificaton). @ l '<<%=' f = do old <- 'use' l l '%=' f return old @ -} (<<%=) :: MonadState s m => LensLike ((,) a) s s a b -> (a -> b) -> m a l <<%= f = l %%= (\a -> (a, f a)) {-# INLINE (<<%=) #-} infix 4 <<%= {- | Set state and return the old value. @ l '<<.=' b = do old <- 'use' l l '.=' b return old @ -} (<<.=) :: MonadState s m => LensLike ((,) a) s s a b -> b -> m a l <<.= b = l %%= (\a -> (a, b)) {-# INLINE (<<.=) #-} infix 4 <<.= {- | Set state and return new value. @ l '<.=' b = do l '.=' b return b @ -} (<.=) :: MonadState s m => LensLike ((,) b) s s a b -> b -> m b l <.= b = l <%= const b {-# INLINE (<.=) #-} infix 4 <.= {- | (' LensLike ((,) b) s s a (Maybe b) -> b -> m b l LensLike ((,) r) s s a b -> (a -> (r, b)) -> m r #if MIN_VERSION_mtl(2,1,1) l %%= f = State.state (l f) #else l %%= f = do (r, s) <- State.gets (l f) State.put s return r #endif {-# INLINE (%%=) #-} infix 4 %%= microlens-mtl-0.2.0.3/src/Lens/Micro/Mtl/0000755000000000000000000000000007346545000016125 5ustar0000000000000000microlens-mtl-0.2.0.3/src/Lens/Micro/Mtl/Internal.hs0000644000000000000000000004725707346545000020254 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE Trustworthy #-} #if !MIN_VERSION_base(4, 9, 0) {-# LANGUAGE DataKinds #-} #endif -- This is needed because ErrorT is deprecated. {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} {- | Module : Lens.Micro.Mtl.Internal Copyright : (C) 2013-2016 Edward Kmett, 2015-2016 Artyom Kazak, 2018 Monadfix License : BSD-style (see the file LICENSE) This module lets you define your own instances of 'Zoom' and 'Magnify'. The warning from "Lens.Micro.Internal" applies to this module as well. Don't export functions that have 'Zoom' or 'Magnify' in their type signatures. If you absolutely need to define an instance (e.g. for internal use), only do it for your own types, because otherwise I might add an instance to one of the microlens packages later and if our instances are different it might lead to subtle bugs. -} module Lens.Micro.Mtl.Internal ( -- * Classes Zoomed, Zoom(..), Magnified, Magnify(..), -- * Focusing (used for 'Zoom') Focusing(..), FocusingWith(..), FocusingPlus(..), FocusingOn(..), FocusingMay(..), FocusingErr(..), -- * Effect (used for 'Magnify') Effect(..), EffectRWS(..), -- * Utilities May(..), Err(..), ) where import Control.Applicative #if MIN_VERSION_mtl(2, 3, 0) import Control.Monad (liftM, liftM2) #else #endif import Control.Monad.Reader as Reader import Control.Monad.State as State import Control.Monad.Trans.State.Lazy as Lazy import Control.Monad.Trans.State.Strict as Strict import Control.Monad.Trans.Writer.Lazy as Lazy import Control.Monad.Trans.Writer.Strict as Strict import Control.Monad.Trans.RWS.Lazy as Lazy import Control.Monad.Trans.RWS.Strict as Strict #if !MIN_VERSION_transformers(0, 6, 0) import Control.Monad.Trans.Error import Control.Monad.Trans.List #endif import Control.Monad.Trans.Except import Control.Monad.Trans.Identity import Control.Monad.Trans.Maybe -- microlens import Lens.Micro import Lens.Micro.Internal #if __GLASGOW_HASKELL__ < 710 import Data.Monoid #endif #if MIN_VERSION_base(4,9,0) import Data.Kind (Type) #endif ------------------------------------------------------------------------------ -- Zoomed ------------------------------------------------------------------------------ -- | This type family is used by 'Zoom' to describe the common effect type. #if MIN_VERSION_base(4,9,0) type family Zoomed (m :: Type -> Type) :: Type -> Type -> Type #else type family Zoomed (m :: * -> *) :: * -> * -> * #endif type instance Zoomed (Strict.StateT s z) = Focusing z type instance Zoomed (Lazy.StateT s z) = Focusing z type instance Zoomed (ReaderT e m) = Zoomed m type instance Zoomed (IdentityT m) = Zoomed m type instance Zoomed (Strict.RWST r w s z) = FocusingWith w z type instance Zoomed (Lazy.RWST r w s z) = FocusingWith w z type instance Zoomed (Strict.WriterT w m) = FocusingPlus w (Zoomed m) type instance Zoomed (Lazy.WriterT w m) = FocusingPlus w (Zoomed m) #if !MIN_VERSION_transformers(0, 6, 0) type instance Zoomed (ListT m) = FocusingOn [] (Zoomed m) type instance Zoomed (ErrorT e m) = FocusingErr e (Zoomed m) #endif type instance Zoomed (MaybeT m) = FocusingMay (Zoomed m) type instance Zoomed (ExceptT e m) = FocusingErr e (Zoomed m) ------------------------------------------------------------------------------ -- Focusing ------------------------------------------------------------------------------ -- | Used by 'Zoom' to 'zoom' into 'Control.Monad.State.StateT'. newtype Focusing m s a = Focusing { unfocusing :: m (s, a) } instance Monad m => Functor (Focusing m s) where fmap f (Focusing m) = Focusing $ do (s, a) <- m return (s, f a) {-# INLINE fmap #-} instance (Monad m, Monoid s) => Applicative (Focusing m s) where pure a = Focusing (return (mempty, a)) {-# INLINE pure #-} Focusing mf <*> Focusing ma = Focusing $ do (s, f) <- mf (s', a) <- ma return (mappend s s', f a) {-# INLINE (<*>) #-} ------------------------------------------------------------------------------ -- FocusingWith ------------------------------------------------------------------------------ -- | Used by 'Zoom' to 'zoom' into 'Control.Monad.RWS.RWST'. newtype FocusingWith w m s a = FocusingWith { unfocusingWith :: m (s, a, w) } instance Monad m => Functor (FocusingWith w m s) where fmap f (FocusingWith m) = FocusingWith $ do (s, a, w) <- m return (s, f a, w) {-# INLINE fmap #-} instance (Monad m, Monoid s, Monoid w) => Applicative (FocusingWith w m s) where pure a = FocusingWith (return (mempty, a, mempty)) {-# INLINE pure #-} FocusingWith mf <*> FocusingWith ma = FocusingWith $ do (s, f, w) <- mf (s', a, w') <- ma return (mappend s s', f a, mappend w w') {-# INLINE (<*>) #-} ------------------------------------------------------------------------------ -- FocusingPlus ------------------------------------------------------------------------------ -- | Used by 'Zoom' to 'zoom' into 'Control.Monad.Writer.WriterT'. newtype FocusingPlus w k s a = FocusingPlus { unfocusingPlus :: k (s, w) a } instance Functor (k (s, w)) => Functor (FocusingPlus w k s) where fmap f (FocusingPlus as) = FocusingPlus (fmap f as) {-# INLINE fmap #-} instance Applicative (k (s, w)) => Applicative (FocusingPlus w k s) where pure = FocusingPlus . pure {-# INLINE pure #-} FocusingPlus kf <*> FocusingPlus ka = FocusingPlus (kf <*> ka) {-# INLINE (<*>) #-} ------------------------------------------------------------------------------ -- FocusingOn ------------------------------------------------------------------------------ -- | Used by 'Zoom' to 'zoom' into 'Control.Monad.Trans.Maybe.MaybeT' or 'Control.Monad.Trans.List.ListT'. newtype FocusingOn f k s a = FocusingOn { unfocusingOn :: k (f s) a } instance Functor (k (f s)) => Functor (FocusingOn f k s) where fmap f (FocusingOn as) = FocusingOn (fmap f as) {-# INLINE fmap #-} instance Applicative (k (f s)) => Applicative (FocusingOn f k s) where pure = FocusingOn . pure {-# INLINE pure #-} FocusingOn kf <*> FocusingOn ka = FocusingOn (kf <*> ka) {-# INLINE (<*>) #-} ------------------------------------------------------------------------------ -- May ------------------------------------------------------------------------------ -- | Make a 'Monoid' out of 'Maybe' for error handling. newtype May a = May { getMay :: Maybe a } instance Monoid a => Monoid (May a) where mempty = May (Just mempty) {-# INLINE mempty #-} #if !MIN_VERSION_base(4,11,0) May Nothing `mappend` _ = May Nothing _ `mappend` May Nothing = May Nothing May (Just a) `mappend` May (Just b) = May (Just (mappend a b)) {-# INLINE mappend #-} #else instance Semigroup a => Semigroup (May a) where May Nothing <> _ = May Nothing _ <> May Nothing = May Nothing May (Just a) <> May (Just b) = May (Just (a <> b)) {-# INLINE (<>) #-} #endif ------------------------------------------------------------------------------ -- FocusingMay ------------------------------------------------------------------------------ -- | Used by 'Zoom' to 'zoom' into 'Control.Monad.Error.ErrorT'. newtype FocusingMay k s a = FocusingMay { unfocusingMay :: k (May s) a } instance Functor (k (May s)) => Functor (FocusingMay k s) where fmap f (FocusingMay as) = FocusingMay (fmap f as) {-# INLINE fmap #-} instance Applicative (k (May s)) => Applicative (FocusingMay k s) where pure = FocusingMay . pure {-# INLINE pure #-} FocusingMay kf <*> FocusingMay ka = FocusingMay (kf <*> ka) {-# INLINE (<*>) #-} ------------------------------------------------------------------------------ -- Err ------------------------------------------------------------------------------ -- | Make a 'Monoid' out of 'Either' for error handling. newtype Err e a = Err { getErr :: Either e a } instance Monoid a => Monoid (Err e a) where mempty = Err (Right mempty) {-# INLINE mempty #-} #if !MIN_VERSION_base(4,11,0) Err (Left e) `mappend` _ = Err (Left e) _ `mappend` Err (Left e) = Err (Left e) Err (Right a) `mappend` Err (Right b) = Err (Right (mappend a b)) {-# INLINE mappend #-} #else instance Semigroup a => Semigroup (Err e a) where Err (Left e) <> _ = Err (Left e) _ <> Err (Left e) = Err (Left e) Err (Right a) <> Err (Right b) = Err (Right (a <> b)) {-# INLINE (<>) #-} #endif ------------------------------------------------------------------------------ -- FocusingErr ------------------------------------------------------------------------------ -- | Used by 'Zoom' to 'zoom' into 'Control.Monad.Error.ErrorT'. newtype FocusingErr e k s a = FocusingErr { unfocusingErr :: k (Err e s) a } instance Functor (k (Err e s)) => Functor (FocusingErr e k s) where fmap f (FocusingErr as) = FocusingErr (fmap f as) {-# INLINE fmap #-} instance Applicative (k (Err e s)) => Applicative (FocusingErr e k s) where pure = FocusingErr . pure {-# INLINE pure #-} FocusingErr kf <*> FocusingErr ka = FocusingErr (kf <*> ka) {-# INLINE (<*>) #-} ------------------------------------------------------------------------------ -- Zoom ------------------------------------------------------------------------------ infixr 2 `zoom` class (MonadState s m, MonadState t n) => Zoom m n s t | m -> s, n -> t, m t -> n, n s -> m where {- | When you're in a state monad, this function lets you operate on a part of your state. For instance, if your state was a record containing a @position@ field, after zooming @position@ would become your whole state (and when you modify it, the bigger structure would be modified as well). (Your 'Lazy.State' \/ 'Lazy.StateT' or 'Lazy.RWS' \/ 'Lazy.RWST' can be anywhere in the stack, but you can't use 'zoom' with arbitrary 'MonadState' because it doesn't provide any methods to change the type of the state. See for details.) For the sake of the example, let's define some types first: @ data Position = Position { _x, _y :: Int } data Player = Player { _position :: Position, ... } data Game = Game { _player :: Player, _obstacles :: [Position], ... } concat \<$\> mapM makeLenses [''Position, ''Player, ''Game] @ Now, here's an action that moves the player north-east: @ moveNE :: 'Lazy.State' Game () moveNE = do player.position.x 'Lens.Micro.Mtl.+=' 1 player.position.y 'Lens.Micro.Mtl.+=' 1 @ With 'zoom', you can use @player.position@ to focus just on a part of the state: @ moveNE :: 'Lazy.State' Game () moveNE = do 'zoom' (player.position) $ do x 'Lens.Micro.Mtl.+=' 1 y 'Lens.Micro.Mtl.+=' 1 @ You can just as well use it for retrieving things out of the state: @ getCoords :: 'Lazy.State' Game (Int, Int) getCoords = 'zoom' (player.position) ((,) '<$>' 'Lens.Micro.Mtl.use' x '<*>' 'Lens.Micro.Mtl.use' y) @ Or more explicitly: @ getCoords = 'zoom' (player.position) $ do x' <- 'Lens.Micro.Mtl.use' x y' <- 'Lens.Micro.Mtl.use' y return (x', y') @ When you pass a traversal to 'zoom', it'll work as a loop. For instance, here we move all obstacles: @ moveObstaclesNE :: 'Lazy.State' Game () moveObstaclesNE = do 'zoom' (obstacles.'each') $ do x 'Lens.Micro.Mtl.+=' 1 y 'Lens.Micro.Mtl.+=' 1 @ If the action returns a result, all results would be combined with '<>' – the same way they're combined when '^.' is passed a traversal. In this example, @moveObstaclesNE@ returns a list of old coordinates of obstacles in addition to moving them: @ moveObstaclesNE = do xys <- 'zoom' (obstacles.'each') $ do -- Get old coordinates. x' <- 'Lens.Micro.Mtl.use' x y' <- 'Lens.Micro.Mtl.use' y -- Update them. x 'Lens.Micro.Mtl..=' x' + 1 y 'Lens.Micro.Mtl..=' y' + 1 -- Return a single-element list with old coordinates. return [(x', y')] ... @ Finally, you might need to write your own instances of 'Zoom' if you use @newtype@d transformers in your monad stack. This can be done as follows: @ import "Lens.Micro.Mtl.Internal" type instance 'Zoomed' (MyStateT s m) = 'Zoomed' (StateT s m) instance Monad m =\> 'Zoom' (MyStateT s m) (MyStateT t m) s t where 'zoom' l (MyStateT m) = MyStateT ('zoom' l m) @ -} zoom :: LensLike' (Zoomed m c) t s -> m c -> n c instance Monad z => Zoom (Strict.StateT s z) (Strict.StateT t z) s t where zoom l (Strict.StateT m) = Strict.StateT $ unfocusing #. l (Focusing #. m) {-# INLINE zoom #-} instance Monad z => Zoom (Lazy.StateT s z) (Lazy.StateT t z) s t where zoom l (Lazy.StateT m) = Lazy.StateT $ unfocusing #. l (Focusing #. m) {-# INLINE zoom #-} instance Zoom m n s t => Zoom (ReaderT e m) (ReaderT e n) s t where zoom l (ReaderT m) = ReaderT (zoom l . m) {-# INLINE zoom #-} instance Zoom m n s t => Zoom (IdentityT m) (IdentityT n) s t where zoom l (IdentityT m) = IdentityT (zoom l m) {-# INLINE zoom #-} instance (Monoid w, Monad z) => Zoom (Strict.RWST r w s z) (Strict.RWST r w t z) s t where zoom l (Strict.RWST m) = Strict.RWST $ \r -> unfocusingWith #. l (FocusingWith #. m r) {-# INLINE zoom #-} instance (Monoid w, Monad z) => Zoom (Lazy.RWST r w s z) (Lazy.RWST r w t z) s t where zoom l (Lazy.RWST m) = Lazy.RWST $ \r -> unfocusingWith #. l (FocusingWith #. m r) {-# INLINE zoom #-} instance (Monoid w, Zoom m n s t) => Zoom (Strict.WriterT w m) (Strict.WriterT w n) s t where zoom l = Strict.WriterT . zoom (\afb -> unfocusingPlus #. l (FocusingPlus #. afb)) . Strict.runWriterT {-# INLINE zoom #-} instance (Monoid w, Zoom m n s t) => Zoom (Lazy.WriterT w m) (Lazy.WriterT w n) s t where zoom l = Lazy.WriterT . zoom (\afb -> unfocusingPlus #. l (FocusingPlus #. afb)) . Lazy.runWriterT {-# INLINE zoom #-} #if !MIN_VERSION_mtl(2, 3, 0) && !MIN_VERSION_transformers(0, 6, 0) instance Zoom m n s t => Zoom (ListT m) (ListT n) s t where zoom l = ListT . zoom (\afb -> unfocusingOn . l (FocusingOn . afb)) . runListT {-# INLINE zoom #-} instance (Error e, Zoom m n s t) => Zoom (ErrorT e m) (ErrorT e n) s t where zoom l = ErrorT . liftM getErr . zoom (\afb -> unfocusingErr #. l (FocusingErr #. afb)) . liftM Err . runErrorT {-# INLINE zoom #-} #endif instance Zoom m n s t => Zoom (MaybeT m) (MaybeT n) s t where zoom l = MaybeT . liftM getMay . zoom (\afb -> unfocusingMay #. l (FocusingMay #. afb)) . liftM May . runMaybeT {-# INLINE zoom #-} instance Zoom m n s t => Zoom (ExceptT e m) (ExceptT e n) s t where zoom l = ExceptT . liftM getErr . zoom (\afb -> unfocusingErr #. l (FocusingErr #. afb)) . liftM Err . runExceptT {-# INLINE zoom #-} -- TODO: instance Zoom m m a a => Zoom (ContT r m) (ContT r m) a a where ------------------------------------------------------------------------------ -- Magnified ------------------------------------------------------------------------------ -- | This type family is used by 'Magnify' to describe the common effect type. #if MIN_VERSION_base(4,9,0) type family Magnified (m :: Type -> Type) :: Type -> Type -> Type #else type family Magnified (m :: * -> *) :: * -> * -> * #endif type instance Magnified (ReaderT b m) = Effect m type instance Magnified ((->)b) = Const type instance Magnified (Strict.RWST a w s m) = EffectRWS w s m type instance Magnified (Lazy.RWST a w s m) = EffectRWS w s m type instance Magnified (IdentityT m) = Magnified m ------------------------------------------------------------------------------ -- Magnify ------------------------------------------------------------------------------ infixr 2 `magnify` class (MonadReader b m, MonadReader a n) => Magnify m n b a | m -> b, n -> a, m a -> n, n b -> m where {- | This is an equivalent of 'Reader.local' which lets you apply a getter to your environment instead of merely applying a function (and it also lets you change the type of the environment). @ 'Reader.local' :: (r -> r) -> 'Reader.Reader' r a -> 'Reader.Reader' r a 'magnify' :: Getter r x -> 'Reader.Reader' x a -> 'Reader.Reader' r a @ 'magnify' works with 'Reader.Reader' \/ 'Reader.ReaderT', 'Lazy.RWS' \/ 'Lazy.RWST', and @(->)@. Here's an example of 'magnify' being used to work with a part of a bigger config. First, the types: @ data URL = URL { _protocol :: Maybe String, _path :: String } data Config = Config { _base :: URL, ... } makeLenses ''URL makeLenses ''Config @ Now, let's define a function which returns the base url: @ getBase :: 'Reader.Reader' Config String getBase = do protocol \<- 'Data.Maybe.fromMaybe' \"https\" '<$>' 'Lens.Micro.Mtl.view' (base.protocol) path \<- 'Lens.Micro.Mtl.view' (base.path) return (protocol ++ path) @ With 'magnify', we can factor out @base@: @ getBase = 'magnify' base $ do protocol \<- 'Data.Maybe.fromMaybe' \"https\" '<$>' 'Lens.Micro.Mtl.view' protocol path \<- 'Lens.Micro.Mtl.view' path return (protocol ++ path) @ This concludes the example. Finally, you should know writing instances of 'Magnify' for your own types can be done as follows: @ import "Lens.Micro.Mtl.Internal" type instance 'Magnified' (MyReaderT r m) = 'Magnified' (ReaderT r m) instance Monad m =\> 'Magnify' (MyReaderT r m) (MyReaderT t m) r t where 'magnify' l (MyReaderT m) = MyReaderT ('magnify' l m) @ -} magnify :: LensLike' (Magnified m c) a b -> m c -> n c instance Monad m => Magnify (ReaderT b m) (ReaderT a m) b a where magnify l (ReaderT m) = ReaderT $ getEffect #. l (Effect #. m) {-# INLINE magnify #-} instance Magnify ((->) b) ((->) a) b a where magnify l f = Reader.asks (getConst #. l (Const #. f)) {-# INLINE magnify #-} instance (Monad m, Monoid w) => Magnify (Strict.RWST b w s m) (Strict.RWST a w s m) b a where magnify l (Strict.RWST m) = Strict.RWST $ getEffectRWS #. l (EffectRWS #. m) {-# INLINE magnify #-} instance (Monad m, Monoid w) => Magnify (Lazy.RWST b w s m) (Lazy.RWST a w s m) b a where magnify l (Lazy.RWST m) = Lazy.RWST $ getEffectRWS #. l (EffectRWS #. m) {-# INLINE magnify #-} instance Magnify m n b a => Magnify (IdentityT m) (IdentityT n) b a where magnify l (IdentityT m) = IdentityT (magnify l m) {-# INLINE magnify #-} ----------------------------------------------------------------------------- --- Effect ------------------------------------------------------------------------------- -- | Wrap a monadic effect with a phantom type argument. newtype Effect m r a = Effect { getEffect :: m r } -- type role Effect representational nominal phantom instance Functor (Effect m r) where fmap _ (Effect m) = Effect m {-# INLINE fmap #-} instance (Monad m, Monoid r) => Monoid (Effect m r a) where mempty = Effect (return mempty) {-# INLINE mempty #-} #if !MIN_VERSION_base(4,11,0) Effect ma `mappend` Effect mb = Effect (liftM2 mappend ma mb) {-# INLINE mappend #-} #else instance (Monad m, Semigroup r) => Semigroup (Effect m r a) where Effect ma <> Effect mb = Effect (liftM2 (<>) ma mb) {-# INLINE (<>) #-} #endif instance (Monad m, Monoid r) => Applicative (Effect m r) where pure _ = Effect (return mempty) {-# INLINE pure #-} Effect ma <*> Effect mb = Effect (liftM2 mappend ma mb) {-# INLINE (<*>) #-} ------------------------------------------------------------------------------ -- EffectRWS ------------------------------------------------------------------------------ -- | Wrap a monadic effect with a phantom type argument. Used when magnifying 'Control.Monad.RWS.RWST'. newtype EffectRWS w st m s a = EffectRWS { getEffectRWS :: st -> m (s,st,w) } instance Functor (EffectRWS w st m s) where fmap _ (EffectRWS m) = EffectRWS m {-# INLINE fmap #-} instance (Monoid s, Monoid w, Monad m) => Applicative (EffectRWS w st m s) where pure _ = EffectRWS $ \st -> return (mempty, st, mempty) {-# INLINE pure #-} EffectRWS m <*> EffectRWS n = EffectRWS $ \st -> m st >>= \ (s,t,w) -> n t >>= \ (s',u,w') -> return (mappend s s', u, mappend w w') {-# INLINE (<*>) #-}