{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE QuantifiedConstraints #-}
module Data.Record.Generic.Lens.VL (
SimpleRecordLens(..)
, HKRecordLens(..)
, RegularRecordLens(..)
, lensesForSimpleRecord
, lensesForHKRecord
, lensesForRegularRecord
, RegularField(..)
, IsRegularField(..)
, RepLens(..)
, repLenses
, genericLens
, normalForm1Lens
, interpretedLens
, standardInterpretationLens
) where
import Data.Kind
import Data.Record.Generic
import Data.Record.Generic.Transform
import qualified Data.Record.Generic.Rep as Rep
type Lens' s a = forall f. Functor f => (a -> f a) -> s -> f s
data SimpleRecordLens a b where
SimpleRecordLens :: Lens' a b -> SimpleRecordLens a b
lensesForSimpleRecord :: forall a. Generic a => Rep (SimpleRecordLens a) a
lensesForSimpleRecord :: forall a. Generic a => Rep (SimpleRecordLens a) a
lensesForSimpleRecord =
forall a (f :: * -> *) (g :: * -> *).
Generic a =>
(forall x. f x -> g x) -> Rep f a -> Rep g a
Rep.map (\(RepLens Lens' (Rep I a) (I x)
l) -> forall a b. Lens' a b -> SimpleRecordLens a b
SimpleRecordLens forall a b. (a -> b) -> a -> b
$ \x -> f x
f -> forall x. Lens' (Rep I a) (I x) -> Lens' a x
aux Lens' (Rep I a) (I x)
l x -> f x
f) forall a (f :: * -> *). Generic a => Rep (RepLens f a) a
repLenses
where
aux :: Lens' (Rep I a) (I x) -> Lens' a x
aux :: forall x. Lens' (Rep I a) (I x) -> Lens' a x
aux Lens' (Rep I a) (I x)
l x -> f x
f a
a = forall a. Generic a => Rep I a -> a
to forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lens' (Rep I a) (I x)
l (\(I x
x) -> forall a. a -> I a
I forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> x -> f x
f x
x) (forall a. Generic a => a -> Rep I a
from a
a)
data HKRecordLens d (f :: Type -> Type) tbl x where
HKRecordLens :: Lens' (tbl f) (Interpret (d f) x) -> HKRecordLens d f tbl x
lensesForHKRecord :: forall d tbl f.
( Generic (tbl f)
, Generic (tbl Uninterpreted)
, HasNormalForm (d f) (tbl f) (tbl Uninterpreted)
)
=> Proxy d -> Rep (HKRecordLens d f tbl) (tbl Uninterpreted)
lensesForHKRecord :: forall (d :: (* -> *) -> *) (tbl :: (* -> *) -> *) (f :: * -> *).
(Generic (tbl f), Generic (tbl Uninterpreted),
HasNormalForm (d f) (tbl f) (tbl Uninterpreted)) =>
Proxy d -> Rep (HKRecordLens d f tbl) (tbl Uninterpreted)
lensesForHKRecord Proxy d
d = forall a (f :: * -> *) (g :: * -> *).
Generic a =>
(forall x. f x -> g x) -> Rep f a -> Rep g a
Rep.map forall x.
RepLens (Interpret (d f)) (tbl Uninterpreted) x
-> HKRecordLens d f tbl x
aux Rep
(RepLens (Interpret (d f)) (tbl Uninterpreted)) (tbl Uninterpreted)
fromRepLenses
where
fromRepLenses :: Rep (RepLens (Interpret (d f)) (tbl Uninterpreted)) (tbl Uninterpreted)
fromRepLenses :: Rep
(RepLens (Interpret (d f)) (tbl Uninterpreted)) (tbl Uninterpreted)
fromRepLenses = forall a (f :: * -> *). Generic a => Rep (RepLens f a) a
repLenses
aux :: forall x. RepLens (Interpret (d f)) (tbl Uninterpreted) x -> HKRecordLens d f tbl x
aux :: forall x.
RepLens (Interpret (d f)) (tbl Uninterpreted) x
-> HKRecordLens d f tbl x
aux (RepLens Lens'
(Rep (Interpret (d f)) (tbl Uninterpreted)) (Interpret (d f) x)
l) = forall (tbl :: (* -> *) -> *) (f :: * -> *) (d :: (* -> *) -> *) x.
Lens' (tbl f) (Interpret (d f) x) -> HKRecordLens d f tbl x
HKRecordLens forall a b. (a -> b) -> a -> b
$
forall a. Generic a => Lens' a (Rep I a)
genericLens
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (d :: (* -> *) -> *) (f :: * -> *) (x :: (* -> *) -> *).
HasNormalForm (d f) (x f) (x Uninterpreted) =>
Proxy d
-> Lens' (Rep I (x f)) (Rep (Interpret (d f)) (x Uninterpreted))
normalForm1Lens Proxy d
d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens'
(Rep (Interpret (d f)) (tbl Uninterpreted)) (Interpret (d f) x)
l
data RegularField f x where
RegularField :: RegularField f (f x)
class IsRegularField f x where
isRegularField :: Proxy (f x) -> RegularField f x
instance IsRegularField f (f x) where
isRegularField :: Proxy (f (f x)) -> RegularField f (f x)
isRegularField Proxy (f (f x))
_ = forall (f :: * -> *) x. RegularField f (f x)
RegularField
data RegularRecordLens tbl f x where
RegularRecordLens :: Lens' (tbl f) (f x) -> RegularRecordLens tbl f x
lensesForRegularRecord :: forall d tbl f.
( Generic (tbl (RegularRecordLens tbl f))
, Generic (tbl Uninterpreted)
, Generic (tbl f)
, HasNormalForm (d (RegularRecordLens tbl f)) (tbl (RegularRecordLens tbl f)) (tbl Uninterpreted)
, HasNormalForm (d f) (tbl f) (tbl Uninterpreted)
, Constraints (tbl Uninterpreted) (IsRegularField Uninterpreted)
, StandardInterpretation d (RegularRecordLens tbl f)
, StandardInterpretation d f
)
=> Proxy d -> tbl (RegularRecordLens tbl f)
lensesForRegularRecord :: forall (d :: (* -> *) -> *) (tbl :: (* -> *) -> *) (f :: * -> *).
(Generic (tbl (RegularRecordLens tbl f)),
Generic (tbl Uninterpreted), Generic (tbl f),
HasNormalForm
(d (RegularRecordLens tbl f))
(tbl (RegularRecordLens tbl f))
(tbl Uninterpreted),
HasNormalForm (d f) (tbl f) (tbl Uninterpreted),
Constraints (tbl Uninterpreted) (IsRegularField Uninterpreted),
StandardInterpretation d (RegularRecordLens tbl f),
StandardInterpretation d f) =>
Proxy d -> tbl (RegularRecordLens tbl f)
lensesForRegularRecord Proxy d
d = forall a. Generic a => Rep I a -> a
to forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} {dom} (d :: (k -> *) -> dom) (f :: k -> *)
(x :: (k -> *) -> *).
HasNormalForm (d f) (x f) (x Uninterpreted) =>
Proxy d -> Rep (Interpret (d f)) (x Uninterpreted) -> Rep I (x f)
denormalize1 Proxy d
d forall a b. (a -> b) -> a -> b
$
forall a (c :: * -> Constraint) (f :: * -> *) (g :: * -> *).
(Generic a, Constraints a c) =>
Proxy c -> (forall x. c x => f x -> g x) -> Rep f a -> Rep g a
Rep.cmap
(forall {k} (t :: k). Proxy t
Proxy @(IsRegularField Uninterpreted))
forall x.
IsRegularField Uninterpreted x =>
HKRecordLens d f tbl x -> Interpret (d (RegularRecordLens tbl f)) x
aux
(forall (d :: (* -> *) -> *) (tbl :: (* -> *) -> *) (f :: * -> *).
(Generic (tbl f), Generic (tbl Uninterpreted),
HasNormalForm (d f) (tbl f) (tbl Uninterpreted)) =>
Proxy d -> Rep (HKRecordLens d f tbl) (tbl Uninterpreted)
lensesForHKRecord Proxy d
d)
where
aux :: forall x.
IsRegularField Uninterpreted x
=> HKRecordLens d f tbl x
-> Interpret (d (RegularRecordLens tbl f)) x
aux :: forall x.
IsRegularField Uninterpreted x =>
HKRecordLens d f tbl x -> Interpret (d (RegularRecordLens tbl f)) x
aux (HKRecordLens Lens' (tbl f) (Interpret (d f) x)
l) =
case forall (f :: * -> *) x.
IsRegularField f x =>
Proxy (f x) -> RegularField f x
isRegularField (forall {k} (t :: k). Proxy t
Proxy @(Uninterpreted x)) of
RegularField Uninterpreted x
RegularField -> forall {k} {dom} (d :: (k -> *) -> dom) (f :: k -> *) (x :: k).
StandardInterpretation d f =>
Proxy d -> f x -> Interpret (d f) (Uninterpreted x)
toStandardInterpretation Proxy d
d forall a b. (a -> b) -> a -> b
$ forall (tbl :: (* -> *) -> *) (f :: * -> *) x.
Lens' (tbl f) (f x) -> RegularRecordLens tbl f x
RegularRecordLens forall a b. (a -> b) -> a -> b
$
Lens' (tbl f) (Interpret (d f) x)
l forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (d :: (* -> *) -> *) (f :: * -> *) x.
StandardInterpretation d f =>
Proxy d -> Lens' (Interpret (d f) (Uninterpreted x)) (f x)
standardInterpretationLens Proxy d
d
data RepLens f a x where
RepLens :: Lens' (Rep f a) (f x) -> RepLens f a x
repLenses :: Generic a => Rep (RepLens f a) a
repLenses :: forall a (f :: * -> *). Generic a => Rep (RepLens f a) a
repLenses = forall a (f :: * -> *) (g :: * -> *).
Generic a =>
(forall x. f x -> g x) -> Rep f a -> Rep g a
Rep.map forall a x (f :: * -> *). Index a x -> RepLens f a x
aux forall a. Generic a => Rep (Index a) a
Rep.allIndices
where
aux :: Rep.Index a x -> RepLens f a x
aux :: forall a x (f :: * -> *). Index a x -> RepLens f a x
aux Index a x
ix = forall (f :: * -> *) a x. Lens' (Rep f a) (f x) -> RepLens f a x
RepLens forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a x (f :: * -> *).
Functor m =>
Index a x -> (f x -> m (f x)) -> Rep f a -> m (Rep f a)
Rep.updateAtIndex Index a x
ix
genericLens :: Generic a => Lens' a (Rep I a)
genericLens :: forall a. Generic a => Lens' a (Rep I a)
genericLens Rep I a -> f (Rep I a)
f a
a = forall a. Generic a => Rep I a -> a
to forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Rep I a -> f (Rep I a)
f (forall a. Generic a => a -> Rep I a
from a
a)
normalForm1Lens ::
HasNormalForm (d f) (x f) (x Uninterpreted)
=> Proxy d
-> Lens' (Rep I (x f)) (Rep (Interpret (d f)) (x Uninterpreted))
normalForm1Lens :: forall (d :: (* -> *) -> *) (f :: * -> *) (x :: (* -> *) -> *).
HasNormalForm (d f) (x f) (x Uninterpreted) =>
Proxy d
-> Lens' (Rep I (x f)) (Rep (Interpret (d f)) (x Uninterpreted))
normalForm1Lens Proxy d
p Rep (Interpret (d f)) (x Uninterpreted)
-> f (Rep (Interpret (d f)) (x Uninterpreted))
f Rep I (x f)
a = forall {k} {dom} (d :: (k -> *) -> dom) (f :: k -> *)
(x :: (k -> *) -> *).
HasNormalForm (d f) (x f) (x Uninterpreted) =>
Proxy d -> Rep (Interpret (d f)) (x Uninterpreted) -> Rep I (x f)
denormalize1 Proxy d
p forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Rep (Interpret (d f)) (x Uninterpreted)
-> f (Rep (Interpret (d f)) (x Uninterpreted))
f (forall {k} {dom} (d :: (k -> *) -> dom) (f :: k -> *)
(x :: (k -> *) -> *).
HasNormalForm (d f) (x f) (x Uninterpreted) =>
Proxy d -> Rep I (x f) -> Rep (Interpret (d f)) (x Uninterpreted)
normalize1 Proxy d
p Rep I (x f)
a)
interpretedLens :: Lens' (Interpret d x) (Interpreted d x)
interpretedLens :: forall d x. Lens' (Interpret d x) (Interpreted d x)
interpretedLens Interpreted d x -> f (Interpreted d x)
f (Interpret Interpreted d x
x) = forall {dom} (d :: dom) x. Interpreted d x -> Interpret d x
Interpret forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Interpreted d x -> f (Interpreted d x)
f Interpreted d x
x
standardInterpretationLens :: forall d f x.
StandardInterpretation d f
=> Proxy d
-> Lens' (Interpret (d f) (Uninterpreted x)) (f x)
standardInterpretationLens :: forall (d :: (* -> *) -> *) (f :: * -> *) x.
StandardInterpretation d f =>
Proxy d -> Lens' (Interpret (d f) (Uninterpreted x)) (f x)
standardInterpretationLens Proxy d
p f x -> f (f x)
f Interpret (d f) (Uninterpreted x)
x =
forall {k} {dom} (d :: (k -> *) -> dom) (f :: k -> *) (x :: k).
StandardInterpretation d f =>
Proxy d -> f x -> Interpret (d f) (Uninterpreted x)
toStandardInterpretation Proxy d
p forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
f x -> f (f x)
f (forall {k} {dom} (d :: (k -> *) -> dom) (f :: k -> *) (x :: k).
StandardInterpretation d f =>
Proxy d -> Interpret (d f) (Uninterpreted x) -> f x
fromStandardInterpretation Proxy d
p Interpret (d f) (Uninterpreted x)
x)