1{-# LANGUAGE UndecidableInstances #-} 2{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} 3module Optics.Zoom 4 ( 5 -- * Zoom 6 Zoom(..) 7 -- * Magnify 8 , Magnify(..) 9 , MagnifyMany(..) 10 ) where 11 12import Control.Monad.Reader as Reader 13import Control.Monad.State 14import Control.Monad.Trans.Error 15import Control.Monad.Trans.Except 16import Control.Monad.Trans.Identity 17import Control.Monad.Trans.List 18import Control.Monad.Trans.Maybe 19import Control.Monad.Trans.RWS.Lazy as L 20import Control.Monad.Trans.RWS.Strict as S 21import Control.Monad.Trans.State.Lazy as L 22import Control.Monad.Trans.State.Strict as S 23import Control.Monad.Trans.Writer.Lazy as L 24import Control.Monad.Trans.Writer.Strict as S 25 26import Optics.Core 27import Optics.Internal.Utils 28import Optics.Extra.Internal.Zoom 29 30-- Chosen so that they have lower fixity than ('%='). 31infixr 2 `zoom`, `zoomMaybe`, `zoomMany` 32infixr 2 `magnify`, `magnifyMaybe`, `magnifyMany` 33 34------------------------------------------------------------------------------ 35-- Zoom 36------------------------------------------------------------------------------ 37 38-- | This class allows us to 'zoom' in, changing the 'State' supplied by many 39-- different monad transformers, potentially quite deep in a monad transformer 40-- stack. 41-- 42-- Its functions can be used to run a monadic action in a larger 'State' than it 43-- was defined in, using a 'Lens'', an 'AffineTraversal'' or a 'Traversal''. 44-- 45-- This is commonly used to lift actions in a simpler 'State' 'Monad' into a 46-- 'State' 'Monad' with a larger 'State' type. 47-- 48-- When used with a 'Traversal'' over multiple values, the actions for each 49-- target are executed sequentially and the results are aggregated. 50-- 51-- This can be used to edit pretty much any 'Monad' transformer stack with a 52-- 'State' in it! 53-- 54-- >>> flip L.evalState ('a','b') $ zoom _1 $ use equality 55-- 'a' 56-- 57-- >>> flip S.execState ('a','b') $ zoom _1 $ equality .= 'c' 58-- ('c','b') 59-- 60-- >>> flip L.execState [(1,2),(3,4)] $ zoomMany traversed $ _2 %= (*10) 61-- [(1,20),(3,40)] 62-- 63-- >>> flip S.runState [('a',"b"),('c',"d")] $ zoomMany traversed $ _2 <%= (\x -> x <> x) 64-- ("bbdd",[('a',"bb"),('c',"dd")]) 65-- 66-- >>> flip S.evalState ("a","b") $ zoomMany each (use equality) 67-- "ab" 68-- 69class 70 (MonadState s m, MonadState t n 71 ) => Zoom m n s t | m -> s, n -> t, m t -> n, n s -> m where 72 zoom 73 :: Is k A_Lens 74 => Optic' k is t s 75 -> m c 76 -> n c 77 78 zoomMaybe 79 :: Is k An_AffineTraversal 80 => Optic' k is t s 81 -> m c 82 -> n (Maybe c) 83 84 zoomMany 85 :: (Is k A_Traversal, Monoid c) 86 => Optic' k is t s 87 -> m c 88 -> n c 89 90instance Monad m => Zoom (S.StateT s m) (S.StateT t m) s t where 91 zoom o = \(S.StateT m) -> S.StateT $ stateZoom o m 92 zoomMaybe o = \(S.StateT m) -> S.StateT $ stateZoomMaybe o m 93 zoomMany o = \(S.StateT m) -> S.StateT $ stateZoomMany o m 94 {-# INLINE zoom #-} 95 {-# INLINE zoomMaybe #-} 96 {-# INLINE zoomMany #-} 97 98instance Monad m => Zoom (L.StateT s m) (L.StateT t m) s t where 99 zoom o = \(L.StateT m) -> L.StateT $ stateZoom o m 100 zoomMaybe o = \(L.StateT m) -> L.StateT $ stateZoomMaybe o m 101 zoomMany o = \(L.StateT m) -> L.StateT $ stateZoomMany o m 102 {-# INLINE zoom #-} 103 {-# INLINE zoomMaybe #-} 104 {-# INLINE zoomMany #-} 105 106instance Zoom m n s t => Zoom (ReaderT e m) (ReaderT e n) s t where 107 zoom o = \(ReaderT m) -> ReaderT (zoom o . m) 108 zoomMaybe o = \(ReaderT m) -> ReaderT (zoomMaybe o . m) 109 zoomMany o = \(ReaderT m) -> ReaderT (zoomMany o . m) 110 {-# INLINE zoom #-} 111 {-# INLINE zoomMaybe #-} 112 {-# INLINE zoomMany #-} 113 114instance Zoom m n s t => Zoom (IdentityT m) (IdentityT n) s t where 115 zoom o = \(IdentityT m) -> IdentityT (zoom o m) 116 zoomMaybe o = \(IdentityT m) -> IdentityT (zoomMaybe o m) 117 zoomMany o = \(IdentityT m) -> IdentityT (zoomMany o m) 118 {-# INLINE zoom #-} 119 {-# INLINE zoomMaybe #-} 120 {-# INLINE zoomMany #-} 121 122instance (Monoid w, Monad m) => Zoom (S.RWST r w s m) (S.RWST r w t m) s t where 123 zoom o = \(S.RWST m) -> S.RWST $ rwsZoom o m 124 zoomMaybe o = \(S.RWST m) -> S.RWST $ rwsZoomMaybe o m 125 zoomMany o = \(S.RWST m) -> S.RWST $ rwsZoomMany o m 126 {-# INLINE zoom #-} 127 {-# INLINE zoomMaybe #-} 128 {-# INLINE zoomMany #-} 129 130instance (Monoid w, Monad m) => Zoom (L.RWST r w s m) (L.RWST r w t m) s t where 131 zoom o = \(L.RWST m) -> L.RWST $ rwsZoom o m 132 zoomMaybe o = \(L.RWST m) -> L.RWST $ rwsZoomMaybe o m 133 zoomMany o = \(L.RWST m) -> L.RWST $ rwsZoomMany o m 134 {-# INLINE zoom #-} 135 {-# INLINE zoomMaybe #-} 136 {-# INLINE zoomMany #-} 137 138instance (Monoid w, Zoom m n s t) => Zoom (S.WriterT w m) (S.WriterT w n) s t where 139 zoom o = S.WriterT #. zoom o .# S.runWriterT 140 zoomMaybe o = S.WriterT #. fmap shuffleW . zoomMaybe o .# S.runWriterT 141 zoomMany o = S.WriterT #. zoomMany o .# S.runWriterT 142 {-# INLINE zoom #-} 143 {-# INLINE zoomMaybe #-} 144 {-# INLINE zoomMany #-} 145 146instance (Monoid w, Zoom m n s t) => Zoom (L.WriterT w m) (L.WriterT w n) s t where 147 zoom o = L.WriterT #. zoom o .# L.runWriterT 148 zoomMaybe o = L.WriterT #. fmap shuffleW . zoomMaybe o .# L.runWriterT 149 zoomMany o = L.WriterT #. zoomMany o .# L.runWriterT 150 {-# INLINE zoom #-} 151 {-# INLINE zoomMaybe #-} 152 {-# INLINE zoomMany #-} 153 154instance Zoom m n s t => Zoom (ListT m) (ListT n) s t where 155 zoom o = ListT #. zoom o .# runListT 156 zoomMaybe o = ListT #. fmap sequenceA . zoomMaybe o .# runListT 157 zoomMany o = ListT #. zoomMany o .# runListT 158 {-# INLINE zoom #-} 159 {-# INLINE zoomMaybe #-} 160 {-# INLINE zoomMany #-} 161 162instance Zoom m n s t => Zoom (MaybeT m) (MaybeT n) s t where 163 zoom o = 164 MaybeT #. zoom o .# runMaybeT 165 zoomMaybe o = 166 MaybeT #. fmap (getMay . shuffleMay) . zoomMaybe o . fmap May .# runMaybeT 167 zoomMany o = 168 MaybeT #. fmap getMay . zoomMany o . fmap May .# runMaybeT 169 {-# INLINE zoom #-} 170 {-# INLINE zoomMaybe #-} 171 {-# INLINE zoomMany #-} 172 173instance (Error e, Zoom m n s t) => Zoom (ErrorT e m) (ErrorT e n) s t where 174 zoom o = 175 ErrorT #. zoom o .# runErrorT 176 zoomMaybe o = 177 ErrorT #. fmap (getErr . shuffleErr) . zoomMaybe o . fmap Err .# runErrorT 178 zoomMany o = 179 ErrorT #. fmap getErr . zoomMany o . fmap Err .# runErrorT 180 {-# INLINE zoom #-} 181 {-# INLINE zoomMaybe #-} 182 {-# INLINE zoomMany #-} 183 184instance Zoom m n s t => Zoom (ExceptT e m) (ExceptT e n) s t where 185 zoom o = 186 ExceptT #. zoom o .# runExceptT 187 zoomMaybe o = 188 ExceptT #. fmap (getErr . shuffleErr) . zoomMaybe o . fmap Err .# runExceptT 189 zoomMany o = 190 ExceptT #. fmap getErr . zoomMany o . fmap Err .# runExceptT 191 {-# INLINE zoom #-} 192 {-# INLINE zoomMaybe #-} 193 {-# INLINE zoomMany #-} 194 195------------------------------------------------------------------------------ 196-- Magnify 197------------------------------------------------------------------------------ 198 199-- | This class allows us to 'magnify' part of the environment, changing the 200-- environment supplied by many different 'Monad' transformers. Unlike 'zoom' 201-- this can change the environment of a deeply nested 'Monad' transformer. 202-- 203-- Its functions can be used to run a monadic action in a larger environment 204-- than it was defined in, using a 'Getter' or an 'AffineFold'. 205-- 206-- They act like 'Control.Monad.Reader.Class.local', but can in many cases 207-- change the type of the environment as well. 208-- 209-- They're commonly used to lift actions in a simpler 'Reader' 'Monad' into a 210-- 'Monad' with a larger environment type. 211-- 212-- They can be used to edit pretty much any 'Monad' transformer stack with an 213-- environment in it: 214-- 215-- >>> (1,2) & magnify _2 (+1) 216-- 3 217-- 218-- >>> flip runReader (1,2) $ magnify _1 Reader.ask 219-- 1 220-- 221-- >>> flip runReader (1,2,[10..20]) $ magnifyMaybe (_3 % _tail) Reader.ask 222-- Just [11,12,13,14,15,16,17,18,19,20] 223-- 224class 225 (MonadReader b m, MonadReader a n 226 ) => Magnify m n b a | m -> b, n -> a, m a -> n, n b -> m where 227 magnify 228 :: Is k A_Getter 229 => Optic' k is a b 230 -> m c 231 -> n c 232 233 magnifyMaybe 234 :: Is k An_AffineFold 235 => Optic' k is a b 236 -> m c 237 -> n (Maybe c) 238 239-- | Extends 'Magnify' with an ability to magnify using a 'Fold' over multiple 240-- targets so that actions for each one are executed sequentially and the 241-- results are aggregated. 242-- 243-- There is however no sensible instance of 'MagnifyMany' for 'StateT'. 244class 245 (MonadReader b m, MonadReader a n, Magnify m n b a 246 ) => MagnifyMany m n b a | m -> b, n -> a, m a -> n, n b -> m where 247 magnifyMany 248 :: (Is k A_Fold, Monoid c) 249 => Optic' k is a b 250 -> m c 251 -> n c 252 253-- | @ 254-- 'magnify' = 'views' 255-- 'magnifyMaybe' = 'previews' 256-- @ 257instance Magnify ((->) b) ((->) a) b a where 258 magnify = views 259 magnifyMaybe = previews 260 {-# INLINE magnify #-} 261 {-# INLINE magnifyMaybe #-} 262 263-- | @ 264-- 'magnifyMany' = 'foldMapOf' 265-- @ 266instance MagnifyMany ((->) b) ((->) a) b a where 267 magnifyMany = foldMapOf 268 {-# INLINE magnifyMany #-} 269 270instance Monad m => Magnify (ReaderT b m) (ReaderT a m) b a where 271 magnify o = \(ReaderT m) -> 272 ReaderT $ \r -> getEffect (views o (Effect #. m) r) 273 magnifyMaybe o = \(ReaderT m) -> 274 ReaderT $ \r -> traverse getEffect (previews o (Effect #. m) r) 275 {-# INLINE magnify #-} 276 {-# INLINE magnifyMaybe #-} 277 278instance Monad m => MagnifyMany (ReaderT b m) (ReaderT a m) b a where 279 magnifyMany o = \(ReaderT m) -> 280 ReaderT $ \r -> getEffect (foldMapOf o (Effect #. m) r) 281 {-# INLINE magnifyMany #-} 282 283instance (Monad m, Monoid w) => Magnify (S.RWST b w s m) (S.RWST a w s m) b a where 284 magnify o = \(S.RWST m) -> S.RWST $ rwsMagnify o m 285 magnifyMaybe o = \(S.RWST m) -> S.RWST $ rwsMagnifyMaybe o m 286 {-# INLINE magnify #-} 287 {-# INLINE magnifyMaybe #-} 288 289instance 290 (Monad m, Monoid w 291 ) => MagnifyMany (S.RWST b w s m) (S.RWST a w s m) b a where 292 magnifyMany o = \(S.RWST m) -> S.RWST $ rwsMagnifyMany o m 293 {-# INLINE magnifyMany #-} 294 295instance (Monad m, Monoid w) => Magnify (L.RWST b w s m) (L.RWST a w s m) b a where 296 magnify o = \(L.RWST m) -> L.RWST $ rwsMagnify o m 297 magnifyMaybe o = \(L.RWST m) -> L.RWST $ rwsMagnifyMaybe o m 298 {-# INLINE magnify #-} 299 {-# INLINE magnifyMaybe #-} 300 301instance 302 (Monad m, Monoid w 303 ) => MagnifyMany (L.RWST b w s m) (L.RWST a w s m) b a where 304 magnifyMany o = \(L.RWST m) -> L.RWST $ rwsMagnifyMany o m 305 {-# INLINE magnifyMany #-} 306 307instance Magnify m n b a => Magnify (IdentityT m) (IdentityT n) b a where 308 magnify o = \(IdentityT m) -> IdentityT (magnify o m) 309 magnifyMaybe o = \(IdentityT m) -> IdentityT (magnifyMaybe o m) 310 {-# INLINE magnify #-} 311 {-# INLINE magnifyMaybe #-} 312 313instance MagnifyMany m n b a => MagnifyMany (IdentityT m) (IdentityT n) b a where 314 magnifyMany o = \(IdentityT m) -> IdentityT (magnifyMany o m) 315 {-# INLINE magnifyMany #-} 316 317instance Magnify m n b a => Magnify (S.StateT s m) (S.StateT s n) b a where 318 magnify o = \(S.StateT m) -> S.StateT $ magnify o . m 319 magnifyMaybe o = \(S.StateT m) -> S.StateT $ \s -> 320 fmap (shuffleS s) $ magnifyMaybe o (m s) 321 {-# INLINE magnify #-} 322 {-# INLINE magnifyMaybe #-} 323 324-- No instance for MagnifyMany (S.StateT s m) (S.StateT s n) b a 325 326instance Magnify m n b a => Magnify (L.StateT s m) (L.StateT s n) b a where 327 magnify o = \(L.StateT m) -> L.StateT $ magnify o . m 328 magnifyMaybe o = \(L.StateT m) -> L.StateT $ \s -> 329 fmap (shuffleS s) $ magnifyMaybe o (m s) 330 {-# INLINE magnify #-} 331 {-# INLINE magnifyMaybe #-} 332 333-- No instance for MagnifyMany (L.StateT s m) (L.StateT s n) b a 334 335instance 336 (Monoid w, Magnify m n b a 337 ) => Magnify (S.WriterT w m) (S.WriterT w n) b a where 338 magnify o = S.WriterT #. magnify o .# S.runWriterT 339 magnifyMaybe o = S.WriterT #. fmap shuffleW . magnifyMaybe o .# S.runWriterT 340 {-# INLINE magnify #-} 341 {-# INLINE magnifyMaybe #-} 342 343instance 344 (Monoid w, MagnifyMany m n b a 345 ) => MagnifyMany (S.WriterT w m) (S.WriterT w n) b a where 346 magnifyMany o = S.WriterT #. magnifyMany o .# S.runWriterT 347 {-# INLINE magnifyMany #-} 348 349instance 350 (Monoid w, Magnify m n b a 351 ) => Magnify (L.WriterT w m) (L.WriterT w n) b a where 352 magnify o = L.WriterT #. magnify o .# L.runWriterT 353 magnifyMaybe o = L.WriterT #. fmap shuffleW . magnifyMaybe o .# L.runWriterT 354 {-# INLINE magnify #-} 355 {-# INLINE magnifyMaybe #-} 356 357instance 358 (Monoid w, MagnifyMany m n b a 359 ) => MagnifyMany (L.WriterT w m) (L.WriterT w n) b a where 360 magnifyMany o = L.WriterT #. magnifyMany o .# L.runWriterT 361 {-# INLINE magnifyMany #-} 362 363instance Magnify m n b a => Magnify (ListT m) (ListT n) b a where 364 magnify o = ListT #. magnify o .# runListT 365 magnifyMaybe o = ListT #. fmap sequenceA . magnifyMaybe o .# runListT 366 {-# INLINE magnify #-} 367 {-# INLINE magnifyMaybe #-} 368 369instance MagnifyMany m n b a => MagnifyMany (ListT m) (ListT n) b a where 370 magnifyMany o = ListT #. magnifyMany o .# runListT 371 {-# INLINE magnifyMany #-} 372 373instance Magnify m n b a => Magnify (MaybeT m) (MaybeT n) b a where 374 magnify o = MaybeT #. magnify o .# runMaybeT 375 magnifyMaybe o = 376 MaybeT #. fmap (getMay . shuffleMay) . magnifyMaybe o . fmap May .# runMaybeT 377 {-# INLINE magnify #-} 378 {-# INLINE magnifyMaybe #-} 379 380instance MagnifyMany m n b a => MagnifyMany (MaybeT m) (MaybeT n) b a where 381 magnifyMany o = MaybeT #. fmap getMay . magnifyMany o . fmap May .# runMaybeT 382 {-# INLINE magnifyMany #-} 383 384instance (Error e, Magnify m n b a) => Magnify (ErrorT e m) (ErrorT e n) b a where 385 magnify o = ErrorT #. magnify o .# runErrorT 386 magnifyMaybe o = 387 ErrorT #. fmap (getErr . shuffleErr) . magnifyMaybe o . fmap Err .# runErrorT 388 {-# INLINE magnify #-} 389 {-# INLINE magnifyMaybe #-} 390 391instance 392 (Error e, MagnifyMany m n b a 393 ) => MagnifyMany (ErrorT e m) (ErrorT e n) b a where 394 magnifyMany o = ErrorT #. fmap getErr . magnifyMany o . fmap Err .# runErrorT 395 {-# INLINE magnifyMany #-} 396 397instance Magnify m n b a => Magnify (ExceptT e m) (ExceptT e n) b a where 398 magnify o = ExceptT #. magnify o .# runExceptT 399 magnifyMaybe o = 400 ExceptT #. fmap (getErr . shuffleErr) . magnifyMaybe o . fmap Err .# runExceptT 401 {-# INLINE magnify #-} 402 {-# INLINE magnifyMaybe #-} 403 404instance MagnifyMany m n b a => MagnifyMany (ExceptT e m) (ExceptT e n) b a where 405 magnifyMany o = ExceptT #. fmap getErr . magnifyMany o . fmap Err .# runExceptT 406 {-# INLINE magnifyMany #-} 407 408-- $setup 409-- >>> import Data.Monoid 410-- >>> import Optics.State 411-- >>> import Optics.State.Operators 412-- >>> import Optics.View 413