1{-# LANGUAGE CPP #-}
2{-# LANGUAGE MultiParamTypeClasses #-}
3{-# LANGUAGE FunctionalDependencies #-}
4{-# LANGUAGE FlexibleInstances #-}
5{-# LANGUAGE UndecidableInstances #-}
6{-# LANGUAGE TypeFamilies #-}
7{-# LANGUAGE Trustworthy #-}
8
9-- This is needed because ErrorT is deprecated.
10{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
11
12
13{- |
14Module      :  Lens.Micro.Mtl
15Copyright   :  (C) 2013-2016 Edward Kmett, 2015-2016 Artyom Kazak, 2018 Monadfix
16License     :  BSD-style (see the file LICENSE)
17-}
18module Lens.Micro.Mtl
19(
20  -- * Getting
21  view, preview,
22  use, preuse,
23
24  -- * Setting
25  (%=), modifying,
26  (.=), assign,
27  (?=),
28  (<~),
29
30  -- * Convenience
31  (&~),
32
33  -- * Specialised modifying operators
34  -- $arith-note
35  (+=), (-=), (*=), (//=),
36
37  -- * Setting with passthrough
38  (<%=), (<.=), (<?=),
39  (<<%=), (<<.=),
40
41  -- * Zooming
42  zoom,
43  magnify,
44)
45where
46
47
48import Control.Applicative
49import Data.Monoid
50
51import Control.Monad.Reader as Reader
52import Control.Monad.State as State
53-- microlens
54import Lens.Micro
55import Lens.Micro.Internal
56-- Internal modules
57import Lens.Micro.Mtl.Internal
58
59
60{- |
61'view' is a synonym for ('^.'), generalised for 'MonadReader' (we are able to use it instead of ('^.') since functions are instances of the 'MonadReader' class):
62
63>>> view _1 (1, 2)
641
65
66When 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':
67
68@
69doSomething :: ('MonadReader' Config m) => m Int
70doSomething = do
71  thingy        <- 'view' setting1  -- same as “'Reader.asks' ('^.' setting1)”
72  anotherThingy <- 'view' setting2
73  ...
74@
75-}
76view :: MonadReader s m => Getting a s a -> m a
77view l = Reader.asks (getConst #. l Const)
78{-# INLINE view #-}
79
80{- |
81'preview' is a synonym for ('^?'), generalised for 'MonadReader' (just like 'view', which is a synonym for ('^.')).
82
83>>> preview each [1..5]
84Just 1
85-}
86preview :: MonadReader s m => Getting (First a) s a -> m (Maybe a)
87preview l = Reader.asks (getFirst #. foldMapOf l (First #. Just))
88{-# INLINE preview #-}
89
90{- |
91'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
92
93@
94x \<- 'use' foo
95@
96
97to extract @foo@ from the state. In other words, 'use' is the same as 'State.gets', but for getters instead of functions.
98
99The implementation of 'use' is straightforward:
100
101@
102'use' l = 'State.gets' ('view' l)
103@
104
105If you need to extract something with a fold or traversal, you need 'preuse'.
106-}
107use :: MonadState s m => Getting a s a -> m a
108use l = State.gets (view l)
109{-# INLINE use #-}
110
111{- |
112'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.
113
114@
115'preuse' l = 'State.gets' ('preview' l)
116@
117-}
118preuse :: MonadState s m => Getting (First a) s a -> m (Maybe a)
119preuse l = State.gets (preview l)
120{-# INLINE preuse #-}
121
122{- |
123This can be used to chain lens operations using @op=@ syntax
124rather than @op~@ syntax for simple non-type-changing cases.
125>>> (10,20) & _1 .~ 30 & _2 .~ 40
126(30,40)
127
128>>> (10,20) &~ do _1 .= 30; _2 .= 40
129(30,40)
130
131This does not support type-changing assignment, /e.g./
132
133>>> (10,20) & _1 .~ "hello"
134("hello",20)
135-}
136(&~) :: s -> State s a -> s
137s &~ l = execState l s
138{-# INLINE (&~) #-}
139
140infixl 1 &~
141
142{- |
143Modify state by “assigning” a value to a part of the state.
144
145This is merely ('.~') which works in 'MonadState':
146
147@
148l '.=' x = 'State.modify' (l '.~' x)
149@
150
151If you also want to know the value that was replaced by ('.='), use ('<<.=').
152-}
153(.=) :: MonadState s m => ASetter s s a b -> b -> m ()
154l .= x = State.modify (l .~ x)
155{-# INLINE (.=) #-}
156
157infix 4 .=
158
159{- |
160A synonym for ('.=').
161-}
162assign :: MonadState s m => ASetter s s a b -> b -> m ()
163assign l x = l .= x
164{-# INLINE assign #-}
165
166{- |
167('?=') is a version of ('.=') that wraps the value into 'Just' before setting.
168
169@
170l '?=' b = l '.=' Just b
171@
172
173It can be useful in combination with 'at'.
174-}
175(?=) :: MonadState s m => ASetter s s a (Maybe b) -> b -> m ()
176l ?= b = l .= Just b
177{-# INLINE (?=) #-}
178
179infix 4 ?=
180
181{- |
182('<~') is a version of ('.=') that takes a monadic value (and then executes it and assigns the result to the lens).
183
184@
185l '<~' mb = do
186  b <- mb
187  l '.=' b
188@
189-}
190(<~) :: MonadState s m => ASetter s s a b -> m b -> m ()
191l <~ mb = mb >>= (l .=)
192{-# INLINE (<~) #-}
193
194infixr 2 <~
195
196{- |
197Modify state by applying a function to a part of the state. An example:
198
199>>> execState (do _1 %= (+1); _2 %= reverse) (1,"hello")
200(2,"olleh")
201
202Implementation:
203
204@
205l '%=' f = 'State.modify' (l '%~' f)
206@
207
208If you also want to get the value before\/after the modification, use ('<<%=')\/('<%=').
209
210There are a few specialised versions of ('%=') which mimic C operators:
211
212* ('+=') for addition
213* ('-=') for substraction
214* ('*=') for multiplication
215* ('//=') for division
216-}
217(%=) :: (MonadState s m) => ASetter s s a b -> (a -> b) -> m ()
218l %= f = State.modify (l %~ f)
219{-# INLINE (%=) #-}
220
221infix 4 %=
222
223{- |
224A synonym for ('%=').
225-}
226modifying :: (MonadState s m) => ASetter s s a b -> (a -> b) -> m ()
227modifying l f = l %= f
228{-# INLINE modifying #-}
229
230{- $arith-note
231
232The following operators mimic well-known C operators ('+=', '-=', etc). ('//=') stands for division.
233
234They're implemented like this:
235
236@
237l '+=' x = l '%=' (+x)
238l '-=' x = l '%=' ('subtract' x)
239...
240@
241-}
242
243(+=) :: (MonadState s m, Num a) => ASetter s s a a -> a -> m ()
244l += x = l %= (+x)
245{-# INLINE (+=) #-}
246
247infix 4 +=
248
249(-=) :: (MonadState s m, Num a) => ASetter s s a a -> a -> m ()
250l -= x = l %= (subtract x)
251{-# INLINE (-=) #-}
252
253infix 4 -=
254
255(*=) :: (MonadState s m, Num a) => ASetter s s a a -> a -> m ()
256l *= x = l %= (*x)
257{-# INLINE (*=) #-}
258
259infix 4 *=
260
261(//=) :: (MonadState s m, Fractional a) => ASetter s s a a -> a -> m ()
262l //= x = l %= (/x)
263{-# INLINE (//=) #-}
264
265infix 4 //=
266
267{- |
268Modify state and return the modified (new) value.
269
270@
271l '<%=' f = do
272  l '%=' f
273  'use' l
274@
275-}
276(<%=) :: MonadState s m => LensLike ((,) b) s s a b -> (a -> b) -> m b
277l <%= f = l %%= (\a -> (a, a)) . f
278{-# INLINE (<%=) #-}
279
280infix 4 <%=
281
282{- |
283Modify state and return the old value (i.e. as it was before the modificaton).
284
285@
286l '<<%=' f = do
287  old <- 'use' l
288  l '%=' f
289  return old
290@
291-}
292(<<%=) :: MonadState s m => LensLike ((,) a) s s a b -> (a -> b) -> m a
293l <<%= f = l %%= (\a -> (a, f a))
294{-# INLINE (<<%=) #-}
295
296infix 4 <<%=
297
298{- |
299Set state and return the old value.
300
301@
302l '<<.=' b = do
303  old <- 'use' l
304  l '.=' b
305  return old
306@
307-}
308(<<.=) :: MonadState s m => LensLike ((,) a) s s a b -> b -> m a
309l <<.= b = l %%= (\a -> (a, b))
310{-# INLINE (<<.=) #-}
311
312infix 4 <<.=
313
314{- |
315Set state and return new value.
316
317@
318l '<.=' b = do
319  l '.=' b
320  return b
321@
322-}
323(<.=) :: MonadState s m => LensLike ((,) b) s s a b -> b -> m b
324l <.= b = l <%= const b
325{-# INLINE (<.=) #-}
326
327infix 4 <.=
328
329{- |
330('<?=') is a version of ('<.=') that wraps the value into 'Just' before setting.
331
332@
333l '<?=' b = do
334  l '.=' Just b
335  'return' b
336@
337
338It can be useful in combination with 'at'.
339-}
340(<?=) :: MonadState s m => LensLike ((,) b) s s a (Maybe b) -> b -> m b
341l <?= b = l %%= const (b, Just b)
342{-# INLINE (<?=) #-}
343
344infix 4 <?=
345
346(%%=) :: MonadState s m => LensLike ((,) r) s s a b -> (a -> (r, b)) -> m r
347#if MIN_VERSION_mtl(2,1,1)
348l %%= f = State.state (l f)
349#else
350l %%= f = do
351  (r, s) <- State.gets (l f)
352  State.put s
353  return r
354#endif
355{-# INLINE (%%=) #-}
356
357infix 4 %%=
358