module Data.Record.Label
(
Getter
, Setter
, Modifier
, (:->) (..)
, mkModifier
, mkLabel
, idL
, (%)
, Lens (..)
, (%%)
, getM, setM, modM, (=:)
, list
, maybeNull
, module Data.Record.Label.TH
) where
import Prelude hiding ((.), id)
import Control.Category
import Control.Monad.State
import Data.Record.Label.TH
type Getter a b = a -> b
type Setter a b = b -> a -> a
type Modifier a b = (b -> b) -> a -> a
data a :-> b = Label
{ lget :: Getter a b
, lset :: Setter a b
, lmod :: Modifier a b
}
mkModifier :: Getter a b -> Setter a b -> Modifier a b
mkModifier gg ss f a = ss (f (gg a)) a
mkLabel :: Getter a b -> Setter a b -> a :-> b
mkLabel g s = Label g s (mkModifier g s)
idL :: a :-> a
idL = mkLabel id const
infixr 8 %
(%) :: (g :-> a) -> (f :-> g) -> (f :-> a)
a % b = Label (lget a . lget b) (lmod b . lset a) (lmod b . lmod a)
instance Category (:->) where
id = idL
(.) = (%)
class Lens f where
lmap :: (a -> b, b -> a) -> f a -> f b
instance Lens ((:->) f) where
lmap (f, g) (Label a b c) = Label (f . a) (b . g) (c . (g.) . (.f))
infixr 8 %%
(%%) :: Functor f => a :-> b -> g :-> f a -> g :-> f b
(%%) a b = let (Label g s _) = a in (fmap g, fmap (\k -> s k (error "unused"))) `lmap` b
getM :: MonadState s m => s :-> b -> m b
getM = gets . lget
setM :: MonadState s m => s :-> b -> b -> m ()
setM l = modify . lset l
infixr 7 =:
(=:) :: MonadState s m => s :-> b -> b -> m ()
(=:) = setM
modM :: MonadState s m => s :-> b -> (b -> b) -> m ()
modM l = modify . lmod l
list :: Int -> [a] :-> a
list i = mkLabel (!! i) (\v a -> take i a ++ [v] ++ drop (i+1) a)
maybeNull :: [a] :-> Maybe [a]
maybeNull = (\x -> if null x then Nothing else Just x, maybe [] id) `lmap` id