git.iko.soy/rel8
on 11bcbbb help sign in
rel8/src/Rel8/Type.hs
323 lines 8.5 kB history raw
1{-# language FlexibleInstances #-}
2{-# language MultiParamTypeClasses #-}
3{-# language StandaloneKindSignatures #-}
4{-# language TypeApplications #-}
5{-# language UndecidableInstances #-}
6{-# language UndecidableInstances #-}
8module Rel8.Type
9 ( DBType (typeInformation)
10 )
11where
13-- aeson
14import Data.Aeson ( Value )
15import qualified Data.Aeson as Aeson
17-- base
18import Data.Int ( Int16, Int32, Int64 )
19import Data.List.NonEmpty ( NonEmpty )
20import Data.Kind ( Constraint, Type )
21import Prelude
23-- bytestring
24import Data.ByteString ( ByteString )
25import qualified Data.ByteString.Lazy as Lazy ( ByteString )
26import qualified Data.ByteString.Lazy as ByteString ( fromStrict, toStrict )
28-- case-insensitive
29import Data.CaseInsensitive ( CI )
30import qualified Data.CaseInsensitive as CI
32-- hasql
33import qualified Hasql.Decoders as Hasql
35-- opaleye
36import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
37import qualified Opaleye.Internal.HaskellDB.Sql.Default as Opaleye ( quote )
39-- rel8
40import Rel8.Opaque ( Opaque )
41import Rel8.Schema.Nullability
42 ( NotNull, Unnullify
43 , HasNullability, nullabilization
44 , Sql
45 )
46import Rel8.Type.Array ( listTypeInformation, nonEmptyTypeInformation )
47import Rel8.Type.Information ( TypeInformation(..), mapTypeInformation )
49-- scientific
50import Data.Scientific ( Scientific )
52-- text
53import Data.Text ( Text )
54import qualified Data.Text as Text
55import qualified Data.Text.Lazy as Lazy ( Text, unpack )
56import qualified Data.Text.Lazy as Text ( fromStrict, toStrict )
57import qualified Data.Text.Lazy.Encoding as Lazy ( decodeUtf8 )
59-- time
60import Data.Time.Calendar ( Day )
61import Data.Time.Clock ( DiffTime, NominalDiffTime, UTCTime )
62import Data.Time.LocalTime ( LocalTime, TimeOfDay )
63import Data.Time.Format ( formatTime, defaultTimeLocale )
65-- uuid
66import Data.UUID ( UUID )
67import qualified Data.UUID as UUID
70-- | Haskell types that can be represented as expressions in a database. There
71-- should be an instance of @DBType@ for all column types in your database
72-- schema (e.g., @int@, @timestamptz@, etc).
73--
74-- Rel8 comes with stock instances for most default types in PostgreSQL, so you
75-- should only need to derive instances of this class for custom database
76-- types, such as types defined in PostgreSQL extensions, or custom domain
77-- types.
78--
79-- [ Creating @DBType@s using @newtype@ ]
80--
81-- Generalized newtype deriving can be used when you want use a @newtype@
82-- around a database type for clarity and accuracy in your Haskell code. A
83-- common example is to @newtype@ row id types:
84--
85-- >>> newtype UserId = UserId { toInt32 :: Int32 } deriving newtype (DBType)
86--
87-- You can now write queries using @UserId@ instead of @Int32@, which may help
88-- avoid making bad joins. However, when SQL is generated, it will be as if you
89-- just used integers (the type distinction does not impact query generation).
90type DBType :: Type -> Constraint
91class NotNull a => DBType a where
92 typeInformation :: TypeInformation a
95-- | Corresponds to @bool@
96instance DBType Bool where
97 typeInformation = TypeInformation
98 { encode = Opaleye.ConstExpr . Opaleye.BoolLit
99 , decode = Hasql.bool
100 , typeName = "bool"
101 , out = id
102 }
105-- | Corresponds to @char@
106instance DBType Char where
107 typeInformation = TypeInformation
108 { encode = Opaleye.ConstExpr . Opaleye.StringLit . pure
109 , decode = Hasql.char
110 , typeName = "char"
111 , out = id
112 }
115-- | Corresponds to @int2@
116instance DBType Int16 where
117 typeInformation = TypeInformation
118 { encode = Opaleye.ConstExpr . Opaleye.IntegerLit . toInteger
119 , decode = Hasql.int2
120 , typeName = "int2"
121 , out = id
122 }
125-- | Corresponds to @int4@
126instance DBType Int32 where
127 typeInformation = TypeInformation
128 { encode = Opaleye.ConstExpr . Opaleye.IntegerLit . toInteger
129 , decode = Hasql.int4
130 , typeName = "int4"
131 , out = id
132 }
135-- | Corresponds to @int8@
136instance DBType Int64 where
137 typeInformation = TypeInformation
138 { encode = Opaleye.ConstExpr . Opaleye.IntegerLit . toInteger
139 , decode = Hasql.int8
140 , typeName = "int8"
141 , out = id
142 }
145-- | Corresponds to @float4@
146instance DBType Float where
147 typeInformation = TypeInformation
148 { encode = Opaleye.ConstExpr . Opaleye.NumericLit . realToFrac
149 , decode = Hasql.float4
150 , typeName = "float4"
151 , out = id
152 }
155-- | Corresponds to @float8@
156instance DBType Double where
157 typeInformation = TypeInformation
158 { encode = Opaleye.ConstExpr . Opaleye.NumericLit . realToFrac
159 , decode = Hasql.float8
160 , typeName = "float8"
161 , out = id
162 }
165-- | Corresponds to @numeric@
166instance DBType Scientific where
167 typeInformation = TypeInformation
168 { encode = Opaleye.ConstExpr . Opaleye.NumericLit
169 , decode = Hasql.numeric
170 , typeName = "numeric"
171 , out = id
172 }
175-- | Corresponds to @timestamptz@
176instance DBType UTCTime where
177 typeInformation = TypeInformation
178 { encode =
179 Opaleye.ConstExpr . Opaleye.OtherLit .
180 formatTime defaultTimeLocale "'%FT%T%QZ'"
181 , decode = Hasql.timestamptz
182 , typeName = "timestamptz"
183 , out = id
184 }
187-- | Corresponds to @date@
188instance DBType Day where
189 typeInformation = TypeInformation
190 { encode =
191 Opaleye.ConstExpr . Opaleye.OtherLit .
192 formatTime defaultTimeLocale "'%F'"
193 , decode = Hasql.date
194 , typeName = "date"
195 , out = id
196 }
199-- | Corresponds to @timestamp@
200instance DBType LocalTime where
201 typeInformation = TypeInformation
202 { encode =
203 Opaleye.ConstExpr . Opaleye.OtherLit .
204 formatTime defaultTimeLocale "'%FT%T%Q'"
205 , decode = Hasql.timestamp
206 , typeName = "timestamp"
207 , out = id
208 }
211-- | Corresponds to @time@
212instance DBType TimeOfDay where
213 typeInformation = TypeInformation
214 { encode =
215 Opaleye.ConstExpr . Opaleye.OtherLit .
216 formatTime defaultTimeLocale "'%T%Q'"
217 , decode = Hasql.time
218 , typeName = "time"
219 , out = id
220 }
223-- | Corresponds to @interval@
224instance DBType DiffTime where
225 typeInformation = TypeInformation
226 { encode =
227 Opaleye.ConstExpr . Opaleye.OtherLit .
228 formatTime defaultTimeLocale "'%-6Es'"
229 , decode = Hasql.interval
230 , typeName = "interval"
231 , out = id
232 }
235instance DBType NominalDiffTime where
236 typeInformation =
237 mapTypeInformation @DiffTime realToFrac realToFrac typeInformation
240-- | Corresponds to @text@
241instance DBType Text where
242 typeInformation = TypeInformation
243 { encode = Opaleye.ConstExpr . Opaleye.StringLit . Text.unpack
244 , decode = Hasql.text
245 , typeName = "text"
246 , out = id
247 }
250-- | Corresponds to @text@
251instance DBType Lazy.Text where
252 typeInformation =
253 mapTypeInformation Text.fromStrict Text.toStrict typeInformation
256-- | Corresponds to @citext@
257instance DBType (CI Text) where
258 typeInformation = mapTypeInformation CI.mk CI.original typeInformation
259 { typeName = "citext"
260 }
263-- | Corresponds to @citext@
264instance DBType (CI Lazy.Text) where
265 typeInformation = mapTypeInformation CI.mk CI.original typeInformation
266 { typeName = "citext"
267 }
270-- | Corresponds to @bytea@
271instance DBType ByteString where
272 typeInformation = TypeInformation
273 { encode = Opaleye.ConstExpr . Opaleye.ByteStringLit
274 , decode = Hasql.bytea
275 , typeName = "bytea"
276 , out = id
277 }
280-- | Corresponds to @bytea@
281instance DBType Lazy.ByteString where
282 typeInformation =
283 mapTypeInformation ByteString.fromStrict ByteString.toStrict
284 typeInformation
287-- | Corresponds to @uuid@
288instance DBType UUID where
289 typeInformation = TypeInformation
290 { encode = Opaleye.ConstExpr . Opaleye.StringLit . UUID.toString
291 , decode = Hasql.uuid
292 , typeName = "uuid"
293 , out = id
294 }
297-- | Corresponds to @jsonb@
298instance DBType Value where
299 typeInformation = TypeInformation
300 { encode =
301 Opaleye.ConstExpr . Opaleye.OtherLit .
302 Opaleye.quote .
303 Lazy.unpack . Lazy.decodeUtf8 . Aeson.encode
304 , decode = Hasql.jsonb
305 , typeName = "jsonb"
306 , out = id
307 }
310instance Sql DBType a => DBType [a] where
311 typeInformation = listTypeInformation nullabilization typeInformation
314instance Sql DBType a => DBType (NonEmpty a) where
315 typeInformation = nonEmptyTypeInformation nullabilization typeInformation
318instance {-# OVERLAPPING #-} DBType Opaque where
319 typeInformation = error "opaque"
322instance {-# INCOHERENT #-} (HasNullability a, DBType (Unnullify a)) =>
323 Sql DBType a