on 9ef8fd8 help sign in
rel8/src/Rel8/Type.hs
278 lines 7.2 kB history raw
1{-# language FlexibleInstances #-}
2{-# language MonoLocalBinds #-}
3{-# language StandaloneKindSignatures #-}
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.Schema.Null ( NotNull, Sql, nullable )
39import Rel8.Type.Array ( listTypeInformation, nonEmptyTypeInformation )
40import Rel8.Type.Information ( TypeInformation(..), mapTypeInformation )
42-- scientific
43import Data.Scientific ( Scientific )
45-- text
46import Data.Text ( Text )
47import qualified Data.Text as Text
48import qualified Data.Text.Lazy as Lazy ( Text, unpack )
49import qualified Data.Text.Lazy as Text ( fromStrict, toStrict )
50import qualified Data.Text.Lazy.Encoding as Lazy ( decodeUtf8 )
52-- time
53import Data.Time.Calendar ( Day )
54import Data.Time.Clock ( UTCTime )
55import Data.Time.LocalTime
56 ( CalendarDiffTime( CalendarDiffTime )
57 , LocalTime
58 , TimeOfDay
59 )
60import Data.Time.Format ( formatTime, defaultTimeLocale )
62-- uuid
63import Data.UUID ( UUID )
64import qualified Data.UUID as UUID
67-- | Haskell types that can be represented as expressions in a database. There
68-- should be an instance of @DBType@ for all column types in your database
69-- schema (e.g., @int@, @timestamptz@, etc).
70--
71-- Rel8 comes with stock instances for most default types in PostgreSQL, so you
72-- should only need to derive instances of this class for custom database
73-- types, such as types defined in PostgreSQL extensions, or custom domain
74-- types.
75type DBType :: Type -> Constraint
76class NotNull a => DBType a where
77 typeInformation :: TypeInformation a
80-- | Corresponds to @bool@
81instance DBType Bool where
82 typeInformation = TypeInformation
83 { encode = Opaleye.ConstExpr . Opaleye.BoolLit
84 , decode = Hasql.bool
85 , typeName = "bool"
86 }
89-- | Corresponds to @char@
90instance DBType Char where
91 typeInformation = TypeInformation
92 { encode = Opaleye.ConstExpr . Opaleye.StringLit . pure
93 , decode = Hasql.char
94 , typeName = "char"
95 }
98-- | Corresponds to @int2@
99instance DBType Int16 where
100 typeInformation = TypeInformation
101 { encode = Opaleye.ConstExpr . Opaleye.IntegerLit . toInteger
102 , decode = Hasql.int2
103 , typeName = "int2"
104 }
107-- | Corresponds to @int4@
108instance DBType Int32 where
109 typeInformation = TypeInformation
110 { encode = Opaleye.ConstExpr . Opaleye.IntegerLit . toInteger
111 , decode = Hasql.int4
112 , typeName = "int4"
113 }
116-- | Corresponds to @int8@
117instance DBType Int64 where
118 typeInformation = TypeInformation
119 { encode = Opaleye.ConstExpr . Opaleye.IntegerLit . toInteger
120 , decode = Hasql.int8
121 , typeName = "int8"
122 }
125-- | Corresponds to @float4@
126instance DBType Float where
127 typeInformation = TypeInformation
128 { encode = Opaleye.ConstExpr . Opaleye.NumericLit . realToFrac
129 , decode = Hasql.float4
130 , typeName = "float4"
131 }
134-- | Corresponds to @float8@
135instance DBType Double where
136 typeInformation = TypeInformation
137 { encode = Opaleye.ConstExpr . Opaleye.NumericLit . realToFrac
138 , decode = Hasql.float8
139 , typeName = "float8"
140 }
143-- | Corresponds to @numeric@
144instance DBType Scientific where
145 typeInformation = TypeInformation
146 { encode = Opaleye.ConstExpr . Opaleye.NumericLit
147 , decode = Hasql.numeric
148 , typeName = "numeric"
149 }
152-- | Corresponds to @timestamptz@
153instance DBType UTCTime where
154 typeInformation = TypeInformation
155 { encode =
156 Opaleye.ConstExpr . Opaleye.OtherLit .
157 formatTime defaultTimeLocale "'%FT%T%QZ'"
158 , decode = Hasql.timestamptz
159 , typeName = "timestamptz"
160 }
163-- | Corresponds to @date@
164instance DBType Day where
165 typeInformation = TypeInformation
166 { encode =
167 Opaleye.ConstExpr . Opaleye.OtherLit .
168 formatTime defaultTimeLocale "'%F'"
169 , decode = Hasql.date
170 , typeName = "date"
171 }
174-- | Corresponds to @timestamp@
175instance DBType LocalTime where
176 typeInformation = TypeInformation
177 { encode =
178 Opaleye.ConstExpr . Opaleye.OtherLit .
179 formatTime defaultTimeLocale "'%FT%T%Q'"
180 , decode = Hasql.timestamp
181 , typeName = "timestamp"
182 }
185-- | Corresponds to @time@
186instance DBType TimeOfDay where
187 typeInformation = TypeInformation
188 { encode =
189 Opaleye.ConstExpr . Opaleye.OtherLit .
190 formatTime defaultTimeLocale "'%T%Q'"
191 , decode = Hasql.time
192 , typeName = "time"
193 }
196-- | Corresponds to @interval@
197instance DBType CalendarDiffTime where
198 typeInformation = TypeInformation
199 { encode =
200 Opaleye.ConstExpr . Opaleye.OtherLit .
201 formatTime defaultTimeLocale "'%bmon %0Es'"
202 , decode = CalendarDiffTime 0 . realToFrac <$> Hasql.interval
203 , typeName = "interval"
204 }
207-- | Corresponds to @text@
208instance DBType Text where
209 typeInformation = TypeInformation
210 { encode = Opaleye.ConstExpr . Opaleye.StringLit . Text.unpack
211 , decode = Hasql.text
212 , typeName = "text"
213 }
216-- | Corresponds to @text@
217instance DBType Lazy.Text where
218 typeInformation =
219 mapTypeInformation Text.fromStrict Text.toStrict typeInformation
222-- | Corresponds to @citext@
223instance DBType (CI Text) where
224 typeInformation = mapTypeInformation CI.mk CI.original typeInformation
225 { typeName = "citext"
226 }
229-- | Corresponds to @citext@
230instance DBType (CI Lazy.Text) where
231 typeInformation = mapTypeInformation CI.mk CI.original typeInformation
232 { typeName = "citext"
233 }
236-- | Corresponds to @bytea@
237instance DBType ByteString where
238 typeInformation = TypeInformation
239 { encode = Opaleye.ConstExpr . Opaleye.ByteStringLit
240 , decode = Hasql.bytea
241 , typeName = "bytea"
242 }
245-- | Corresponds to @bytea@
246instance DBType Lazy.ByteString where
247 typeInformation =
248 mapTypeInformation ByteString.fromStrict ByteString.toStrict
249 typeInformation
252-- | Corresponds to @uuid@
253instance DBType UUID where
254 typeInformation = TypeInformation
255 { encode = Opaleye.ConstExpr . Opaleye.StringLit . UUID.toString
256 , decode = Hasql.uuid
257 , typeName = "uuid"
258 }
261-- | Corresponds to @jsonb@
262instance DBType Value where
263 typeInformation = TypeInformation
264 { encode =
265 Opaleye.ConstExpr . Opaleye.OtherLit .
266 Opaleye.quote .
267 Lazy.unpack . Lazy.decodeUtf8 . Aeson.encode
268 , decode = Hasql.jsonb
269 , typeName = "jsonb"
270 }
273instance Sql DBType a => DBType [a] where
274 typeInformation = listTypeInformation nullable typeInformation
277instance Sql DBType a => DBType (NonEmpty a) where
278 typeInformation = nonEmptyTypeInformation nullable typeInformation