git.iko.soy/rel8
on 0857ffb help sign in
rel8/src/Rel8/Type.hs
305 lines 8.2 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 }
108-- | Corresponds to @char@
109instance DBType Char where
110 typeInformation = TypeInformation
111 { encode = Opaleye.ConstExpr . Opaleye.StringLit . pure
112 , decode = Hasql.char
113 , typeName = "char"
114 }
117-- | Corresponds to @int2@
118instance DBType Int16 where
119 typeInformation = TypeInformation
120 { encode = Opaleye.ConstExpr . Opaleye.IntegerLit . toInteger
121 , decode = Hasql.int2
122 , typeName = "int2"
123 }
126-- | Corresponds to @int4@
127instance DBType Int32 where
128 typeInformation = TypeInformation
129 { encode = Opaleye.ConstExpr . Opaleye.IntegerLit . toInteger
130 , decode = Hasql.int4
131 , typeName = "int4"
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 }
144-- | Corresponds to @float4@
145instance DBType Float where
146 typeInformation = TypeInformation
147 { encode = Opaleye.ConstExpr . Opaleye.NumericLit . realToFrac
148 , decode = Hasql.float4
149 , typeName = "float4"
150 }
153-- | Corresponds to @float8@
154instance DBType Double where
155 typeInformation = TypeInformation
156 { encode = Opaleye.ConstExpr . Opaleye.NumericLit . realToFrac
157 , decode = Hasql.float8
158 , typeName = "float8"
159 }
162-- | Corresponds to @numeric@
163instance DBType Scientific where
164 typeInformation = TypeInformation
165 { encode = Opaleye.ConstExpr . Opaleye.NumericLit
166 , decode = Hasql.numeric
167 , typeName = "numeric"
168 }
171-- | Corresponds to @timestamptz@
172instance DBType UTCTime where
173 typeInformation = TypeInformation
174 { encode =
175 Opaleye.ConstExpr . Opaleye.OtherLit .
176 formatTime defaultTimeLocale "'%FT%T%QZ'"
177 , decode = Hasql.timestamptz
178 , typeName = "timestamptz"
179 }
182-- | Corresponds to @date@
183instance DBType Day where
184 typeInformation = TypeInformation
185 { encode =
186 Opaleye.ConstExpr . Opaleye.OtherLit .
187 formatTime defaultTimeLocale "'%F'"
188 , decode = Hasql.date
189 , typeName = "date"
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 }
204-- | Corresponds to @time@
205instance DBType TimeOfDay where
206 typeInformation = TypeInformation
207 { encode =
208 Opaleye.ConstExpr . Opaleye.OtherLit .
209 formatTime defaultTimeLocale "'%T%Q'"
210 , decode = Hasql.time
211 , typeName = "time"
212 }
215-- | Corresponds to @interval@
216instance DBType CalendarDiffTime where
217 typeInformation = TypeInformation
218 { encode =
219 Opaleye.ConstExpr . Opaleye.OtherLit .
220 formatTime defaultTimeLocale "'%bmon %0Es'"
221 , decode = CalendarDiffTime 0 . realToFrac <$> Hasql.interval
222 , typeName = "interval"
223 }
226-- | Corresponds to @text@
227instance DBType Text where
228 typeInformation = TypeInformation
229 { encode = Opaleye.ConstExpr . Opaleye.StringLit . Text.unpack
230 , decode = Hasql.text
231 , typeName = "text"
232 }
235-- | Corresponds to @text@
236instance DBType Lazy.Text where
237 typeInformation =
238 mapTypeInformation Text.fromStrict Text.toStrict typeInformation
241-- | Corresponds to @citext@
242instance DBType (CI Text) where
243 typeInformation = mapTypeInformation CI.mk CI.original typeInformation
244 { typeName = "citext"
245 }
248-- | Corresponds to @citext@
249instance DBType (CI Lazy.Text) where
250 typeInformation = mapTypeInformation CI.mk CI.original typeInformation
251 { typeName = "citext"
252 }
255-- | Corresponds to @bytea@
256instance DBType ByteString where
257 typeInformation = TypeInformation
258 { encode = Opaleye.ConstExpr . Opaleye.ByteStringLit
259 , decode = Hasql.bytea
260 , typeName = "bytea"
261 }
264-- | Corresponds to @bytea@
265instance DBType Lazy.ByteString where
266 typeInformation =
267 mapTypeInformation ByteString.fromStrict ByteString.toStrict
268 typeInformation
271-- | Corresponds to @uuid@
272instance DBType UUID where
273 typeInformation = TypeInformation
274 { encode = Opaleye.ConstExpr . Opaleye.StringLit . UUID.toString
275 , decode = Hasql.uuid
276 , typeName = "uuid"
277 }
280-- | Corresponds to @jsonb@
281instance DBType Value where
282 typeInformation = TypeInformation
283 { encode =
284 Opaleye.ConstExpr . Opaleye.OtherLit .
285 Opaleye.quote .
286 Lazy.unpack . Lazy.decodeUtf8 . Aeson.encode
287 , decode = Hasql.jsonb
288 , typeName = "jsonb"
289 }
292instance Sql DBType a => DBType [a] where
293 typeInformation = listTypeInformation nullabilization typeInformation
296instance Sql DBType a => DBType (NonEmpty a) where
297 typeInformation = nonEmptyTypeInformation nullabilization typeInformation
300instance {-# OVERLAPPING #-} DBType Opaque where
301 typeInformation = error "opaque"
304instance {-# INCOHERENT #-} (HasNullability a, DBType (Unnullify a)) =>
305 Sql DBType a