{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE TypeFamilies #-}
module Serokell.Util.Lens
( (%%=)
, (%?=)
, WrappedM (..)
, _UnwrappedM
, zoom'
, magnify'
, listL
) where
import Universum
import Control.Monad.Trans.Except (ExceptT, mapExceptT)
import GHC.Exts (IsList (..))
import System.Wlog (LoggerName, LoggerNameBox (..))
import qualified Control.Lens as L
infix 4 %%=
(%%=) :: L.Lens' s a -> State a b -> State s b
(%%=) l ma = do
attr <- L.view l <$> get
let (res,newAttr) = runState ma attr
l L..= newAttr
return res
infix 4 %?=
(%?=) :: L.Lens' s a -> ExceptT t (State a) b -> ExceptT t (State s) b
(%?=) l = mapExceptT (l %%=)
class Monad m => WrappedM m where
type UnwrappedM m :: * -> *
_WrappedM :: L.Iso' (m a) (UnwrappedM m a)
_WrappedM = L.iso packM unpackM
packM :: m a -> UnwrappedM m a
packM = L.view _WrappedM
unpackM :: UnwrappedM m a -> m a
unpackM = L.view _UnwrappedM
_UnwrappedM :: WrappedM m => L.Iso' (UnwrappedM m a) (m a)
_UnwrappedM = L.from _WrappedM
instance Monad m => WrappedM (LoggerNameBox m) where
type UnwrappedM (LoggerNameBox m) = ReaderT LoggerName m
_WrappedM = L.iso loggerNameBoxEntry LoggerNameBox
zoom'
:: MonadState s m
=> L.LensLike' (L.Zoomed (State s) a) s t
-> StateT t L.Identity a
-> m a
zoom' l = state . runState . L.zoom l
magnify'
:: MonadReader s m
=> L.LensLike' (L.Magnified (Reader s) a) s t
-> ReaderT t L.Identity a
-> m a
magnify' l = reader . runReader . L.magnify l
listL
:: (IsList (t a), IsList (t b))
=> L.Iso (t a) (t b) [Item (t a)] [Item (t b)]
listL = L.iso GHC.Exts.toList fromList