git.iko.soy/rel8
on fce7213 help sign in
rel8/src/Rel8/Type.hs
313 lines 8.3 kB history raw
1{-# language FlexibleInstances #-}
2{-# language StandaloneKindSignatures #-}
3{-# language TypeApplications #-}
4{-# language UndecidableInstances #-}
6module Rel8.Type
7 ( DBType (typeInformation)
8 )
9where
11-- aeson
12import Data.Aeson ( Value )
13import qualified Data.Aeson as Aeson
15-- base
16import Data.Int ( Int16, Int32, Int64 )
17import Data.List.NonEmpty ( NonEmpty )
18import Data.Kind ( Constraint, Type )
19import Prelude
21-- bytestring
22import Data.ByteString ( ByteString )
23import qualified Data.ByteString.Lazy as Lazy ( ByteString )
24import qualified Data.ByteString.Lazy as ByteString ( fromStrict, toStrict )
26-- case-insensitive
27import Data.CaseInsensitive ( CI )
28import qualified Data.CaseInsensitive as CI
30-- hasql
31import qualified Hasql.Decoders as Hasql
33-- opaleye
34import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
35import qualified Opaleye.Internal.HaskellDB.Sql.Default as Opaleye ( quote )
37-- rel8
38import Rel8.Opaque ( Opaque )
39import Rel8.Schema.Nullability ( Nullabilizes, nullabilization )
40import Rel8.Type.Array ( listTypeInformation, nonEmptyTypeInformation )
41import Rel8.Type.Information ( TypeInformation(..), mapTypeInformation )
43-- scientific
44import Data.Scientific ( Scientific )
46-- text
47import Data.Text ( Text )
48import qualified Data.Text as Text
49import qualified Data.Text.Lazy as Lazy ( Text, unpack )
50import qualified Data.Text.Lazy as Text ( fromStrict, toStrict )
51import qualified Data.Text.Lazy.Encoding as Lazy ( decodeUtf8 )
53-- time
54import Data.Time.Calendar ( Day )
55import Data.Time.Clock ( DiffTime, NominalDiffTime, UTCTime )
56import Data.Time.LocalTime ( LocalTime, TimeOfDay )
57import Data.Time.Format ( formatTime, defaultTimeLocale )
59-- uuid
60import Data.UUID ( UUID )
61import qualified Data.UUID as UUID
64-- | Haskell types that can be represented as expressions in a database. There
65-- should be an instance of @DBType@ for all column types in your database
66-- schema (e.g., @int@, @timestamptz@, etc).
67--
68-- Rel8 comes with stock instances for most default types in PostgreSQL, so you
69-- should only need to derive instances of this class for custom database
70-- types, such as types defined in PostgreSQL extensions, or custom domain
71-- types.
72--
73-- [ Creating @DBType@s using @newtype@ ]
74--
75-- Generalized newtype deriving can be used when you want use a @newtype@
76-- around a database type for clarity and accuracy in your Haskell code. A
77-- common example is to @newtype@ row id types:
78--
79-- >>> newtype UserId = UserId { toInt32 :: Int32 } deriving newtype (DBType)
80--
81-- You can now write queries using @UserId@ instead of @Int32@, which may help
82-- avoid making bad joins. However, when SQL is generated, it will be as if you
83-- just used integers (the type distinction does not impact query generation).
84type DBType :: Type -> Constraint
85class DBType a where
86 typeInformation :: TypeInformation a
89-- | Corresponds to @bool@
90instance DBType Bool where
91 typeInformation = TypeInformation
92 { encode = Opaleye.ConstExpr . Opaleye.BoolLit
93 , decode = Hasql.bool
94 , typeName = "bool"
95 , out = id
96 }
99-- | Corresponds to @char@
100instance DBType Char where
101 typeInformation = TypeInformation
102 { encode = Opaleye.ConstExpr . Opaleye.StringLit . pure
103 , decode = Hasql.char
104 , typeName = "char"
105 , out = id
106 }
109-- | Corresponds to @int2@
110instance DBType Int16 where
111 typeInformation = TypeInformation
112 { encode = Opaleye.ConstExpr . Opaleye.IntegerLit . toInteger
113 , decode = Hasql.int2
114 , typeName = "int2"
115 , out = id
116 }
119-- | Corresponds to @int4@
120instance DBType Int32 where
121 typeInformation = TypeInformation
122 { encode = Opaleye.ConstExpr . Opaleye.IntegerLit . toInteger
123 , decode = Hasql.int4
124 , typeName = "int4"
125 , out = id
126 }
129-- | Corresponds to @int8@
130instance DBType Int64 where
131 typeInformation = TypeInformation
132 { encode = Opaleye.ConstExpr . Opaleye.IntegerLit . toInteger
133 , decode = Hasql.int8
134 , typeName = "int8"
135 , out = id
136 }
139-- | Corresponds to @float4@
140instance DBType Float where
141 typeInformation = TypeInformation
142 { encode = Opaleye.ConstExpr . Opaleye.NumericLit . realToFrac
143 , decode = Hasql.float4
144 , typeName = "float4"
145 , out = id
146 }
149-- | Corresponds to @float8@
150instance DBType Double where
151 typeInformation = TypeInformation
152 { encode = Opaleye.ConstExpr . Opaleye.NumericLit . realToFrac
153 , decode = Hasql.float8
154 , typeName = "float8"
155 , out = id
156 }
159-- | Corresponds to @numeric@
160instance DBType Scientific where
161 typeInformation = TypeInformation
162 { encode = Opaleye.ConstExpr . Opaleye.NumericLit
163 , decode = Hasql.numeric
164 , typeName = "numeric"
165 , out = id
166 }
169-- | Corresponds to @timestamptz@
170instance DBType UTCTime where
171 typeInformation = TypeInformation
172 { encode =
173 Opaleye.ConstExpr . Opaleye.OtherLit .
174 formatTime defaultTimeLocale "'%FT%T%QZ'"
175 , decode = Hasql.timestamptz
176 , typeName = "timestamptz"
177 , out = id
178 }
181-- | Corresponds to @date@
182instance DBType Day where
183 typeInformation = TypeInformation
184 { encode =
185 Opaleye.ConstExpr . Opaleye.OtherLit .
186 formatTime defaultTimeLocale "'%F'"
187 , decode = Hasql.date
188 , typeName = "date"
189 , out = id
190 }
193-- | Corresponds to @timestamp@
194instance DBType LocalTime where
195 typeInformation = TypeInformation
196 { encode =
197 Opaleye.ConstExpr . Opaleye.OtherLit .
198 formatTime defaultTimeLocale "'%FT%T%Q'"
199 , decode = Hasql.timestamp
200 , typeName = "timestamp"
201 , out = id
202 }
205-- | Corresponds to @time@
206instance DBType TimeOfDay where
207 typeInformation = TypeInformation
208 { encode =
209 Opaleye.ConstExpr . Opaleye.OtherLit .
210 formatTime defaultTimeLocale "'%T%Q'"
211 , decode = Hasql.time
212 , typeName = "time"
213 , out = id
214 }
217-- | Corresponds to @interval@
218instance DBType DiffTime where
219 typeInformation = TypeInformation
220 { encode =
221 Opaleye.ConstExpr . Opaleye.OtherLit .
222 formatTime defaultTimeLocale "'%-6Es'"
223 , decode = Hasql.interval
224 , typeName = "interval"
225 , out = id
226 }
229instance DBType NominalDiffTime where
230 typeInformation =
231 mapTypeInformation @DiffTime realToFrac realToFrac typeInformation
234-- | Corresponds to @text@
235instance DBType Text where
236 typeInformation = TypeInformation
237 { encode = Opaleye.ConstExpr . Opaleye.StringLit . Text.unpack
238 , decode = Hasql.text
239 , typeName = "text"
240 , out = id
241 }
244-- | Corresponds to @text@
245instance DBType Lazy.Text where
246 typeInformation =
247 mapTypeInformation Text.fromStrict Text.toStrict typeInformation
250-- | Corresponds to @citext@
251instance DBType (CI Text) where
252 typeInformation = mapTypeInformation CI.mk CI.original typeInformation
253 { typeName = "citext"
254 }
257-- | Corresponds to @citext@
258instance DBType (CI Lazy.Text) where
259 typeInformation = mapTypeInformation CI.mk CI.original typeInformation
260 { typeName = "citext"
261 }
264-- | Corresponds to @bytea@
265instance DBType ByteString where
266 typeInformation = TypeInformation
267 { encode = Opaleye.ConstExpr . Opaleye.ByteStringLit
268 , decode = Hasql.bytea
269 , typeName = "bytea"
270 , out = id
271 }
274-- | Corresponds to @bytea@
275instance DBType Lazy.ByteString where
276 typeInformation =
277 mapTypeInformation ByteString.fromStrict ByteString.toStrict
278 typeInformation
281-- | Corresponds to @uuid@
282instance DBType UUID where
283 typeInformation = TypeInformation
284 { encode = Opaleye.ConstExpr . Opaleye.StringLit . UUID.toString
285 , decode = Hasql.uuid
286 , typeName = "uuid"
287 , out = id
288 }
291-- | Corresponds to @jsonb@
292instance DBType Value where
293 typeInformation = TypeInformation
294 { encode =
295 Opaleye.ConstExpr . Opaleye.OtherLit .
296 Opaleye.quote .
297 Lazy.unpack . Lazy.decodeUtf8 . Aeson.encode
298 , decode = Hasql.jsonb
299 , typeName = "jsonb"
300 , out = id
301 }
304instance (DBType db, Nullabilizes db a) => DBType [a] where
305 typeInformation = listTypeInformation nullabilization typeInformation
308instance (DBType db, Nullabilizes db a) => DBType (NonEmpty a) where
309 typeInformation = nonEmptyTypeInformation nullabilization typeInformation
312instance {-# OVERLAPPING #-} DBType Opaque where
313 typeInformation = error "opaque"