{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
module Data.Record.Anon.Internal.Simple (
Record
, Field
, empty
, insert
, insertA
, get
, set
, merge
, lens
, project
, inject
, applyPending
, RecordConstraints
, toAdvanced
, fromAdvanced
, sequenceA
, letRecordT
, letInsertAs
) where
import Prelude hiding (sequenceA)
import Data.Aeson (ToJSON(..), FromJSON(..))
import Data.Bifunctor
import Data.Record.Generic
import Data.Record.Generic.Eq
import Data.Record.Generic.JSON
import Data.Record.Generic.Show
import Data.Tagged
import GHC.Exts
import GHC.OverloadedLabels
import GHC.Records.Compat
import GHC.TypeLits
import TypeLet
import Data.Primitive.SmallArray
import qualified Optics.Core as Optics
import Data.Record.Anon.Plugin.Internal.Runtime
import Data.Record.Anon.Internal.Advanced (Field(..))
import qualified Data.Record.Anon.Internal.Advanced as A
newtype Record r = SimpleRecord { Record r -> Record I r
toAdvanced :: A.Record I r }
fromAdvanced :: A.Record I r -> Record r
fromAdvanced :: Record I r -> Record r
fromAdvanced = Record I r -> Record r
forall (r :: Row *). Record I r -> Record r
SimpleRecord
sequenceA :: Applicative m => A.Record m r -> m (Record r)
sequenceA :: Record m r -> m (Record r)
sequenceA = (Record I r -> Record r) -> m (Record I r) -> m (Record r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Record I r -> Record r
forall (r :: Row *). Record I r -> Record r
fromAdvanced (m (Record I r) -> m (Record r))
-> (Record m r -> m (Record I r)) -> Record m r -> m (Record r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Record m r -> m (Record I r)
forall (m :: * -> *) (r :: Row *).
Applicative m =>
Record m r -> m (Record I r)
A.sequenceA'
empty :: Record '[]
empty :: Record '[]
empty = Record I '[] -> Record '[]
forall (r :: Row *). Record I r -> Record r
fromAdvanced (Record I '[] -> Record '[]) -> Record I '[] -> Record '[]
forall a b. (a -> b) -> a -> b
$ Record I '[]
forall k (f :: k -> *). Record f '[]
A.empty
insert :: Field n -> a -> Record r -> Record (n := a : r)
insert :: Field n -> a -> Record r -> Record ((n ':= a) : r)
insert Field n
n a
x = Record I ((n ':= a) : r) -> Record ((n ':= a) : r)
forall (r :: Row *). Record I r -> Record r
fromAdvanced (Record I ((n ':= a) : r) -> Record ((n ':= a) : r))
-> (Record r -> Record I ((n ':= a) : r))
-> Record r
-> Record ((n ':= a) : r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Field n -> I a -> Record I r -> Record I ((n ':= a) : r)
forall k (f :: k -> *) (r :: Row k) (a :: k) (n :: Symbol).
Field n -> f a -> Record f r -> Record f ((n ':= a) : r)
A.insert Field n
n (a -> I a
forall a. a -> I a
I a
x) (Record I r -> Record I ((n ':= a) : r))
-> (Record r -> Record I r) -> Record r -> Record I ((n ':= a) : r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Record r -> Record I r
forall (r :: Row *). Record r -> Record I r
toAdvanced
insertA ::
Applicative m
=> Field n -> m a -> m (Record r) -> m (Record (n := a : r))
insertA :: Field n -> m a -> m (Record r) -> m (Record ((n ':= a) : r))
insertA Field n
f m a
x m (Record r)
r = Field n -> a -> Record r -> Record ((n ':= a) : r)
forall (n :: Symbol) a (r :: Row *).
Field n -> a -> Record r -> Record ((n ':= a) : r)
insert Field n
f (a -> Record r -> Record ((n ':= a) : r))
-> m a -> m (Record r -> Record ((n ':= a) : r))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
x m (Record r -> Record ((n ':= a) : r))
-> m (Record r) -> m (Record ((n ':= a) : r))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m (Record r)
r
merge :: Record r -> Record r' -> Record (Merge r r')
merge :: Record r -> Record r' -> Record (Merge r r')
merge Record r
r Record r'
r' = Record I (Merge r r') -> Record (Merge r r')
forall (r :: Row *). Record I r -> Record r
fromAdvanced (Record I (Merge r r') -> Record (Merge r r'))
-> Record I (Merge r r') -> Record (Merge r r')
forall a b. (a -> b) -> a -> b
$ Record I r -> Record I r' -> Record I (Merge r r')
forall k (f :: k -> *) (r :: Row k) (r' :: Row k).
Record f r -> Record f r' -> Record f (Merge r r')
A.merge (Record r -> Record I r
forall (r :: Row *). Record r -> Record I r
toAdvanced Record r
r) (Record r' -> Record I r'
forall (r :: Row *). Record r -> Record I r
toAdvanced Record r'
r')
lens :: SubRow r r' => Record r -> (Record r', Record r' -> Record r)
lens :: Record r -> (Record r', Record r' -> Record r)
lens =
(Record I r' -> Record r')
-> ((Record I r' -> Record I r) -> Record r' -> Record r)
-> (Record I r', Record I r' -> Record I r)
-> (Record r', Record r' -> Record r)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Record I r' -> Record r'
forall (r :: Row *). Record I r -> Record r
fromAdvanced (\Record I r' -> Record I r
f -> Record I r -> Record r
forall (r :: Row *). Record I r -> Record r
fromAdvanced (Record I r -> Record r)
-> (Record r' -> Record I r) -> Record r' -> Record r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Record I r' -> Record I r
f (Record I r' -> Record I r)
-> (Record r' -> Record I r') -> Record r' -> Record I r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Record r' -> Record I r'
forall (r :: Row *). Record r -> Record I r
toAdvanced)
((Record I r', Record I r' -> Record I r)
-> (Record r', Record r' -> Record r))
-> (Record r -> (Record I r', Record I r' -> Record I r))
-> Record r
-> (Record r', Record r' -> Record r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Record I r -> (Record I r', Record I r' -> Record I r)
forall k (f :: k -> *) (r :: Row k) (r' :: Row k).
SubRow r r' =>
Record f r -> (Record f r', Record f r' -> Record f r)
A.lens
(Record I r -> (Record I r', Record I r' -> Record I r))
-> (Record r -> Record I r)
-> Record r
-> (Record I r', Record I r' -> Record I r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Record r -> Record I r
forall (r :: Row *). Record r -> Record I r
toAdvanced
project :: SubRow r r' => Record r -> Record r'
project :: Record r -> Record r'
project = (Record r', Record r' -> Record r) -> Record r'
forall a b. (a, b) -> a
fst ((Record r', Record r' -> Record r) -> Record r')
-> (Record r -> (Record r', Record r' -> Record r))
-> Record r
-> Record r'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Record r -> (Record r', Record r' -> Record r)
forall (r :: Row *) (r' :: Row *).
SubRow r r' =>
Record r -> (Record r', Record r' -> Record r)
lens
inject :: SubRow r r' => Record r' -> Record r -> Record r
inject :: Record r' -> Record r -> Record r
inject Record r'
small = ((Record r' -> Record r) -> Record r' -> Record r
forall a b. (a -> b) -> a -> b
$ Record r'
small) ((Record r' -> Record r) -> Record r)
-> (Record r -> Record r' -> Record r) -> Record r -> Record r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Record r', Record r' -> Record r) -> Record r' -> Record r
forall a b. (a, b) -> b
snd ((Record r', Record r' -> Record r) -> Record r' -> Record r)
-> (Record r -> (Record r', Record r' -> Record r))
-> Record r
-> Record r'
-> Record r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Record r -> (Record r', Record r' -> Record r)
forall (r :: Row *) (r' :: Row *).
SubRow r r' =>
Record r -> (Record r', Record r' -> Record r)
lens
applyPending :: Record r -> Record r
applyPending :: Record r -> Record r
applyPending = Record I r -> Record r
forall (r :: Row *). Record I r -> Record r
fromAdvanced (Record I r -> Record r)
-> (Record r -> Record I r) -> Record r -> Record r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Record I r -> Record I r
forall k (f :: k -> *) (r :: Row k). Record f r -> Record f r
A.applyPending (Record I r -> Record I r)
-> (Record r -> Record I r) -> Record r -> Record I r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Record r -> Record I r
forall (r :: Row *). Record r -> Record I r
toAdvanced
instance HasField n (A.Record I r) (I a)
=> HasField (n :: Symbol) ( Record r) a where
hasField :: Record r -> (a -> Record r, a)
hasField = (I a -> Record I r, I a) -> (a -> Record r, a)
aux ((I a -> Record I r, I a) -> (a -> Record r, a))
-> (Record r -> (I a -> Record I r, I a))
-> Record r
-> (a -> Record r, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (x :: k) r a. HasField x r a => r -> (a -> r, a)
forall r a. HasField n r a => r -> (a -> r, a)
hasField @n (Record I r -> (I a -> Record I r, I a))
-> (Record r -> Record I r) -> Record r -> (I a -> Record I r, I a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Record r -> Record I r
forall (r :: Row *). Record r -> Record I r
toAdvanced
where
aux :: (I a -> A.Record I r, I a) -> (a -> Record r, a)
aux :: (I a -> Record I r, I a) -> (a -> Record r, a)
aux (I a -> Record I r
setX, I a
x) = (Record I r -> Record r
forall (r :: Row *). Record I r -> Record r
fromAdvanced (Record I r -> Record r) -> (a -> Record I r) -> a -> Record r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. I a -> Record I r
setX (I a -> Record I r) -> (a -> I a) -> a -> Record I r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> I a
forall a. a -> I a
I, I a -> a
forall a. I a -> a
unI I a
x)
instance Optics.LabelOptic n Optics.A_Lens (A.Record I r) (A.Record I r) (I a) (I a)
=> Optics.LabelOptic n Optics.A_Lens ( Record r) ( Record r) a a where
labelOptic :: Optic A_Lens NoIx (Record r) (Record r) a a
labelOptic = Iso' (Record r) (Record I r)
toAdvanced Iso' (Record r) (Record I r)
-> Optic A_Lens NoIx (Record I r) (Record I r) (I a) (I a)
-> Optic A_Lens NoIx (Record r) (Record r) (I a) (I a)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
Optics.% forall a. IsLabel n a => a
forall (x :: Symbol) a. IsLabel x a => a
fromLabel @n Optic A_Lens NoIx (Record r) (Record r) (I a) (I a)
-> Optic An_Iso NoIx (I a) (I a) a a
-> Optic A_Lens NoIx (Record r) (Record r) a a
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
Optics.% Optic An_Iso NoIx (I a) (I a) a a
fromI
where
toAdvanced :: Optics.Iso' (Record r) (A.Record I r)
toAdvanced :: Iso' (Record r) (Record I r)
toAdvanced = Iso' (Record r) (Record I r)
forall s a t b. (Coercible s a, Coercible t b) => Iso s t a b
Optics.coerced
fromI :: Optics.Iso' (I a) a
fromI :: Optic An_Iso NoIx (I a) (I a) a a
fromI = Optic An_Iso NoIx (I a) (I a) a a
forall s a t b. (Coercible s a, Coercible t b) => Iso s t a b
Optics.coerced
get :: forall n r a. RowHasField n r a => Field n -> Record r -> a
get :: Field n -> Record r -> a
get (Field Proxy n
_) = forall a. HasField n (Record r) a => Record r -> a
forall k (x :: k) r a. HasField x r a => r -> a
getField @n @(Record r)
set :: forall n r a. RowHasField n r a => Field n -> a -> Record r -> Record r
set :: Field n -> a -> Record r -> Record r
set (Field Proxy n
_) = (Record r -> a -> Record r) -> a -> Record r -> Record r
forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a. HasField n (Record r) a => Record r -> a -> Record r
forall k (x :: k) r a. HasField x r a => r -> a -> r
setField @n @(Record r))
class (AllFields r c, KnownFields r) => RecordConstraints r c
instance (AllFields r c, KnownFields r) => RecordConstraints r c
recordConstraints :: forall r c.
RecordConstraints r c
=> Proxy c -> Rep (Dict c) (Record r)
recordConstraints :: Proxy c -> Rep (Dict c) (Record r)
recordConstraints Proxy c
_ = SmallArray (Dict c Any) -> Rep (Dict c) (Record r)
forall (f :: * -> *) a. SmallArray (f Any) -> Rep f a
Rep (SmallArray (Dict c Any) -> Rep (Dict c) (Record r))
-> SmallArray (Dict c Any) -> Rep (Dict c) (Record r)
forall a b. (a -> b) -> a -> b
$
DictAny c -> Dict c Any
aux (DictAny c -> Dict c Any)
-> SmallArray (DictAny c) -> SmallArray (Dict c Any)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tagged r (SmallArray (DictAny c))
-> Proxy r -> SmallArray (DictAny c)
forall k (s :: k) a (proxy :: k -> *). Tagged s a -> proxy s -> a
proxy Tagged r (SmallArray (DictAny c))
forall k (r :: Row k) (c :: k -> Constraint).
AllFields r c =>
DictAllFields k r c
fieldDicts (Proxy r
forall k (t :: k). Proxy t
Proxy @r)
where
aux :: DictAny c -> Dict c Any
aux :: DictAny c -> Dict c Any
aux DictAny c
DictAny = Dict c Any
forall k (c :: k -> Constraint) (a :: k). c a => Dict c a
Dict
instance KnownFields r => Generic (Record r) where
type Constraints (Record r) = RecordConstraints r
type MetadataOf (Record r) = SimpleFieldTypes r
from :: Record r -> Rep I (Record r)
from = Rep I (Record I r) -> Rep I (Record r)
forall (r :: Row *). Rep I (Record I r) -> Rep I (Record r)
fromAdvancedRep (Rep I (Record I r) -> Rep I (Record r))
-> (Record r -> Rep I (Record I r)) -> Record r -> Rep I (Record r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Record I r -> Rep I (Record I r)
forall a. Generic a => a -> Rep I a
from (Record I r -> Rep I (Record I r))
-> (Record r -> Record I r) -> Record r -> Rep I (Record I r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Record r -> Record I r
forall (r :: Row *). Record r -> Record I r
toAdvanced
to :: Rep I (Record r) -> Record r
to = Record I r -> Record r
forall (r :: Row *). Record I r -> Record r
fromAdvanced (Record I r -> Record r)
-> (Rep I (Record r) -> Record I r) -> Rep I (Record r) -> Record r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rep I (Record I r) -> Record I r
forall a. Generic a => Rep I a -> a
to (Rep I (Record I r) -> Record I r)
-> (Rep I (Record r) -> Rep I (Record I r))
-> Rep I (Record r)
-> Record I r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rep I (Record r) -> Rep I (Record I r)
forall (r :: Row *). Rep I (Record r) -> Rep I (Record I r)
toAdvancedRep
dict :: Proxy c -> Rep (Dict c) (Record r)
dict = Proxy c -> Rep (Dict c) (Record r)
forall (r :: Row *) (c :: * -> Constraint).
RecordConstraints r c =>
Proxy c -> Rep (Dict c) (Record r)
recordConstraints
metadata :: proxy (Record r) -> Metadata (Record r)
metadata = Metadata (Record r) -> proxy (Record r) -> Metadata (Record r)
forall a b. a -> b -> a
const Metadata (Record r)
forall (r :: Row *). KnownFields r => Metadata (Record r)
recordMetadata
fromAdvancedRep :: Rep I (A.Record I r) -> Rep I (Record r)
fromAdvancedRep :: Rep I (Record I r) -> Rep I (Record r)
fromAdvancedRep = Rep I (Record I r) -> Rep I (Record r)
forall a b. a -> b
noInlineUnsafeCo
toAdvancedRep :: Rep I (Record r) -> Rep I (A.Record I r)
toAdvancedRep :: Rep I (Record r) -> Rep I (Record I r)
toAdvancedRep = Rep I (Record r) -> Rep I (Record I r)
forall a b. a -> b
noInlineUnsafeCo
recordMetadata :: forall r. KnownFields r => Metadata (Record r)
recordMetadata :: Metadata (Record r)
recordMetadata = Metadata :: forall a.
String -> String -> Int -> Rep FieldMetadata a -> Metadata a
Metadata {
recordName :: String
recordName = String
"Record"
, recordConstructor :: String
recordConstructor = String
"Record"
, recordSize :: Int
recordSize = [FieldMetadata Any] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FieldMetadata Any]
fields
, recordFieldMetadata :: Rep FieldMetadata (Record r)
recordFieldMetadata = SmallArray (FieldMetadata Any) -> Rep FieldMetadata (Record r)
forall (f :: * -> *) a. SmallArray (f Any) -> Rep f a
Rep (SmallArray (FieldMetadata Any) -> Rep FieldMetadata (Record r))
-> SmallArray (FieldMetadata Any) -> Rep FieldMetadata (Record r)
forall a b. (a -> b) -> a -> b
$ [FieldMetadata Any] -> SmallArray (FieldMetadata Any)
forall a. [a] -> SmallArray a
smallArrayFromList [FieldMetadata Any]
fields
}
where
fields :: [FieldMetadata Any]
fields :: [FieldMetadata Any]
fields = Proxy r -> [FieldMetadata Any]
forall k (r :: Row k) (proxy :: Row k -> *).
KnownFields r =>
proxy r -> [FieldMetadata Any]
fieldMetadata (Proxy r
forall k (t :: k). Proxy t
Proxy @r)
instance RecordConstraints r Show => Show (Record r) where
showsPrec :: Int -> Record r -> ShowS
showsPrec = Int -> Record r -> ShowS
forall a. (Generic a, Constraints a Show) => Int -> a -> ShowS
gshowsPrec
instance RecordConstraints r Eq => Eq (Record r) where
== :: Record r -> Record r -> Bool
(==) = Record r -> Record r -> Bool
forall a. (Generic a, Constraints a Eq) => a -> a -> Bool
geq
instance ( RecordConstraints r Eq
, RecordConstraints r Ord
) => Ord (Record r) where
compare :: Record r -> Record r -> Ordering
compare = Record r -> Record r -> Ordering
forall a. (Generic a, Constraints a Ord) => a -> a -> Ordering
gcompare
instance RecordConstraints r ToJSON => ToJSON (Record r) where
toJSON :: Record r -> Value
toJSON = Record r -> Value
forall a. (Generic a, Constraints a ToJSON) => a -> Value
gtoJSON
instance RecordConstraints r FromJSON => FromJSON (Record r) where
parseJSON :: Value -> Parser (Record r)
parseJSON = Value -> Parser (Record r)
forall a. (Generic a, Constraints a FromJSON) => Value -> Parser a
gparseJSON
letRecordT :: forall r.
(forall r'. Let r' r => Proxy r' -> Record r)
-> Record r
letRecordT :: (forall (r' :: Row *). Let r' r => Proxy r' -> Record r)
-> Record r
letRecordT forall (r' :: Row *). Let r' r => Proxy r' -> Record r
f = Proxy r
-> (forall (r' :: Row *). Let r' r => Proxy r' -> Record r)
-> Record r
forall k r (a :: k).
Proxy a -> (forall (b :: k). Let b a => Proxy b -> r) -> r
letT' (Proxy r
forall k (t :: k). Proxy t
Proxy @r) forall (r' :: Row *). Let r' r => Proxy r' -> Record r
f
letInsertAs :: forall r r' n a.
Proxy r
-> Field n
-> a
-> Record r'
-> (forall r''. Let r'' (n := a : r') => Record r'' -> Record r)
-> Record r
letInsertAs :: Proxy r
-> Field n
-> a
-> Record r'
-> (forall (r'' :: Row *).
Let r'' ((n ':= a) : r') =>
Record r'' -> Record r)
-> Record r
letInsertAs Proxy r
_ Field n
n a
x Record r'
r = Record ((n ':= a) : r')
-> (forall (r'' :: Row *).
Let r'' ((n ':= a) : r') =>
Record r'' -> Record r)
-> Record r
forall k r (f :: k -> *) (a :: k).
f a -> (forall (b :: k). Let b a => f b -> r) -> r
letAs' (Field n -> a -> Record r' -> Record ((n ':= a) : r')
forall (n :: Symbol) a (r :: Row *).
Field n -> a -> Record r -> Record ((n ':= a) : r)
insert Field n
n a
x Record r'
r)