{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module Data.Record.Plugin.Runtime (
Constraint
, Proxy
, Type
, proxy
, AnyArray
, anyArrayFromList
, anyArrayToList
, anyArrayIndex
, anyArrayUpdate
, Rep
, Dict
, anyArrayToRep
, anyArrayFromRep
, mkDicts
, mkDict
, mkStrictField
, mkLazyField
, mkMetadata
, gcompare
, geq
, gshowsPrec
, noInlineUnsafeCo
, ThroughLRGenerics
, wrapThroughLRGenerics
, unwrapThroughLRGenerics
) where
import Control.Monad (forM_)
import Data.Coerce (coerce)
import Data.Primitive.SmallArray
import GHC.Exts (Any)
import GHC.TypeLits
import qualified Data.Foldable as Foldable
import qualified Data.Kind as Base
import qualified Data.Proxy as Base
import qualified Data.Record.Generic as LR
import qualified Data.Record.Generic.Eq as LR
import qualified Data.Record.Generic.GHC as LR
import qualified Data.Record.Generic.Rep.Internal as LR
import qualified Data.Record.Generic.Show as LR
type Constraint = Base.Constraint
type Proxy = Base.Proxy
type Type = Base.Type
proxy :: forall k (a :: k). Proxy a
proxy :: forall k (a :: k). Proxy a
proxy = forall k (a :: k). Proxy a
Base.Proxy
type AnyArray = SmallArray Any
anyArrayFromList :: [Any] -> AnyArray
anyArrayFromList :: [Any] -> AnyArray
anyArrayFromList = forall a. [a] -> SmallArray a
smallArrayFromList
anyArrayToList :: AnyArray -> [Any]
anyArrayToList :: AnyArray -> [Any]
anyArrayToList = forall (t :: Type -> Type) a. Foldable t => t a -> [a]
Foldable.toList
anyArrayIndex :: AnyArray -> Int -> Any
anyArrayIndex :: AnyArray -> Int -> Any
anyArrayIndex = forall a. SmallArray a -> Int -> a
indexSmallArray
anyArrayUpdate :: AnyArray -> [(Int, Any)] -> AnyArray
anyArrayUpdate :: AnyArray -> [(Int, Any)] -> AnyArray
anyArrayUpdate AnyArray
v [(Int, Any)]
updates = forall a. (forall s. ST s (SmallMutableArray s a)) -> SmallArray a
runSmallArray forall a b. (a -> b) -> a -> b
$ do
SmallMutableArray s Any
v' <- forall (m :: Type -> Type) a.
PrimMonad m =>
SmallArray a -> Int -> Int -> m (SmallMutableArray (PrimState m) a)
thawSmallArray AnyArray
v Int
0 (forall a. SmallArray a -> Int
sizeofSmallArray AnyArray
v)
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Int, Any)]
updates forall a b. (a -> b) -> a -> b
$ \(Int
i, Any
a) -> do
forall (m :: Type -> Type) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s Any
v' Int
i Any
a
forall (m :: Type -> Type) a. Monad m => a -> m a
return SmallMutableArray s Any
v'
anyArrayToRep :: AnyArray -> Rep LR.I a
anyArrayToRep :: forall a. AnyArray -> Rep I a
anyArrayToRep = coerce :: forall a b. Coercible a b => a -> b
coerce
anyArrayFromRep :: Rep LR.I a -> AnyArray
anyArrayFromRep :: forall a. Rep I a -> AnyArray
anyArrayFromRep = coerce :: forall a b. Coercible a b => a -> b
coerce
mkDicts :: [Dict c Any] -> Rep (Dict c) a
mkDicts :: forall (c :: Type -> Constraint) a. [Dict c Any] -> Rep (Dict c) a
mkDicts = forall (f :: Type -> Type) a. SmallArray (f Any) -> Rep f a
LR.Rep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> SmallArray a
smallArrayFromList
mkDict :: c x => Proxy c -> Proxy x -> Dict c x
mkDict :: forall {k} (c :: k -> Constraint) (x :: k).
c x =>
Proxy c -> Proxy x -> Dict c x
mkDict Proxy c
_ Proxy x
_ = forall {k} (c :: k -> Constraint) (a :: k). c a => Dict c a
LR.Dict
mkStrictField :: forall name a.
KnownSymbol name
=> Proxy name -> LR.FieldMetadata a
mkStrictField :: forall (name :: Symbol) a.
KnownSymbol name =>
Proxy name -> FieldMetadata a
mkStrictField Proxy name
_ = forall (name :: Symbol) x.
KnownSymbol name =>
Proxy name -> FieldStrictness -> FieldMetadata x
LR.FieldMetadata (forall k (a :: k). Proxy a
Base.Proxy @name) FieldStrictness
LR.FieldStrict
mkLazyField :: forall name a.
KnownSymbol name
=> Proxy name -> LR.FieldMetadata a
mkLazyField :: forall (name :: Symbol) a.
KnownSymbol name =>
Proxy name -> FieldMetadata a
mkLazyField Proxy name
_ = forall (name :: Symbol) x.
KnownSymbol name =>
Proxy name -> FieldStrictness -> FieldMetadata x
LR.FieldMetadata (forall k (a :: k). Proxy a
Base.Proxy @name) FieldStrictness
LR.FieldLazy
mkMetadata ::
String
-> String
-> [LR.FieldMetadata Any]
-> LR.Metadata a
mkMetadata :: forall a. String -> String -> [FieldMetadata Any] -> Metadata a
mkMetadata String
name String
constr [FieldMetadata Any]
fields = LR.Metadata {
recordName :: String
recordName = String
name
, recordConstructor :: String
recordConstructor = String
constr
, recordSize :: Int
recordSize = forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [FieldMetadata Any]
fields
, recordFieldMetadata :: Rep FieldMetadata a
recordFieldMetadata = forall (f :: Type -> Type) a. SmallArray (f Any) -> Rep f a
LR.Rep forall a b. (a -> b) -> a -> b
$ forall a. [a] -> SmallArray a
smallArrayFromList [FieldMetadata Any]
fields
}
type Rep = LR.Rep
type Dict = LR.Dict
gcompare :: (LR.Generic a, LR.Constraints a Ord) => a -> a -> Ordering
gcompare :: forall a. (Generic a, Constraints a Ord) => a -> a -> Ordering
gcompare = forall a. (Generic a, Constraints a Ord) => a -> a -> Ordering
LR.gcompare
geq :: (LR.Generic a, LR.Constraints a Eq) => a -> a -> Bool
geq :: forall a. (Generic a, Constraints a Eq) => a -> a -> Bool
geq = forall a. (Generic a, Constraints a Eq) => a -> a -> Bool
LR.geq
gshowsPrec :: (LR.Generic a, LR.Constraints a Show) => Int -> a -> ShowS
gshowsPrec :: forall a. (Generic a, Constraints a Show) => Int -> a -> ShowS
gshowsPrec = forall a. (Generic a, Constraints a Show) => Int -> a -> ShowS
LR.gshowsPrec
noInlineUnsafeCo :: a -> b
noInlineUnsafeCo :: forall a b. a -> b
noInlineUnsafeCo = forall a b. a -> b
LR.noInlineUnsafeCo
type ThroughLRGenerics = LR.ThroughLRGenerics
wrapThroughLRGenerics :: a -> ThroughLRGenerics a p
wrapThroughLRGenerics :: forall a p. a -> ThroughLRGenerics a p
wrapThroughLRGenerics = forall a p. a -> ThroughLRGenerics a p
LR.WrapThroughLRGenerics
unwrapThroughLRGenerics :: ThroughLRGenerics a p -> a
unwrapThroughLRGenerics :: forall a p. ThroughLRGenerics a p -> a
unwrapThroughLRGenerics = forall a p. ThroughLRGenerics a p -> a
LR.unwrapThroughLRGenerics