{-# 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 Control.DeepSeq (NFData(..))
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.NFData
import Data.Record.Generic.Show
import Data.Tagged
import GHC.Exts (Any)
import GHC.OverloadedLabels
import GHC.TypeLits
import TypeLet
import Data.Primitive.SmallArray
import qualified GHC.Records as Base
import qualified GHC.Records.Compat as RecordHasfield
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 (A.Record I r)
toAdvanced :: Record r -> A.Record I r
toAdvanced :: forall (r :: Row (*)). Record r -> Record I r
toAdvanced (SimpleRecord Record I r
r) = Record I r
r
fromAdvanced :: A.Record I r -> Record r
fromAdvanced :: forall (r :: Row (*)). Record I r -> Record r
fromAdvanced = forall (r :: Row (*)). Record I r -> Record r
SimpleRecord
sequenceA :: Applicative m => A.Record m r -> m (Record r)
sequenceA :: forall (m :: * -> *) (r :: Row (*)).
Applicative m =>
Record m r -> m (Record r)
sequenceA = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (r :: Row (*)). Record I r -> Record r
fromAdvanced forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) (r :: Row (*)).
Applicative m =>
Record m r -> m (Record I r)
A.sequenceA'
empty :: Record '[]
empty :: Record '[]
empty = forall (r :: Row (*)). Record I r -> Record r
fromAdvanced forall a b. (a -> b) -> a -> b
$ forall {k} (f :: k -> *). Record f '[]
A.empty
insert :: Field n -> a -> Record r -> Record (n := a : r)
insert :: forall (n :: Symbol) a (r :: Row (*)).
Field n -> a -> Record r -> Record ((n ':= a) : r)
insert Field n
n a
x = forall (r :: Row (*)). Record I r -> Record r
fromAdvanced forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 (forall a. a -> I a
I a
x) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall (m :: * -> *) (n :: Symbol) a (r :: Row (*)).
Applicative m =>
Field n -> m a -> m (Record r) -> m (Record ((n ':= a) : r))
insertA Field n
f m a
x m (Record r)
r = forall (n :: Symbol) a (r :: Row (*)).
Field n -> a -> Record r -> Record ((n ':= a) : r)
insert Field n
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
x 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 :: forall (r :: Row (*)) (r' :: Row (*)).
Record r -> Record r' -> Record (Merge r r')
merge Record r
r Record r'
r' = forall (r :: Row (*)). Record I r -> Record r
fromAdvanced forall a b. (a -> b) -> a -> b
$ forall {k} (f :: k -> *) (r :: Row k) (r' :: Row k).
Record f r -> Record f r' -> Record f (Merge r r')
A.merge (forall (r :: Row (*)). Record r -> Record I r
toAdvanced Record r
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 :: forall (r :: Row (*)) (r' :: Row (*)).
SubRow r r' =>
Record r -> (Record r', Record r' -> Record r)
lens =
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap forall (r :: Row (*)). Record I r -> Record r
fromAdvanced (\Record I r' -> Record I r
f -> forall (r :: Row (*)). Record I r -> Record r
fromAdvanced forall b c a. (b -> c) -> (a -> b) -> a -> c
. Record I r' -> Record I r
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: Row (*)). Record r -> Record I r
toAdvanced)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: Row (*)). Record r -> Record I r
toAdvanced
project :: SubRow r r' => Record r -> Record r'
project :: forall (r :: Row (*)) (r' :: Row (*)).
SubRow r r' =>
Record r -> Record r'
project = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall (r :: Row (*)) (r' :: Row (*)).
SubRow r r' =>
Record r' -> Record r -> Record r
inject Record r'
small = (forall a b. (a -> b) -> a -> b
$ Record r'
small) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: Row (*)) (r' :: Row (*)).
SubRow r r' =>
Record r -> (Record r', Record r' -> Record r)
lens
applyPending :: Record r -> Record r
applyPending :: forall (r :: Row (*)). Record r -> Record r
applyPending = forall (r :: Row (*)). Record I r -> Record r
fromAdvanced forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) (r :: Row k). Record f r -> Record f r
A.applyPending forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: Row (*)). Record r -> Record I r
toAdvanced
instance RecordHasfield.HasField n (A.Record I r) (I a)
=> RecordHasfield.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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (x :: k) r a. HasField x r a => r -> (a -> r, a)
RecordHasfield.hasField @n forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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) = (forall (r :: Row (*)). Record I r -> Record r
fromAdvanced forall b c a. (b -> c) -> (a -> b) -> a -> c
. I a -> Record I r
setX forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> I a
I, 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)
isoAdvanced 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 (x :: Symbol) a. IsLabel x a => a
fromLabel @n 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.% Iso' (I a) a
fromI
where
isoAdvanced :: Optics.Iso' (Record r) (A.Record I r)
isoAdvanced :: Iso' (Record r) (Record I r)
isoAdvanced = 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 :: Iso' (I a) a
fromI = 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 :: forall (n :: Symbol) (r :: Row (*)) a.
RowHasField n r a =>
Field n -> Record r -> a
get (Field Proxy n
_) = forall {k} (x :: k) r a. HasField x r a => r -> a
RecordHasfield.getField @n @(Record r)
set :: forall n r a. RowHasField n r a => Field n -> a -> Record r -> Record r
set :: forall (n :: Symbol) (r :: Row (*)) a.
RowHasField n r a =>
Field n -> a -> Record r -> Record r
set (Field Proxy n
_) = forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall {k} (x :: k) r a. HasField x r a => r -> a -> r
RecordHasfield.setField @n @(Record r))
instance RecordHasfield.HasField n (A.Record I r) (I a)
=> Base.HasField (n :: Symbol) ( Record r) a where
getField :: Record r -> a
getField = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (x :: k) r a. HasField x r a => r -> (a -> r, a)
RecordHasfield.hasField @n
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 :: forall (r :: Row (*)) (c :: * -> Constraint).
RecordConstraints r c =>
Proxy c -> Rep (Dict c) (Record r)
recordConstraints Proxy c
_ = forall (f :: * -> *) a. SmallArray (f Any) -> Rep f a
Rep forall a b. (a -> b) -> a -> b
$
DictAny c -> Dict c Any
aux forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k} (s :: k) a (proxy :: k -> *). Tagged s a -> proxy s -> a
proxy forall k (r :: Row k) (c :: k -> Constraint).
AllFields r c =>
DictAllFields k r c
fieldDicts (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 = 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 = forall (r :: Row (*)). Rep I (Record I r) -> Rep I (Record r)
fromAdvancedRep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Generic a => a -> Rep I a
from forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: Row (*)). Record r -> Record I r
toAdvanced
to :: Rep I (Record r) -> Record r
to = forall (r :: Row (*)). Record I r -> Record r
fromAdvanced forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Generic a => Rep I a -> a
to forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: Row (*)). Rep I (Record r) -> Rep I (Record I r)
toAdvancedRep
dict :: forall (c :: * -> Constraint).
Constraints (Record r) c =>
Proxy c -> Rep (Dict c) (Record r)
dict = forall (r :: Row (*)) (c :: * -> Constraint).
RecordConstraints r c =>
Proxy c -> Rep (Dict c) (Record r)
recordConstraints
metadata :: forall (proxy :: * -> *). proxy (Record r) -> Metadata (Record r)
metadata = forall a b. a -> b -> a
const forall (r :: Row (*)). KnownFields r => Metadata (Record r)
recordMetadata
fromAdvancedRep :: Rep I (A.Record I r) -> Rep I (Record r)
fromAdvancedRep :: forall (r :: Row (*)). Rep I (Record I r) -> Rep I (Record r)
fromAdvancedRep = forall a b. a -> b
noInlineUnsafeCo
toAdvancedRep :: Rep I (Record r) -> Rep I (A.Record I r)
toAdvancedRep :: forall (r :: Row (*)). Rep I (Record r) -> Rep I (Record I r)
toAdvancedRep = forall a b. a -> b
noInlineUnsafeCo
recordMetadata :: forall r. KnownFields r => Metadata (Record r)
recordMetadata :: forall (r :: Row (*)). KnownFields r => Metadata (Record r)
recordMetadata = Metadata {
recordName :: String
recordName = String
"Record"
, recordConstructor :: String
recordConstructor = String
"ANON"
, recordSize :: Int
recordSize = forall (t :: * -> *) a. Foldable t => t a -> Int
length [FieldMetadata Any]
fields
, recordFieldMetadata :: Rep FieldMetadata (Record r)
recordFieldMetadata = forall (f :: * -> *) a. SmallArray (f Any) -> Rep f a
Rep forall a b. (a -> b) -> a -> b
$ forall a. [a] -> SmallArray a
smallArrayFromList [FieldMetadata Any]
fields
}
where
fields :: [FieldMetadata Any]
fields :: [FieldMetadata Any]
fields = forall k (r :: Row k) (proxy :: Row k -> *).
KnownFields r =>
proxy r -> [FieldMetadata Any]
fieldMetadata (forall {k} (t :: k). Proxy t
Proxy @r)
instance RecordConstraints r Show => Show (Record r) where
showsPrec :: Int -> Record r -> ShowS
showsPrec = forall a. (Generic a, Constraints a Show) => Int -> a -> ShowS
gshowsPrec
instance RecordConstraints r Eq => Eq (Record r) where
== :: 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 = forall a. (Generic a, Constraints a Ord) => a -> a -> Ordering
gcompare
instance RecordConstraints r NFData => NFData (Record r) where
rnf :: Record r -> ()
rnf = forall a. (Generic a, Constraints a NFData) => a -> ()
grnf
instance RecordConstraints r ToJSON => ToJSON (Record r) where
toJSON :: Record r -> Value
toJSON = forall a. (Generic a, Constraints a ToJSON) => a -> Value
gtoJSON
instance RecordConstraints r FromJSON => FromJSON (Record r) where
parseJSON :: Value -> Parser (Record r)
parseJSON = 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 (*)).
(forall (r' :: Row (*)). Let r' r => Proxy r' -> Record r)
-> Record r
letRecordT forall (r' :: Row (*)). Let r' r => Proxy r' -> Record r
f = forall {k} r (a :: k).
Proxy a -> (forall (b :: k). Let b a => Proxy b -> r) -> r
letT' (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 :: forall (r :: Row (*)) (r' :: Row (*)) (n :: Symbol) a.
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 = forall {k} r (f :: k -> *) (a :: k).
f a -> (forall (b :: k). Let b a => f b -> r) -> r
letAs' (forall (n :: Symbol) a (r :: Row (*)).
Field n -> a -> Record r -> Record ((n ':= a) : r)
insert Field n
n a
x Record r'
r)