src/Rel8/Schema/HTable/Identity.hs · rel8

on 22deaf2 help sign in

55 lines 1.4 kB history raw

1{-# language DataKinds #-}

2{-# language GADTs #-}

3{-# language PatternSynonyms #-}

4{-# language StandaloneKindSignatures #-}

5{-# language TypeFamilies #-}

7module Rel8.Schema.HTable.Identity

8 ( HIdentity( HIdentity, HType, unHIdentity )

9 , HType

10 )

11where

13-- base

14import Data.Kind ( Type )

15import Prelude

17-- rel8

18import Rel8.Schema.Dict ( Dict( Dict ) )

19import Rel8.Schema.HTable

20 ( HTable, HConstrainTable, HField

21 , hfield, htabulate, htraverse, hdicts, hspecs

22 )

23import qualified Rel8.Schema.Kind as K

24import Rel8.Schema.Spec ( Spec( Spec ), KnownSpec, specSing )

27type HType :: Type -> K.HTable

28type HType a = HIdentity ('Spec '[] a)

31pattern HType :: context ('Spec '[] a) -> HType a context

32pattern HType a = HIdentity a

33{-# COMPLETE HType #-}

36type HIdentity :: Spec -> K.HTable

37newtype HIdentity spec context = HIdentity

38 { unHIdentity :: context spec

39 }

42type HIdentityField :: Spec -> Spec -> Type

43data HIdentityField _spec spec where

44 HIdentityField :: HIdentityField spec spec

47instance KnownSpec spec => HTable (HIdentity spec) where

48 type HConstrainTable (HIdentity spec) c = c spec

49 type HField (HIdentity spec) = HIdentityField spec

51 hfield (HIdentity a) HIdentityField = a

52 htabulate f = HIdentity $ f HIdentityField

53 htraverse f (HIdentity a) = HIdentity <$> f a

54 hdicts = HIdentity Dict

55 hspecs = HIdentity specSing