git.iko.soy/rel8
on db148ff help sign in
rel8/src/Rel8/Type.hs
287 lines 7.7 kB history raw
1{-# language FlexibleInstances #-}
2{-# language MonoLocalBinds #-}
3{-# language MultiWayIf #-}
4{-# language StandaloneKindSignatures #-}
5{-# language UndecidableInstances #-}
7module Rel8.Type
8 ( DBType (typeInformation)
9 )
10where
12-- aeson
13import Data.Aeson ( Value )
14import qualified Data.Aeson as Aeson
16-- base
17import Data.Int ( Int16, Int32, Int64 )
18import Data.List.NonEmpty ( NonEmpty )
19import Data.Kind ( Constraint, Type )
20import Prelude
22-- bytestring
23import Data.ByteString ( ByteString )
24import qualified Data.ByteString.Lazy as Lazy ( ByteString )
25import qualified Data.ByteString.Lazy as ByteString ( fromStrict, toStrict )
27-- case-insensitive
28import Data.CaseInsensitive ( CI )
29import qualified Data.CaseInsensitive as CI
31-- hasql
32import qualified Hasql.Decoders as Hasql
34-- opaleye
35import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
36import qualified Opaleye.Internal.HaskellDB.Sql.Default as Opaleye ( quote )
38-- rel8
39import Rel8.Schema.Null ( NotNull, Sql, nullable )
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 ( UTCTime )
56import Data.Time.LocalTime
57 ( CalendarDiffTime( CalendarDiffTime )
58 , LocalTime
59 , TimeOfDay
60 )
61import Data.Time.Format ( formatTime, defaultTimeLocale )
63-- uuid
64import Data.UUID ( UUID )
65import qualified Data.UUID as UUID
68-- | Haskell types that can be represented as expressions in a database. There
69-- should be an instance of @DBType@ for all column types in your database
70-- schema (e.g., @int@, @timestamptz@, etc).
71--
72-- Rel8 comes with stock instances for most default types in PostgreSQL, so you
73-- should only need to derive instances of this class for custom database
74-- types, such as types defined in PostgreSQL extensions, or custom domain
75-- types.
76type DBType :: Type -> Constraint
77class NotNull a => DBType a where
78 typeInformation :: TypeInformation a
81-- | Corresponds to @bool@
82instance DBType Bool where
83 typeInformation = TypeInformation
84 { encode = Opaleye.ConstExpr . Opaleye.BoolLit
85 , decode = Hasql.bool
86 , typeName = "bool"
87 }
90-- | Corresponds to @char@
91instance DBType Char where
92 typeInformation = TypeInformation
93 { encode = Opaleye.ConstExpr . Opaleye.StringLit . pure
94 , decode = Hasql.char
95 , typeName = "char"
96 }
99-- | Corresponds to @int2@
100instance DBType Int16 where
101 typeInformation = TypeInformation
102 { encode = Opaleye.ConstExpr . Opaleye.IntegerLit . toInteger
103 , decode = Hasql.int2
104 , typeName = "int2"
105 }
108-- | Corresponds to @int4@
109instance DBType Int32 where
110 typeInformation = TypeInformation
111 { encode = Opaleye.ConstExpr . Opaleye.IntegerLit . toInteger
112 , decode = Hasql.int4
113 , typeName = "int4"
114 }
117-- | Corresponds to @int8@
118instance DBType Int64 where
119 typeInformation = TypeInformation
120 { encode = Opaleye.ConstExpr . Opaleye.IntegerLit . toInteger
121 , decode = Hasql.int8
122 , typeName = "int8"
123 }
126-- | Corresponds to @float4@
127instance DBType Float where
128 typeInformation = TypeInformation
129 { encode = \x -> Opaleye.ConstExpr
130 if | x == (1 /0) -> Opaleye.OtherLit "'Infinity'"
131 | isNaN x -> Opaleye.OtherLit "'NaN'"
132 | x == (-1/0) -> Opaleye.OtherLit "'-Infinity'"
133 | otherwise -> Opaleye.NumericLit $ realToFrac x
134 , decode = Hasql.float4
135 , typeName = "float4"
136 }
139-- | Corresponds to @float8@
140instance DBType Double where
141 typeInformation = TypeInformation
142 { encode = \x -> Opaleye.ConstExpr
143 if | x == (1 /0) -> Opaleye.OtherLit "'Infinity'"
144 | isNaN x -> Opaleye.OtherLit "'NaN'"
145 | x == (-1/0) -> Opaleye.OtherLit "'-Infinity'"
146 | otherwise -> Opaleye.NumericLit $ realToFrac x
147 , decode = Hasql.float8
148 , typeName = "float8"
149 }
152-- | Corresponds to @numeric@
153instance DBType Scientific where
154 typeInformation = TypeInformation
155 { encode = Opaleye.ConstExpr . Opaleye.NumericLit
156 , decode = Hasql.numeric
157 , typeName = "numeric"
158 }
161-- | Corresponds to @timestamptz@
162instance DBType UTCTime where
163 typeInformation = TypeInformation
164 { encode =
165 Opaleye.ConstExpr . Opaleye.OtherLit .
166 formatTime defaultTimeLocale "'%FT%T%QZ'"
167 , decode = Hasql.timestamptz
168 , typeName = "timestamptz"
169 }
172-- | Corresponds to @date@
173instance DBType Day where
174 typeInformation = TypeInformation
175 { encode =
176 Opaleye.ConstExpr . Opaleye.OtherLit .
177 formatTime defaultTimeLocale "'%F'"
178 , decode = Hasql.date
179 , typeName = "date"
180 }
183-- | Corresponds to @timestamp@
184instance DBType LocalTime where
185 typeInformation = TypeInformation
186 { encode =
187 Opaleye.ConstExpr . Opaleye.OtherLit .
188 formatTime defaultTimeLocale "'%FT%T%Q'"
189 , decode = Hasql.timestamp
190 , typeName = "timestamp"
191 }
194-- | Corresponds to @time@
195instance DBType TimeOfDay where
196 typeInformation = TypeInformation
197 { encode =
198 Opaleye.ConstExpr . Opaleye.OtherLit .
199 formatTime defaultTimeLocale "'%T%Q'"
200 , decode = Hasql.time
201 , typeName = "time"
202 }
205-- | Corresponds to @interval@
206instance DBType CalendarDiffTime where
207 typeInformation = TypeInformation
208 { encode =
209 Opaleye.ConstExpr . Opaleye.OtherLit .
210 formatTime defaultTimeLocale "'%bmon %0Es'"
211 , decode = CalendarDiffTime 0 . realToFrac <$> Hasql.interval
212 , typeName = "interval"
213 }
216-- | Corresponds to @text@
217instance DBType Text where
218 typeInformation = TypeInformation
219 { encode = Opaleye.ConstExpr . Opaleye.StringLit . Text.unpack
220 , decode = Hasql.text
221 , typeName = "text"
222 }
225-- | Corresponds to @text@
226instance DBType Lazy.Text where
227 typeInformation =
228 mapTypeInformation Text.fromStrict Text.toStrict typeInformation
231-- | Corresponds to @citext@
232instance DBType (CI Text) where
233 typeInformation = mapTypeInformation CI.mk CI.original typeInformation
234 { typeName = "citext"
235 }
238-- | Corresponds to @citext@
239instance DBType (CI Lazy.Text) where
240 typeInformation = mapTypeInformation CI.mk CI.original typeInformation
241 { typeName = "citext"
242 }
245-- | Corresponds to @bytea@
246instance DBType ByteString where
247 typeInformation = TypeInformation
248 { encode = Opaleye.ConstExpr . Opaleye.ByteStringLit
249 , decode = Hasql.bytea
250 , typeName = "bytea"
251 }
254-- | Corresponds to @bytea@
255instance DBType Lazy.ByteString where
256 typeInformation =
257 mapTypeInformation ByteString.fromStrict ByteString.toStrict
258 typeInformation
261-- | Corresponds to @uuid@
262instance DBType UUID where
263 typeInformation = TypeInformation
264 { encode = Opaleye.ConstExpr . Opaleye.StringLit . UUID.toString
265 , decode = Hasql.uuid
266 , typeName = "uuid"
267 }
270-- | Corresponds to @jsonb@
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 }
282instance Sql DBType a => DBType [a] where
283 typeInformation = listTypeInformation nullable typeInformation
286instance Sql DBType a => DBType (NonEmpty a) where
287 typeInformation = nonEmptyTypeInformation nullable typeInformation