git.iko.soy/rel8
on ab3a193 help sign in
rel8/src/Rel8/Type.hs
292 lines 7.7 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
64type DBType :: Type -> Constraint
65class DBType a where
66 typeInformation :: TypeInformation a
69-- | Haskell types that can be represented as expressions in a database. There
70-- should be an instance of @DBType@ for all column types in your database
71-- schema (e.g., @int@, @timestamptz@, etc).
72--
73-- Rel8 comes with stock instances for most default types in PostgreSQL, so you
74-- should only need to derive instances of this class for custom database
75-- types, such as types defined in PostgreSQL extensions, or custom domain
76-- types.
77--
78-- [ Creating @DBType@s using @newtype@ ]
79--
80-- Generalized newtype deriving can be used when you want use a @newtype@
81-- around a database type for clarity and accuracy in your Haskell code. A
82-- common example is to @newtype@ row id types:
83--
84-- >>> newtype UserId = UserId { toInt32 :: Int32 } deriving newtype (DBType)
85--
86-- You can now write queries using @UserId@ instead of @Int32@, which may help
87-- avoid making bad joins. However, when SQL is generated, it will be as if you
88-- just used integers (the type distinction does not impact query generation).
89instance DBType Bool where
90 typeInformation = TypeInformation
91 { encode = Opaleye.ConstExpr . Opaleye.BoolLit
92 , decode = Hasql.bool
93 , typeName = "bool"
94 , out = id
95 }
98instance DBType Char where
99 typeInformation = TypeInformation
100 { encode = Opaleye.ConstExpr . Opaleye.StringLit . pure
101 , decode = Hasql.char
102 , typeName = "char"
103 , out = id
104 }
107instance DBType Int16 where
108 typeInformation = TypeInformation
109 { encode = Opaleye.ConstExpr . Opaleye.IntegerLit . toInteger
110 , decode = Hasql.int2
111 , typeName = "int2"
112 , out = id
113 }
116instance DBType Int32 where
117 typeInformation = TypeInformation
118 { encode = Opaleye.ConstExpr . Opaleye.IntegerLit . toInteger
119 , decode = Hasql.int4
120 , typeName = "int4"
121 , out = id
122 }
125instance DBType Int64 where
126 typeInformation = TypeInformation
127 { encode = Opaleye.ConstExpr . Opaleye.IntegerLit . toInteger
128 , decode = Hasql.int8
129 , typeName = "int8"
130 , out = id
131 }
134instance DBType Float where
135 typeInformation = TypeInformation
136 { encode = Opaleye.ConstExpr . Opaleye.NumericLit . realToFrac
137 , decode = Hasql.float4
138 , typeName = "float4"
139 , out = id
140 }
143instance DBType Double where
144 typeInformation = TypeInformation
145 { encode = Opaleye.ConstExpr . Opaleye.NumericLit . realToFrac
146 , decode = Hasql.float8
147 , typeName = "float8"
148 , out = id
149 }
152instance DBType Scientific where
153 typeInformation = TypeInformation
154 { encode = Opaleye.ConstExpr . Opaleye.NumericLit
155 , decode = Hasql.numeric
156 , typeName = "numeric"
157 , out = id
158 }
161instance DBType UTCTime where
162 typeInformation = TypeInformation
163 { encode =
164 Opaleye.ConstExpr . Opaleye.OtherLit .
165 formatTime defaultTimeLocale "'%FT%T%QZ'"
166 , decode = Hasql.timestamptz
167 , typeName = "timestamptz"
168 , out = id
169 }
172instance DBType Day where
173 typeInformation = TypeInformation
174 { encode =
175 Opaleye.ConstExpr . Opaleye.OtherLit .
176 formatTime defaultTimeLocale "'%F'"
177 , decode = Hasql.date
178 , typeName = "date"
179 , out = id
180 }
183instance DBType LocalTime where
184 typeInformation = TypeInformation
185 { encode =
186 Opaleye.ConstExpr . Opaleye.OtherLit .
187 formatTime defaultTimeLocale "'%FT%T%Q'"
188 , decode = Hasql.timestamp
189 , typeName = "timestamp"
190 , out = id
191 }
194instance DBType TimeOfDay where
195 typeInformation = TypeInformation
196 { encode =
197 Opaleye.ConstExpr . Opaleye.OtherLit .
198 formatTime defaultTimeLocale "'%T%Q'"
199 , decode = Hasql.time
200 , typeName = "time"
201 , out = id
202 }
205instance DBType DiffTime where
206 typeInformation = TypeInformation
207 { encode =
208 Opaleye.ConstExpr . Opaleye.OtherLit .
209 formatTime defaultTimeLocale "'%-6Es'"
210 , decode = Hasql.interval
211 , typeName = "interval"
212 , out = id
213 }
216instance DBType NominalDiffTime where
217 typeInformation =
218 mapTypeInformation @DiffTime realToFrac realToFrac typeInformation
221instance DBType Text where
222 typeInformation = TypeInformation
223 { encode = Opaleye.ConstExpr . Opaleye.StringLit . Text.unpack
224 , decode = Hasql.text
225 , typeName = "text"
226 , out = id
227 }
230instance DBType Lazy.Text where
231 typeInformation =
232 mapTypeInformation Text.fromStrict Text.toStrict typeInformation
235instance DBType (CI Text) where
236 typeInformation = mapTypeInformation CI.mk CI.original typeInformation
237 { typeName = "citext"
238 }
241instance DBType (CI Lazy.Text) where
242 typeInformation = mapTypeInformation CI.mk CI.original typeInformation
243 { typeName = "citext"
244 }
247instance DBType ByteString where
248 typeInformation = TypeInformation
249 { encode = Opaleye.ConstExpr . Opaleye.ByteStringLit
250 , decode = Hasql.bytea
251 , typeName = "bytea"
252 , out = id
253 }
256instance DBType Lazy.ByteString where
257 typeInformation =
258 mapTypeInformation ByteString.fromStrict ByteString.toStrict
259 typeInformation
262instance DBType UUID where
263 typeInformation = TypeInformation
264 { encode = Opaleye.ConstExpr . Opaleye.StringLit . UUID.toString
265 , decode = Hasql.uuid
266 , typeName = "uuid"
267 , out = id
268 }
271instance DBType Value where
272 typeInformation = TypeInformation
273 { encode =
274 Opaleye.ConstExpr . Opaleye.OtherLit .
275 Opaleye.quote .
276 Lazy.unpack . Lazy.decodeUtf8 . Aeson.encode
277 , decode = Hasql.jsonb
278 , typeName = "jsonb"
279 , out = id
280 }
283instance (DBType db, Nullabilizes db a) => DBType [a] where
284 typeInformation = listTypeInformation nullabilization typeInformation
287instance (DBType db, Nullabilizes db a) => DBType (NonEmpty a) where
288 typeInformation = nonEmptyTypeInformation nullabilization typeInformation
291instance {-# OVERLAPPING #-} DBType Opaque where
292 typeInformation = error "opaque"