module UHC.Util.Lens
( (:->)
, Lens
, (^*)
, (^.)
, (^=)
, (^$=)
, (=.)
, (=:)
, (=$:)
, getl
, focus
, mkLabel
, isoMb
, isoMbWithDefault
)
where
import Prelude hiding ((.), id)
import qualified Control.Monad.State as MS
import Control.Monad.Trans
import Control.Category
import Data.Label hiding (Lens)
import Data.Label.Monadic((=:), (=.))
import qualified Data.Label.Monadic as M
import qualified Data.Label.Partial as P
import UHC.Util.Utils
type Lens a b = a :-> b
infixl 9 ^*
(^*) :: (a :-> b) -> (b :-> c) -> (a :-> c)
f1 ^* f2 = f2 . f1
infixl 8 ^.
(^.) :: a -> (a :-> b) -> b
a ^. f = get f a
infixr 4 ^=
(^=) :: (a :-> b) -> b -> a -> a
(^=) = set
infixr 4 ^$=
(^$=) :: (a :-> b) -> (b -> b) -> a -> a
(^$=) = modify
infixr 4 =$:
(=$:) :: MS.MonadState f m => (f :-> o) -> (o -> o) -> m ()
(=$:) = M.modify
focus :: (MS.MonadState a m, MS.MonadState b m) => (a :-> b) -> m c -> m c
focus f m = do
a <- MS.get
(b,c) <- do {MS.put (get f a) ; c <- m ; b <- MS.get ; return (b,c)}
MS.put $ set f b a
return c
getl :: MS.MonadState f m => (f :-> o) -> m o
getl = M.gets
isoMbWithDefault :: o -> (f :-> Maybe o) -> (f :-> o)
isoMbWithDefault dflt f = iso (Iso (maybe dflt id) (Just)) . f
isoMb :: String -> (f :-> Maybe o) -> (f :-> o)
isoMb msg f = iso (Iso (panicJust msg) (Just)) . f