module Data.Schematic.Lens where
import Data.Proxy
import Data.Schematic.Schema
import Data.Vinyl
import Data.Vinyl.Functor
import Data.Vinyl.TypeLevel (Nat(..))
import GHC.TypeLits (Symbol)
type family FIndex (r :: Symbol) (rs :: [(Symbol, Schema)]) :: Nat where
FIndex r ( '(fn, s) ': rs) = 'Z
FIndex r ( s ': rs) = 'S (FIndex r rs)
class i ~ FIndex fn rs => FElem (fn :: Symbol) (rs :: [(Symbol, Schema)]) (i :: Nat) where
type ByRevision fn rs i :: Schema
flens
:: Functor g
=> proxy fn
-> (FieldRepr '(fn, (ByRevision fn rs i)) -> g (FieldRepr '(fn, (ByRevision fn rs i))))
-> Rec FieldRepr rs
-> g (Rec FieldRepr rs)
fget
:: proxy fn
-> Rec FieldRepr rs
-> FieldRepr '(fn, (ByRevision fn rs i))
fput
:: FieldRepr '(fn, ByRevision fn rs i)
-> Rec FieldRepr rs
-> Rec FieldRepr rs
instance FElem fn ('(fn, r) ': rs) 'Z where
type ByRevision fn ('(fn, r) ': rs) 'Z = r
flens _ f (x :& xs) = fmap (:& xs) (f x)
fget k = getConst . flens k Const
fput y = getIdentity . flens Proxy (\_ -> Identity y)
instance (FIndex r (s ': rs) ~ 'S i, FElem r rs i) => FElem r (s ': rs) ('S i) where
type ByRevision fn (s ': rs) ('S i) = ByRevision fn rs i
flens p f (x :& xs) = fmap (x :&) (flens p f xs)
fget k = getConst . flens k Const
fput y = getIdentity . flens Proxy (\_ -> Identity y)