{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ConstraintKinds #-}
module RecordOperations (Mapped(..),
MapRecord,
MapField(..),
mapRecord,
RecordSubSet,
recordSubSet) where
import GHC.Records
import GHC.Generics
class MapField a where
type Mapped a :: *
mapField :: a -> Mapped a
class GenMapRecord f a b where
genMapRecord :: (forall c.c -> f c) -> a -> b
instance ( MapField (f b)
, HasField label a b
, d ~ Mapped (f b)) =>
GenMapRecord f a
(S1 ('MetaSel ('Just label) _x _x2 _x3) (Rec0 d) ())
where
genMapRecord :: (forall c. c -> f c)
-> a -> S1 ('MetaSel ('Just label) _x _x2 _x3) (Rec0 d) ()
genMapRecord forall c. c -> f c
f a
a = K1 R d () -> S1 ('MetaSel ('Just label) _x _x2 _x3) (Rec0 d) ()
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (K1 R d () -> S1 ('MetaSel ('Just label) _x _x2 _x3) (Rec0 d) ())
-> K1 R d () -> S1 ('MetaSel ('Just label) _x _x2 _x3) (Rec0 d) ()
forall a b. (a -> b) -> a -> b
$ d -> K1 R d ()
forall k i c (p :: k). c -> K1 i c p
K1 (d -> K1 R d ()) -> d -> K1 R d ()
forall a b. (a -> b) -> a -> b
$ f b -> Mapped (f b)
forall a. MapField a => a -> Mapped a
mapField (f b -> Mapped (f b)) -> f b -> Mapped (f b)
forall a b. (a -> b) -> a -> b
$ b -> f b
forall c. c -> f c
f ((a -> b
forall k (x :: k) r a. HasField x r a => r -> a
getField @label) a
a :: b)
instance ( GenMapRecord f a (b ())
, GenMapRecord f a (c ())) =>
GenMapRecord f a ((b :*: c) ())
where
genMapRecord :: (forall c. c -> f c) -> a -> (:*:) b c ()
genMapRecord forall c. c -> f c
f a
a = (forall c. c -> f c) -> a -> b ()
forall (f :: * -> *) a b.
GenMapRecord f a b =>
(forall c. c -> f c) -> a -> b
genMapRecord forall c. c -> f c
f a
a b () -> c () -> (:*:) b c ()
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: (forall c. c -> f c) -> a -> c ()
forall (f :: * -> *) a b.
GenMapRecord f a b =>
(forall c. c -> f c) -> a -> b
genMapRecord forall c. c -> f c
f a
a
instance ( GenMapRecord f a (b ())) =>
GenMapRecord f a (D1 meta (C1 meta2 b) ())
where
genMapRecord :: (forall c. c -> f c) -> a -> D1 meta (C1 meta2 b) ()
genMapRecord forall c. c -> f c
f a
a = M1 C meta2 b () -> D1 meta (C1 meta2 b) ()
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (M1 C meta2 b () -> D1 meta (C1 meta2 b) ())
-> M1 C meta2 b () -> D1 meta (C1 meta2 b) ()
forall a b. (a -> b) -> a -> b
$ b () -> M1 C meta2 b ()
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (b () -> M1 C meta2 b ()) -> b () -> M1 C meta2 b ()
forall a b. (a -> b) -> a -> b
$ (forall c. c -> f c) -> a -> b ()
forall (f :: * -> *) a b.
GenMapRecord f a b =>
(forall c. c -> f c) -> a -> b
genMapRecord forall c. c -> f c
f a
a
type MapRecord f a b = GenMapRecord f a (Rep b ())
mapRecord :: forall b f a.(Generic b, MapRecord f a b)
=> (forall c.c -> f c) -> a -> b
mapRecord :: (forall c. c -> f c) -> a -> b
mapRecord forall c. c -> f c
f a
x = Rep b () -> b
forall a x. Generic a => Rep a x -> a
to ((forall c. c -> f c) -> a -> Rep b ()
forall (f :: * -> *) a b.
GenMapRecord f a b =>
(forall c. c -> f c) -> a -> b
genMapRecord forall c. c -> f c
f a
x :: Rep b ())
class GenRecordSubSet a b where
genRecordSubSet :: a -> b
instance (HasField label a b) =>
GenRecordSubSet a
(S1 ('MetaSel ('Just label) _x _x2 _x3) (Rec0 b) ())
where
genRecordSubSet :: a -> S1 ('MetaSel ('Just label) _x _x2 _x3) (Rec0 b) ()
genRecordSubSet a
a = K1 R b () -> S1 ('MetaSel ('Just label) _x _x2 _x3) (Rec0 b) ()
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (K1 R b () -> S1 ('MetaSel ('Just label) _x _x2 _x3) (Rec0 b) ())
-> K1 R b () -> S1 ('MetaSel ('Just label) _x _x2 _x3) (Rec0 b) ()
forall a b. (a -> b) -> a -> b
$ b -> K1 R b ()
forall k i c (p :: k). c -> K1 i c p
K1 ((a -> b
forall k (x :: k) r a. HasField x r a => r -> a
getField @label) a
a :: b)
instance ( GenRecordSubSet a (b ())
, GenRecordSubSet a (c ())) =>
GenRecordSubSet a ((b :*: c) ())
where
genRecordSubSet :: a -> (:*:) b c ()
genRecordSubSet a
a = a -> b ()
forall a b. GenRecordSubSet a b => a -> b
genRecordSubSet a
a b () -> c () -> (:*:) b c ()
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: a -> c ()
forall a b. GenRecordSubSet a b => a -> b
genRecordSubSet a
a
instance (GenRecordSubSet a (b ())) =>
GenRecordSubSet a (D1 meta (C1 meta2 b) ())
where
genRecordSubSet :: a -> D1 meta (C1 meta2 b) ()
genRecordSubSet a
a = M1 C meta2 b () -> D1 meta (C1 meta2 b) ()
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (M1 C meta2 b () -> D1 meta (C1 meta2 b) ())
-> M1 C meta2 b () -> D1 meta (C1 meta2 b) ()
forall a b. (a -> b) -> a -> b
$ b () -> M1 C meta2 b ()
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (b () -> M1 C meta2 b ()) -> b () -> M1 C meta2 b ()
forall a b. (a -> b) -> a -> b
$ a -> b ()
forall a b. GenRecordSubSet a b => a -> b
genRecordSubSet a
a
type RecordSubSet a b = GenRecordSubSet a (Rep b ())
recordSubSet :: forall b a.(Generic b, RecordSubSet a b)
=> a -> b
recordSubSet :: a -> b
recordSubSet a
x = Rep b () -> b
forall a x. Generic a => Rep a x -> a
to (a -> Rep b ()
forall a b. GenRecordSubSet a b => a -> b
genRecordSubSet a
x :: Rep b ())