{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_HADDOCK hide #-}
module Data.Record.Anon.Plugin.Internal.Runtime (
Pair(..)
, Row
, RowHasField(..)
, DictRowHasField
, evidenceRowHasField
, KnownFields(..)
, DictKnownFields
, evidenceKnownFields
, fieldMetadata
, FieldTypes
, SimpleFieldTypes
, AllFields(..)
, DictAny(..)
, DictAllFields
, evidenceAllFields
, KnownHash(..)
, evidenceKnownHash
, Merge
, SubRow(..)
, DictSubRow
, evidenceSubRow
, noInlineUnsafeCo
) where
import Data.Kind
import Data.Primitive.SmallArray
import Data.Record.Generic hiding (FieldName)
import Data.SOP.Constraint (Compose)
import Data.Tagged
import GHC.Exts (Any)
import GHC.TypeLits
import Unsafe.Coerce (unsafeCoerce)
import Data.Record.Anon.Internal.Util.StrictArray (StrictArray)
import qualified Data.Record.Anon.Internal.Util.StrictArray as Strict
data Pair a b = a := b
type Row k = [Pair Symbol k]
class RowHasField (n :: Symbol) (r :: Row k) (a :: k) | n r -> a where
rowHasField :: DictRowHasField k n r a
rowHasField = DictRowHasField k n r a
forall a. HasCallStack => a
undefined
type DictRowHasField k (n :: Symbol) (r :: Row k) (a :: k) =
Tagged '(n, r, a) Int
evidenceRowHasField :: forall k n r a. Int -> DictRowHasField k n r a
evidenceRowHasField :: Int -> DictRowHasField k n r a
evidenceRowHasField = Int -> DictRowHasField k n r a
forall k (s :: k) b. b -> Tagged s b
Tagged
class KnownFields (r :: Row k) where
fieldNames :: DictKnownFields k r
fieldNames = DictKnownFields k r
forall a. HasCallStack => a
undefined
type DictKnownFields k (r :: Row k) = Tagged r [String]
evidenceKnownFields :: forall k r. [String] -> DictKnownFields k r
evidenceKnownFields :: [String] -> DictKnownFields k r
evidenceKnownFields = [String] -> DictKnownFields k r
forall k (s :: k) b. b -> Tagged s b
Tagged
type family FieldTypes (f :: k -> Type) (r :: Row k) :: [(Symbol, Type)]
type family SimpleFieldTypes (r :: Row Type) :: [(Symbol, Type)]
class AllFields (r :: Row k) (c :: k -> Constraint) where
fieldDicts :: DictAllFields k r c
fieldDicts = DictAllFields k r c
forall a. HasCallStack => a
undefined
type DictAllFields k (r :: Row k) (c :: k -> Constraint) =
Tagged r (SmallArray (DictAny c))
data DictAny c where
DictAny :: c Any => DictAny c
evidenceAllFields :: forall k r c. [DictAny c] -> DictAllFields k r c
evidenceAllFields :: [DictAny c] -> DictAllFields k r c
evidenceAllFields = SmallArray (DictAny c) -> DictAllFields k r c
forall k (s :: k) b. b -> Tagged s b
Tagged (SmallArray (DictAny c) -> DictAllFields k r c)
-> ([DictAny c] -> SmallArray (DictAny c))
-> [DictAny c]
-> DictAllFields k r c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [DictAny c] -> SmallArray (DictAny c)
forall a. [a] -> SmallArray a
smallArrayFromList
instance {-# OVERLAPPING #-}
(KnownFields r, Show a)
=> AllFields r (Compose Show (K a)) where
fieldDicts :: DictAllFields k r (Compose Show (K a))
fieldDicts = SmallArray (DictAny (Compose Show (K a)))
-> DictAllFields k r (Compose Show (K a))
forall k (s :: k) b. b -> Tagged s b
Tagged (SmallArray (DictAny (Compose Show (K a)))
-> DictAllFields k r (Compose Show (K a)))
-> SmallArray (DictAny (Compose Show (K a)))
-> DictAllFields k r (Compose Show (K a))
forall a b. (a -> b) -> a -> b
$
[DictAny (Compose Show (K a))]
-> SmallArray (DictAny (Compose Show (K a)))
forall a. [a] -> SmallArray a
smallArrayFromList ([DictAny (Compose Show (K a))]
-> SmallArray (DictAny (Compose Show (K a))))
-> [DictAny (Compose Show (K a))]
-> SmallArray (DictAny (Compose Show (K a)))
forall a b. (a -> b) -> a -> b
$ (String -> DictAny (Compose Show (K a)))
-> [String] -> [DictAny (Compose Show (K a))]
forall a b. (a -> b) -> [a] -> [b]
map (DictAny (Compose Show (K a))
-> String -> DictAny (Compose Show (K a))
forall a b. a -> b -> a
const DictAny (Compose Show (K a))
forall k (c :: k -> Constraint). c Any => DictAny c
DictAny) ([String] -> [DictAny (Compose Show (K a))])
-> [String] -> [DictAny (Compose Show (K a))]
forall a b. (a -> b) -> a -> b
$ Tagged r [String] -> Proxy r -> [String]
forall k (s :: k) a (proxy :: k -> *). Tagged s a -> proxy s -> a
proxy Tagged r [String]
forall k (r :: Row k). KnownFields r => DictKnownFields k r
fieldNames (Proxy r
forall k (t :: k). Proxy t
Proxy @r)
instance {-# OVERLAPPING #-}
(KnownFields r, Eq a)
=> AllFields r (Compose Eq (K a)) where
fieldDicts :: DictAllFields k r (Compose Eq (K a))
fieldDicts = SmallArray (DictAny (Compose Eq (K a)))
-> DictAllFields k r (Compose Eq (K a))
forall k (s :: k) b. b -> Tagged s b
Tagged (SmallArray (DictAny (Compose Eq (K a)))
-> DictAllFields k r (Compose Eq (K a)))
-> SmallArray (DictAny (Compose Eq (K a)))
-> DictAllFields k r (Compose Eq (K a))
forall a b. (a -> b) -> a -> b
$
[DictAny (Compose Eq (K a))]
-> SmallArray (DictAny (Compose Eq (K a)))
forall a. [a] -> SmallArray a
smallArrayFromList ([DictAny (Compose Eq (K a))]
-> SmallArray (DictAny (Compose Eq (K a))))
-> [DictAny (Compose Eq (K a))]
-> SmallArray (DictAny (Compose Eq (K a)))
forall a b. (a -> b) -> a -> b
$ (String -> DictAny (Compose Eq (K a)))
-> [String] -> [DictAny (Compose Eq (K a))]
forall a b. (a -> b) -> [a] -> [b]
map (DictAny (Compose Eq (K a)) -> String -> DictAny (Compose Eq (K a))
forall a b. a -> b -> a
const DictAny (Compose Eq (K a))
forall k (c :: k -> Constraint). c Any => DictAny c
DictAny) ([String] -> [DictAny (Compose Eq (K a))])
-> [String] -> [DictAny (Compose Eq (K a))]
forall a b. (a -> b) -> a -> b
$ Tagged r [String] -> Proxy r -> [String]
forall k (s :: k) a (proxy :: k -> *). Tagged s a -> proxy s -> a
proxy Tagged r [String]
forall k (r :: Row k). KnownFields r => DictKnownFields k r
fieldNames (Proxy r
forall k (t :: k). Proxy t
Proxy @r)
instance {-# OVERLAPPING #-}
(KnownFields r, Ord a)
=> AllFields r (Compose Ord (K a)) where
fieldDicts :: DictAllFields k r (Compose Ord (K a))
fieldDicts = SmallArray (DictAny (Compose Ord (K a)))
-> DictAllFields k r (Compose Ord (K a))
forall k (s :: k) b. b -> Tagged s b
Tagged (SmallArray (DictAny (Compose Ord (K a)))
-> DictAllFields k r (Compose Ord (K a)))
-> SmallArray (DictAny (Compose Ord (K a)))
-> DictAllFields k r (Compose Ord (K a))
forall a b. (a -> b) -> a -> b
$
[DictAny (Compose Ord (K a))]
-> SmallArray (DictAny (Compose Ord (K a)))
forall a. [a] -> SmallArray a
smallArrayFromList ([DictAny (Compose Ord (K a))]
-> SmallArray (DictAny (Compose Ord (K a))))
-> [DictAny (Compose Ord (K a))]
-> SmallArray (DictAny (Compose Ord (K a)))
forall a b. (a -> b) -> a -> b
$ (String -> DictAny (Compose Ord (K a)))
-> [String] -> [DictAny (Compose Ord (K a))]
forall a b. (a -> b) -> [a] -> [b]
map (DictAny (Compose Ord (K a))
-> String -> DictAny (Compose Ord (K a))
forall a b. a -> b -> a
const DictAny (Compose Ord (K a))
forall k (c :: k -> Constraint). c Any => DictAny c
DictAny) ([String] -> [DictAny (Compose Ord (K a))])
-> [String] -> [DictAny (Compose Ord (K a))]
forall a b. (a -> b) -> a -> b
$ Tagged r [String] -> Proxy r -> [String]
forall k (s :: k) a (proxy :: k -> *). Tagged s a -> proxy s -> a
proxy Tagged r [String]
forall k (r :: Row k). KnownFields r => DictKnownFields k r
fieldNames (Proxy r
forall k (t :: k). Proxy t
Proxy @r)
fieldMetadata :: forall k (r :: Row k) proxy.
KnownFields r
=> proxy r -> [FieldMetadata Any]
fieldMetadata :: proxy r -> [FieldMetadata Any]
fieldMetadata proxy r
_ = (String -> FieldMetadata Any) -> [String] -> [FieldMetadata Any]
forall a b. (a -> b) -> [a] -> [b]
map String -> FieldMetadata Any
aux ([String] -> [FieldMetadata Any])
-> [String] -> [FieldMetadata Any]
forall a b. (a -> b) -> a -> b
$ Tagged r [String] -> Proxy r -> [String]
forall k (s :: k) a (proxy :: k -> *). Tagged s a -> proxy s -> a
proxy Tagged r [String]
forall k (r :: Row k). KnownFields r => DictKnownFields k r
fieldNames (Proxy r
forall k (t :: k). Proxy t
Proxy @r)
where
aux :: String -> FieldMetadata Any
aux :: String -> FieldMetadata Any
aux String
name = case String -> SomeSymbol
someSymbolVal String
name of
SomeSymbol Proxy n
p -> Proxy n -> FieldStrictness -> FieldMetadata Any
forall (name :: Symbol) x.
KnownSymbol name =>
Proxy name -> FieldStrictness -> FieldMetadata x
FieldMetadata Proxy n
p FieldStrictness
FieldStrict
type family Merge :: Row k -> Row k -> Row k
class KnownHash (s :: Symbol) where
hashVal :: forall proxy. proxy s -> Int
type DictKnownHash (s :: Symbol) =
forall proxy. proxy s -> Int
evidenceKnownHash :: forall (s :: Symbol).
Int -> DictKnownHash s
evidenceKnownHash :: Int -> DictKnownHash s
evidenceKnownHash Int
x proxy s
_ = Int
x
class SubRow (r :: Row k) (r' :: Row k) where
projectIndices :: DictSubRow k r r'
projectIndices = DictSubRow k r r'
forall a. HasCallStack => a
undefined
type DictSubRow k (r :: Row k) (r' :: Row k) =
Tagged '(r, r') (StrictArray Int)
evidenceSubRow :: forall k r r'. [Int] -> DictSubRow k r r'
evidenceSubRow :: [Int] -> DictSubRow k r r'
evidenceSubRow = StrictArray Int -> DictSubRow k r r'
forall k (s :: k) b. b -> Tagged s b
Tagged (StrictArray Int -> DictSubRow k r r')
-> ([Int] -> StrictArray Int) -> [Int] -> DictSubRow k r r'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> StrictArray Int
forall a. [a] -> StrictArray a
Strict.fromList
noInlineUnsafeCo :: a -> b
{-# NOINLINE noInlineUnsafeCo #-}
noInlineUnsafeCo :: a -> b
noInlineUnsafeCo = a -> b
forall a b. a -> b
unsafeCoerce