{-# 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
  (<%=), (<.=), (<?=),
  (<<%=), (<<.=),

  -- * Zooming
  zoom,
  magnify,
)
where


import Control.Applicative
import Data.Monoid

import Control.Monad.Reader as Reader
import Control.Monad.State as State
-- microlens
import Lens.Micro
import Lens.Micro.Internal
-- Internal modules
import Lens.Micro.Mtl.Internal


{- |
'view' is a synonym for ('^.'), generalised for 'MonadReader' (we are able to use it instead of ('^.') since functions are instances of the 'MonadReader' class):

>>> 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 :: Getting a s a -> m a
view Getting a s a
l = (s -> a) -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
Reader.asks (Const a s -> a
forall a k (b :: k). Const a b -> a
getConst (Const a s -> a) -> (s -> Const a s) -> s -> a
forall c b a. Coercible c b => (b -> c) -> (a -> b) -> a -> c
#. Getting a s a
l a -> Const a a
forall k a (b :: k). a -> Const a b
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 :: Getting (First a) s a -> m (Maybe a)
preview Getting (First a) s a
l = (s -> Maybe a) -> m (Maybe a)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
Reader.asks (First a -> Maybe a
forall a. First a -> Maybe a
getFirst (First a -> Maybe a) -> (s -> First a) -> s -> Maybe a
forall c b a. Coercible c b => (b -> c) -> (a -> b) -> a -> c
#. Getting (First a) s a -> (a -> First a) -> s -> First a
forall r s a. Getting r s a -> (a -> r) -> s -> r
foldMapOf Getting (First a) s a
l (Maybe a -> First a
forall a. Maybe a -> First a
First (Maybe a -> First a) -> (a -> Maybe a) -> a -> First a
forall c b a. Coercible c b => (b -> c) -> (a -> b) -> a -> c
#. a -> Maybe a
forall a. a -> Maybe a
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 :: Getting a s a -> m a
use Getting a s a
l = (s -> a) -> m a
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
State.gets (Getting a s a -> s -> a
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting a s a
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 :: Getting (First a) s a -> m (Maybe a)
preuse Getting (First a) s a
l = (s -> Maybe a) -> m (Maybe a)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
State.gets (Getting (First a) s a -> s -> Maybe a
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First a) s a
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
s &~ :: s -> State s a -> s
&~ State s a
l = State s a -> s -> s
forall s a. State s a -> s -> s
execState State s a
l s
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 ()
ASetter s s a b
l .= :: ASetter s s a b -> b -> m ()
.= b
x = (s -> s) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (ASetter s s a b
l ASetter s s a b -> b -> s -> s
forall s t a b. ASetter s t a b -> b -> s -> t
.~ b
x)
{-# INLINE (.=) #-}

infix 4 .=

{- |
A synonym for ('.=').
-}
assign :: MonadState s m => ASetter s s a b -> b -> m ()
assign :: ASetter s s a b -> b -> m ()
assign ASetter s s a b
l b
x = ASetter s s a b
l ASetter s s a b -> b -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= b
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 ()
ASetter s s a (Maybe b)
l ?= :: ASetter s s a (Maybe b) -> b -> m ()
?= b
b = ASetter s s a (Maybe b)
l ASetter s s a (Maybe b) -> Maybe b -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= b -> Maybe b
forall a. a -> Maybe a
Just b
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 ()
ASetter s s a b
l <~ :: ASetter s s a b -> m b -> m ()
<~ m b
mb = m b
mb m b -> (b -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ASetter s s a b
l ASetter s s a b -> b -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.=)
{-# 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 ()
ASetter s s a b
l %= :: ASetter s s a b -> (a -> b) -> m ()
%= a -> b
f = (s -> s) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (ASetter s s a b
l ASetter s s a b -> (a -> b) -> s -> s
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ a -> b
f)
{-# INLINE (%=) #-}

infix 4 %=

{- |
A synonym for ('%=').
-}
modifying :: (MonadState s m) => ASetter s s a b -> (a -> b) -> m ()
modifying :: ASetter s s a b -> (a -> b) -> m ()
modifying ASetter s s a b
l a -> b
f = ASetter s s a b
l ASetter s s a b -> (a -> b) -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= a -> b
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 ()
ASetter s s a a
l += :: ASetter s s a a -> a -> m ()
+= a
x = ASetter s s a a
l ASetter s s a a -> (a -> a) -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (a -> a -> a
forall a. Num a => a -> a -> a
+a
x)
{-# INLINE (+=) #-}

infix 4 +=

(-=) :: (MonadState s m, Num a) => ASetter s s a a -> a -> m ()
ASetter s s a a
l -= :: ASetter s s a a -> a -> m ()
-= a
x = ASetter s s a a
l ASetter s s a a -> (a -> a) -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (a -> a -> a
forall a. Num a => a -> a -> a
subtract a
x)
{-# INLINE (-=) #-}

infix 4 -=

(*=) :: (MonadState s m, Num a) => ASetter s s a a -> a -> m ()
ASetter s s a a
l *= :: ASetter s s a a -> a -> m ()
*= a
x = ASetter s s a a
l ASetter s s a a -> (a -> a) -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (a -> a -> a
forall a. Num a => a -> a -> a
*a
x)
{-# INLINE (*=) #-}

infix 4 *=

(//=) :: (MonadState s m, Fractional a) => ASetter s s a a -> a -> m ()
ASetter s s a a
l //= :: ASetter s s a a -> a -> m ()
//= a
x = ASetter s s a a
l ASetter s s a a -> (a -> a) -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (a -> a -> a
forall a. Fractional a => a -> a -> a
/a
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
LensLike ((,) b) s s a b
l <%= :: LensLike ((,) b) s s a b -> (a -> b) -> m b
<%= a -> b
f = LensLike ((,) b) s s a b
l LensLike ((,) b) s s a b -> (a -> (b, b)) -> m b
forall s (m :: * -> *) r a b.
MonadState s m =>
LensLike ((,) r) s s a b -> (a -> (r, b)) -> m r
%%= (\b
a -> (b
a, b
a)) (b -> (b, b)) -> (a -> b) -> a -> (b, b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
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
LensLike ((,) a) s s a b
l <<%= :: LensLike ((,) a) s s a b -> (a -> b) -> m a
<<%= a -> b
f = LensLike ((,) a) s s a b
l LensLike ((,) a) s s a b -> (a -> (a, b)) -> m a
forall s (m :: * -> *) r a b.
MonadState s m =>
LensLike ((,) r) s s a b -> (a -> (r, b)) -> m r
%%= (\a
a -> (a
a, a -> b
f a
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
LensLike ((,) a) s s a b
l <<.= :: LensLike ((,) a) s s a b -> b -> m a
<<.= b
b = LensLike ((,) a) s s a b
l LensLike ((,) a) s s a b -> (a -> (a, b)) -> m a
forall s (m :: * -> *) r a b.
MonadState s m =>
LensLike ((,) r) s s a b -> (a -> (r, b)) -> m r
%%= (\a
a -> (a
a, b
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
LensLike ((,) b) s s a b
l <.= :: LensLike ((,) b) s s a b -> b -> m b
<.= b
b = LensLike ((,) b) s s a b
l LensLike ((,) b) s s a b -> (a -> b) -> m b
forall s (m :: * -> *) b a.
MonadState s m =>
LensLike ((,) b) s s a b -> (a -> b) -> m b
<%= b -> a -> b
forall a b. a -> b -> a
const b
b
{-# INLINE (<.=) #-}

infix 4 <.=

{- |
('<?=') is a version of ('<.=') that wraps the value into 'Just' before setting.

@
l '<?=' b = do
  l '.=' Just b
  'return' b
@

It can be useful in combination with 'at'.
-}
(<?=) :: MonadState s m => LensLike ((,) b) s s a (Maybe b) -> b -> m b
LensLike ((,) b) s s a (Maybe b)
l <?= :: LensLike ((,) b) s s a (Maybe b) -> b -> m b
<?= b
b = LensLike ((,) b) s s a (Maybe b)
l LensLike ((,) b) s s a (Maybe b) -> (a -> (b, Maybe b)) -> m b
forall s (m :: * -> *) r a b.
MonadState s m =>
LensLike ((,) r) s s a b -> (a -> (r, b)) -> m r
%%= (b, Maybe b) -> a -> (b, Maybe b)
forall a b. a -> b -> a
const (b
b, b -> Maybe b
forall a. a -> Maybe a
Just b
b)
{-# INLINE (<?=) #-}

infix 4 <?=

(%%=) :: MonadState s m => LensLike ((,) r) s s a b -> (a -> (r, b)) -> m r
#if MIN_VERSION_mtl(2,1,1)
LensLike ((,) r) s s a b
l %%= :: LensLike ((,) r) s s a b -> (a -> (r, b)) -> m r
%%= a -> (r, b)
f = (s -> (r, s)) -> m r
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
State.state (LensLike ((,) r) s s a b
l a -> (r, b)
f)
#else
l %%= f = do
  (r, s) <- State.gets (l f)
  State.put s
  return r
#endif
{-# INLINE (%%=) #-}

infix 4 %%=