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

on 89ec060 help sign in

56 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.Kind.Necessity ( Necessity( Required ) )

19import Rel8.Schema.Dict ( Dict( Dict ) )

20import Rel8.Schema.HTable

21 ( HTable, HConstrainTable, HField

22 , hfield, htabulate, htraverse, hdicts, hspecs

23 )

24import qualified Rel8.Schema.Kind as K

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

28type HType :: Type -> K.HTable

29type HType a = HIdentity ('Spec '[] 'Required a)

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

33pattern HType a = HIdentity a

34{-# COMPLETE HType #-}

37type HIdentity :: Spec -> K.HTable

38newtype HIdentity spec context = HIdentity

39 { unHIdentity :: context spec

40 }

43type HIdentityField :: Spec -> Spec -> Type

44data HIdentityField _spec spec where

45 HIdentityField :: HIdentityField spec spec

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

49 type HConstrainTable (HIdentity spec) c = c spec

50 type HField (HIdentity spec) = HIdentityField spec

52 hfield (HIdentity a) HIdentityField = a

53 htabulate f = HIdentity $ f HIdentityField

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

55 hdicts = HIdentity Dict

56 hspecs = HIdentity specSing