git.iko.soy/rel8
on 28aaa76 help sign in
rel8/src/Rel8/Type.hs
322 lines 8.4 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 ( UTCTime )
62import Data.Time.LocalTime
63 ( CalendarDiffTime( CalendarDiffTime )
64 , LocalTime
65 , TimeOfDay
66 )
67import Data.Time.Format ( formatTime, defaultTimeLocale )
69-- uuid
70import Data.UUID ( UUID )
71import qualified Data.UUID as UUID
74-- | Haskell types that can be represented as expressions in a database. There
75-- should be an instance of @DBType@ for all column types in your database
76-- schema (e.g., @int@, @timestamptz@, etc).
77--
78-- Rel8 comes with stock instances for most default types in PostgreSQL, so you
79-- should only need to derive instances of this class for custom database
80-- types, such as types defined in PostgreSQL extensions, or custom domain
81-- types.
82--
83-- [ Creating @DBType@s using @newtype@ ]
84--
85-- Generalized newtype deriving can be used when you want use a @newtype@
86-- around a database type for clarity and accuracy in your Haskell code. A
87-- common example is to @newtype@ row id types:
88--
89-- >>> newtype UserId = UserId { toInt32 :: Int32 } deriving newtype (DBType)
90--
91-- You can now write queries using @UserId@ instead of @Int32@, which may help
92-- avoid making bad joins. However, when SQL is generated, it will be as if you
93-- just used integers (the type distinction does not impact query generation).
94type DBType :: Type -> Constraint
95class NotNull a => DBType a where
96 typeInformation :: TypeInformation a
99-- | Corresponds to @bool@
100instance DBType Bool where
101 typeInformation = TypeInformation
102 { encode = Opaleye.ConstExpr . Opaleye.BoolLit
103 , decode = Hasql.bool
104 , typeName = "bool"
105 , out = id
106 }
109-- | Corresponds to @char@
110instance DBType Char where
111 typeInformation = TypeInformation
112 { encode = Opaleye.ConstExpr . Opaleye.StringLit . pure
113 , decode = Hasql.char
114 , typeName = "char"
115 , out = id
116 }
119-- | Corresponds to @int2@
120instance DBType Int16 where
121 typeInformation = TypeInformation
122 { encode = Opaleye.ConstExpr . Opaleye.IntegerLit . toInteger
123 , decode = Hasql.int2
124 , typeName = "int2"
125 , out = id
126 }
129-- | Corresponds to @int4@
130instance DBType Int32 where
131 typeInformation = TypeInformation
132 { encode = Opaleye.ConstExpr . Opaleye.IntegerLit . toInteger
133 , decode = Hasql.int4
134 , typeName = "int4"
135 , out = id
136 }
139-- | Corresponds to @int8@
140instance DBType Int64 where
141 typeInformation = TypeInformation
142 { encode = Opaleye.ConstExpr . Opaleye.IntegerLit . toInteger
143 , decode = Hasql.int8
144 , typeName = "int8"
145 , out = id
146 }
149-- | Corresponds to @float4@
150instance DBType Float where
151 typeInformation = TypeInformation
152 { encode = Opaleye.ConstExpr . Opaleye.NumericLit . realToFrac
153 , decode = Hasql.float4
154 , typeName = "float4"
155 , out = id
156 }
159-- | Corresponds to @float8@
160instance DBType Double where
161 typeInformation = TypeInformation
162 { encode = Opaleye.ConstExpr . Opaleye.NumericLit . realToFrac
163 , decode = Hasql.float8
164 , typeName = "float8"
165 , out = id
166 }
169-- | Corresponds to @numeric@
170instance DBType Scientific where
171 typeInformation = TypeInformation
172 { encode = Opaleye.ConstExpr . Opaleye.NumericLit
173 , decode = Hasql.numeric
174 , typeName = "numeric"
175 , out = id
176 }
179-- | Corresponds to @timestamptz@
180instance DBType UTCTime where
181 typeInformation = TypeInformation
182 { encode =
183 Opaleye.ConstExpr . Opaleye.OtherLit .
184 formatTime defaultTimeLocale "'%FT%T%QZ'"
185 , decode = Hasql.timestamptz
186 , typeName = "timestamptz"
187 , out = id
188 }
191-- | Corresponds to @date@
192instance DBType Day where
193 typeInformation = TypeInformation
194 { encode =
195 Opaleye.ConstExpr . Opaleye.OtherLit .
196 formatTime defaultTimeLocale "'%F'"
197 , decode = Hasql.date
198 , typeName = "date"
199 , out = id
200 }
203-- | Corresponds to @timestamp@
204instance DBType LocalTime where
205 typeInformation = TypeInformation
206 { encode =
207 Opaleye.ConstExpr . Opaleye.OtherLit .
208 formatTime defaultTimeLocale "'%FT%T%Q'"
209 , decode = Hasql.timestamp
210 , typeName = "timestamp"
211 , out = id
212 }
215-- | Corresponds to @time@
216instance DBType TimeOfDay where
217 typeInformation = TypeInformation
218 { encode =
219 Opaleye.ConstExpr . Opaleye.OtherLit .
220 formatTime defaultTimeLocale "'%T%Q'"
221 , decode = Hasql.time
222 , typeName = "time"
223 , out = id
224 }
227-- | Corresponds to @interval@
228instance DBType CalendarDiffTime where
229 typeInformation = TypeInformation
230 { encode =
231 Opaleye.ConstExpr . Opaleye.OtherLit .
232 formatTime defaultTimeLocale "'%bmon %0Es'"
233 , decode = CalendarDiffTime 0 . realToFrac <$> Hasql.interval
234 , typeName = "interval"
235 , out = id
236 }
239-- | Corresponds to @text@
240instance DBType Text where
241 typeInformation = TypeInformation
242 { encode = Opaleye.ConstExpr . Opaleye.StringLit . Text.unpack
243 , decode = Hasql.text
244 , typeName = "text"
245 , out = id
246 }
249-- | Corresponds to @text@
250instance DBType Lazy.Text where
251 typeInformation =
252 mapTypeInformation Text.fromStrict Text.toStrict typeInformation
255-- | Corresponds to @citext@
256instance DBType (CI Text) where
257 typeInformation = mapTypeInformation CI.mk CI.original typeInformation
258 { typeName = "citext"
259 }
262-- | Corresponds to @citext@
263instance DBType (CI Lazy.Text) where
264 typeInformation = mapTypeInformation CI.mk CI.original typeInformation
265 { typeName = "citext"
266 }
269-- | Corresponds to @bytea@
270instance DBType ByteString where
271 typeInformation = TypeInformation
272 { encode = Opaleye.ConstExpr . Opaleye.ByteStringLit
273 , decode = Hasql.bytea
274 , typeName = "bytea"
275 , out = id
276 }
279-- | Corresponds to @bytea@
280instance DBType Lazy.ByteString where
281 typeInformation =
282 mapTypeInformation ByteString.fromStrict ByteString.toStrict
283 typeInformation
286-- | Corresponds to @uuid@
287instance DBType UUID where
288 typeInformation = TypeInformation
289 { encode = Opaleye.ConstExpr . Opaleye.StringLit . UUID.toString
290 , decode = Hasql.uuid
291 , typeName = "uuid"
292 , out = id
293 }
296-- | Corresponds to @jsonb@
297instance DBType Value where
298 typeInformation = TypeInformation
299 { encode =
300 Opaleye.ConstExpr . Opaleye.OtherLit .
301 Opaleye.quote .
302 Lazy.unpack . Lazy.decodeUtf8 . Aeson.encode
303 , decode = Hasql.jsonb
304 , typeName = "jsonb"
305 , out = id
306 }
309instance Sql DBType a => DBType [a] where
310 typeInformation = listTypeInformation nullabilization typeInformation
313instance Sql DBType a => DBType (NonEmpty a) where
314 typeInformation = nonEmptyTypeInformation nullabilization typeInformation
317instance {-# OVERLAPPING #-} DBType Opaque where
318 typeInformation = error "opaque"
321instance {-# INCOHERENT #-} (HasNullability a, DBType (Unnullify a)) =>
322 Sql DBType a