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

on da76712 help sign in

43 lines 1.1 kB history raw

1{-# language DataKinds #-}

2{-# language FlexibleContexts #-}

3{-# language StandaloneKindSignatures #-}

4{-# language TypeFamilies #-}

5{-# language UndecidableInstances #-}

7module Rel8.Schema.HTable.Identity

8 ( HIdentity( HIdentity, unHIdentity )

9 )

10where

12-- base

13import Data.Kind ( Type )

14import Data.Type.Equality ( (:~:)( Refl ) )

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.Null ( Sql )

25import Rel8.Schema.Spec ( specification )

26import Rel8.Type ( DBType )

29type HIdentity :: Type -> K.HTable

30newtype HIdentity a context = HIdentity

31 { unHIdentity :: context a

32 }

35instance Sql DBType a => HTable (HIdentity a) where

36 type HConstrainTable (HIdentity a) constraint = constraint a

37 type HField (HIdentity a) = (:~:) a

39 hfield (HIdentity a) Refl = a

40 htabulate f = HIdentity $ f Refl

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

42 hdicts = HIdentity Dict

43 hspecs = HIdentity specification