{-# 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 = 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 :: forall k (n :: Symbol) (r :: Row k) (a :: k).
Int -> DictRowHasField k n r a
evidenceRowHasField = forall {k} (s :: k) b. b -> Tagged s b
Tagged
class KnownFields (r :: Row k) where
fieldNames :: DictKnownFields k r
fieldNames = forall a. HasCallStack => a
undefined
type DictKnownFields k (r :: Row k) = Tagged r [String]
evidenceKnownFields :: forall k r. [String] -> DictKnownFields k r
evidenceKnownFields :: forall k (r :: Row k). [String] -> DictKnownFields k r
evidenceKnownFields = 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 = 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 :: forall k (r :: Row k) (c :: k -> Constraint).
[DictAny c] -> DictAllFields k r c
evidenceAllFields = forall {k} (s :: k) b. b -> Tagged s b
Tagged forall b c a. (b -> c) -> (a -> b) -> a -> 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 = forall {k} (s :: k) b. b -> Tagged s b
Tagged forall a b. (a -> b) -> a -> b
$
forall a. [a] -> SmallArray a
smallArrayFromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a b. a -> b -> a
const forall {k} (c :: k -> Constraint). c Any => DictAny c
DictAny) forall a b. (a -> b) -> a -> b
$ forall {k} (s :: k) a (proxy :: k -> *). Tagged s a -> proxy s -> a
proxy forall k (r :: Row k). KnownFields r => DictKnownFields k r
fieldNames (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 = forall {k} (s :: k) b. b -> Tagged s b
Tagged forall a b. (a -> b) -> a -> b
$
forall a. [a] -> SmallArray a
smallArrayFromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a b. a -> b -> a
const forall {k} (c :: k -> Constraint). c Any => DictAny c
DictAny) forall a b. (a -> b) -> a -> b
$ forall {k} (s :: k) a (proxy :: k -> *). Tagged s a -> proxy s -> a
proxy forall k (r :: Row k). KnownFields r => DictKnownFields k r
fieldNames (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 = forall {k} (s :: k) b. b -> Tagged s b
Tagged forall a b. (a -> b) -> a -> b
$
forall a. [a] -> SmallArray a
smallArrayFromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a b. a -> b -> a
const forall {k} (c :: k -> Constraint). c Any => DictAny c
DictAny) forall a b. (a -> b) -> a -> b
$ forall {k} (s :: k) a (proxy :: k -> *). Tagged s a -> proxy s -> a
proxy forall k (r :: Row k). KnownFields r => DictKnownFields k r
fieldNames (forall {k} (t :: k). Proxy t
Proxy @r)
fieldMetadata :: forall k (r :: Row k) proxy.
KnownFields r
=> proxy r -> [FieldMetadata Any]
fieldMetadata :: forall k (r :: Row k) (proxy :: Row k -> *).
KnownFields r =>
proxy r -> [FieldMetadata Any]
fieldMetadata proxy r
_ = forall a b. (a -> b) -> [a] -> [b]
map String -> FieldMetadata Any
aux forall a b. (a -> b) -> a -> b
$ forall {k} (s :: k) a (proxy :: k -> *). Tagged s a -> proxy s -> a
proxy forall k (r :: Row k). KnownFields r => DictKnownFields k r
fieldNames (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 -> 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 :: forall (s :: Symbol). 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 = 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 :: forall k (r :: Row k) (r' :: Row k). [Int] -> DictSubRow k r r'
evidenceSubRow = forall {k} (s :: k) b. b -> Tagged s b
Tagged forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> StrictArray a
Strict.fromList
noInlineUnsafeCo :: a -> b
{-# NOINLINE noInlineUnsafeCo #-}
noInlineUnsafeCo :: forall a b. a -> b
noInlineUnsafeCo = forall a b. a -> b
unsafeCoerce