git.iko.soy/rel8
on da76712 help sign in
rel8/src/Rel8/Type.hs
288 lines 7.7 kB history raw
1{-# language FlexibleContexts #-}
2{-# language FlexibleInstances #-}
3{-# language MonoLocalBinds #-}
4{-# language MultiWayIf #-}
5{-# language StandaloneKindSignatures #-}
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.Schema.Null ( NotNull, Sql, nullable )
41import Rel8.Type.Array ( listTypeInformation, nonEmptyTypeInformation )
42import Rel8.Type.Information ( TypeInformation(..), mapTypeInformation )
44-- scientific
45import Data.Scientific ( Scientific )
47-- text
48import Data.Text ( Text )
49import qualified Data.Text as Text
50import qualified Data.Text.Lazy as Lazy ( Text, unpack )
51import qualified Data.Text.Lazy as Text ( fromStrict, toStrict )
52import qualified Data.Text.Lazy.Encoding as Lazy ( decodeUtf8 )
54-- time
55import Data.Time.Calendar ( Day )
56import Data.Time.Clock ( UTCTime )
57import Data.Time.LocalTime
58 ( CalendarDiffTime( CalendarDiffTime )
59 , LocalTime
60 , TimeOfDay
61 )
62import Data.Time.Format ( formatTime, defaultTimeLocale )
64-- uuid
65import Data.UUID ( UUID )
66import qualified Data.UUID as UUID
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.
77type DBType :: Type -> Constraint
78class NotNull a => DBType a where
79 typeInformation :: TypeInformation a
82-- | Corresponds to @bool@
83instance DBType Bool where
84 typeInformation = TypeInformation
85 { encode = Opaleye.ConstExpr . Opaleye.BoolLit
86 , decode = Hasql.bool
87 , typeName = "bool"
88 }
91-- | Corresponds to @char@
92instance DBType Char where
93 typeInformation = TypeInformation
94 { encode = Opaleye.ConstExpr . Opaleye.StringLit . pure
95 , decode = Hasql.char
96 , typeName = "char"
97 }
100-- | Corresponds to @int2@
101instance DBType Int16 where
102 typeInformation = TypeInformation
103 { encode = Opaleye.ConstExpr . Opaleye.IntegerLit . toInteger
104 , decode = Hasql.int2
105 , typeName = "int2"
106 }
109-- | Corresponds to @int4@
110instance DBType Int32 where
111 typeInformation = TypeInformation
112 { encode = Opaleye.ConstExpr . Opaleye.IntegerLit . toInteger
113 , decode = Hasql.int4
114 , typeName = "int4"
115 }
118-- | Corresponds to @int8@
119instance DBType Int64 where
120 typeInformation = TypeInformation
121 { encode = Opaleye.ConstExpr . Opaleye.IntegerLit . toInteger
122 , decode = Hasql.int8
123 , typeName = "int8"
124 }
127-- | Corresponds to @float4@
128instance DBType Float where
129 typeInformation = TypeInformation
130 { encode = \x -> Opaleye.ConstExpr
131 if | x == (1 / 0) -> Opaleye.OtherLit "'Infinity'"
132 | isNaN x -> Opaleye.OtherLit "'NaN'"
133 | x == (-1 / 0) -> Opaleye.OtherLit "'-Infinity'"
134 | otherwise -> Opaleye.NumericLit $ realToFrac x
135 , decode = Hasql.float4
136 , typeName = "float4"
137 }
140-- | Corresponds to @float8@
141instance DBType Double where
142 typeInformation = TypeInformation
143 { encode = \x -> Opaleye.ConstExpr
144 if | x == (1 / 0) -> Opaleye.OtherLit "'Infinity'"
145 | isNaN x -> Opaleye.OtherLit "'NaN'"
146 | x == (-1 / 0) -> Opaleye.OtherLit "'-Infinity'"
147 | otherwise -> Opaleye.NumericLit $ realToFrac x
148 , decode = Hasql.float8
149 , typeName = "float8"
150 }
153-- | Corresponds to @numeric@
154instance DBType Scientific where
155 typeInformation = TypeInformation
156 { encode = Opaleye.ConstExpr . Opaleye.NumericLit
157 , decode = Hasql.numeric
158 , typeName = "numeric"
159 }
162-- | Corresponds to @timestamptz@
163instance DBType UTCTime where
164 typeInformation = TypeInformation
165 { encode =
166 Opaleye.ConstExpr . Opaleye.OtherLit .
167 formatTime defaultTimeLocale "'%FT%T%QZ'"
168 , decode = Hasql.timestamptz
169 , typeName = "timestamptz"
170 }
173-- | Corresponds to @date@
174instance DBType Day where
175 typeInformation = TypeInformation
176 { encode =
177 Opaleye.ConstExpr . Opaleye.OtherLit .
178 formatTime defaultTimeLocale "'%F'"
179 , decode = Hasql.date
180 , typeName = "date"
181 }
184-- | Corresponds to @timestamp@
185instance DBType LocalTime where
186 typeInformation = TypeInformation
187 { encode =
188 Opaleye.ConstExpr . Opaleye.OtherLit .
189 formatTime defaultTimeLocale "'%FT%T%Q'"
190 , decode = Hasql.timestamp
191 , typeName = "timestamp"
192 }
195-- | Corresponds to @time@
196instance DBType TimeOfDay where
197 typeInformation = TypeInformation
198 { encode =
199 Opaleye.ConstExpr . Opaleye.OtherLit .
200 formatTime defaultTimeLocale "'%T%Q'"
201 , decode = Hasql.time
202 , typeName = "time"
203 }
206-- | Corresponds to @interval@
207instance DBType CalendarDiffTime where
208 typeInformation = TypeInformation
209 { encode =
210 Opaleye.ConstExpr . Opaleye.OtherLit .
211 formatTime defaultTimeLocale "'%bmon %0Es'"
212 , decode = CalendarDiffTime 0 . realToFrac <$> Hasql.interval
213 , typeName = "interval"
214 }
217-- | Corresponds to @text@
218instance DBType Text where
219 typeInformation = TypeInformation
220 { encode = Opaleye.ConstExpr . Opaleye.StringLit . Text.unpack
221 , decode = Hasql.text
222 , typeName = "text"
223 }
226-- | Corresponds to @text@
227instance DBType Lazy.Text where
228 typeInformation =
229 mapTypeInformation Text.fromStrict Text.toStrict typeInformation
232-- | Corresponds to @citext@
233instance DBType (CI Text) where
234 typeInformation = mapTypeInformation CI.mk CI.original typeInformation
235 { typeName = "citext"
236 }
239-- | Corresponds to @citext@
240instance DBType (CI Lazy.Text) where
241 typeInformation = mapTypeInformation CI.mk CI.original typeInformation
242 { typeName = "citext"
243 }
246-- | Corresponds to @bytea@
247instance DBType ByteString where
248 typeInformation = TypeInformation
249 { encode = Opaleye.ConstExpr . Opaleye.ByteStringLit
250 , decode = Hasql.bytea
251 , typeName = "bytea"
252 }
255-- | Corresponds to @bytea@
256instance DBType Lazy.ByteString where
257 typeInformation =
258 mapTypeInformation ByteString.fromStrict ByteString.toStrict
259 typeInformation
262-- | Corresponds to @uuid@
263instance DBType UUID where
264 typeInformation = TypeInformation
265 { encode = Opaleye.ConstExpr . Opaleye.StringLit . UUID.toString
266 , decode = Hasql.uuid
267 , typeName = "uuid"
268 }
271-- | Corresponds to @jsonb@
272instance DBType Value where
273 typeInformation = TypeInformation
274 { encode =
275 Opaleye.ConstExpr . Opaleye.OtherLit .
276 Opaleye.quote .
277 Lazy.unpack . Lazy.decodeUtf8 . Aeson.encode
278 , decode = Hasql.jsonb
279 , typeName = "jsonb"
280 }
283instance Sql DBType a => DBType [a] where
284 typeInformation = listTypeInformation nullable typeInformation
287instance Sql DBType a => DBType (NonEmpty a) where
288 typeInformation = nonEmptyTypeInformation nullable typeInformation