git.iko.soy/rel8
on cfe8a70 help sign in
rel8/src/Rel8/Type/Composite.hs
84 lines 2.5 kB history raw
1{-# language DataKinds #-}
2{-# language FlexibleContexts #-}
3{-# language GADTs #-}
4{-# language ScopedTypeVariables #-}
5{-# language StandaloneKindSignatures #-}
6{-# language TypeApplications #-}
7{-# language TypeOperators #-}
8{-# language UndecidableInstances #-}
10module Rel8.Type.Composite
11 ( Composite( Composite )
12 )
13where
15-- base
16import Control.Applicative ( liftA2 )
17import Data.Kind ( Constraint, Type )
18import Data.Proxy ( Proxy( Proxy ) )
19import GHC.Generics
20 ( Generic, Rep, from, to
21 , (:*:)( (:*:) ), K1( K1 ), M1( M1 )
22 )
23import GHC.TypeLits ( KnownSymbol, Symbol, symbolVal )
24import Prelude hiding ( null )
26-- hasql
27import qualified Hasql.Decoders as Hasql
29-- opaleye
30import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
32-- rel8
33import Rel8.Schema.Null ( Nullity( Null, NotNull ), Sql, nullable )
34import Rel8.Type ( DBType, typeInformation )
35import Rel8.Type.Information ( TypeInformation(..) )
38-- | A deriving-via helper type for column types that store a Haskell product
39-- type in a single Postgres column using a Postgres composite type.
40--
41-- Note that this must map to a specific extant type in your database's schema
42-- (created with @CREATE TYPE@). The @name@ parameter of @Composite@ should be
43-- the name of this type.
44type Composite :: Symbol -> Type -> Type
45newtype Composite name a = Composite
46 { unComposite :: a
47 }
50instance (KnownSymbol name, Generic a, GComposite (Rep a)) =>
51 DBType (Composite name a)
52 where
53 typeInformation = TypeInformation
54 { decode = Hasql.composite (Composite . to <$> gdecode @(Rep a))
55 , encode = Opaleye.FunExpr "ROW" . gencode @(Rep a) . from . unComposite
56 , typeName = symbolVal (Proxy @name)
57 }
60type GComposite :: (Type -> Type) -> Constraint
61class GComposite rep where
62 gdecode :: Hasql.Composite (rep x)
63 gencode :: rep x -> [Opaleye.PrimExpr]
66instance GComposite rep => GComposite (M1 i c rep) where
67 gdecode = M1 <$> gdecode
68 gencode (M1 a) = gencode a
71instance (GComposite a, GComposite b) => GComposite (a :*: b) where
72 gdecode = liftA2 (:*:) gdecode gdecode
73 gencode (a :*: b) = gencode a <> gencode b
76instance Sql DBType a => GComposite (K1 i a) where
77 gdecode = fmap K1 $ Hasql.field $ case nullable @a of
78 Null -> Hasql.nullable (decode typeInformation)
79 NotNull -> Hasql.nonNullable (decode typeInformation)
80 gencode (K1 a) = case nullable @a of
81 Null -> [maybe null (encode typeInformation) a]
82 NotNull -> [encode typeInformation a]
83 where
84 null = Opaleye.ConstExpr Opaleye.NullLit