on 593e21b help sign in
rel8/src/Rel8/Type.hs
282 lines 7.3 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.Nullability
39 ( NotNull
40 , nullabilization
41 , Sql
42 )
43import Rel8.Type.Array ( listTypeInformation, nonEmptyTypeInformation )
44import Rel8.Type.Information ( TypeInformation(..), mapTypeInformation )
46-- scientific
47import Data.Scientific ( Scientific )
49-- text
50import Data.Text ( Text )
51import qualified Data.Text as Text
52import qualified Data.Text.Lazy as Lazy ( Text, unpack )
53import qualified Data.Text.Lazy as Text ( fromStrict, toStrict )
54import qualified Data.Text.Lazy.Encoding as Lazy ( decodeUtf8 )
56-- time
57import Data.Time.Calendar ( Day )
58import Data.Time.Clock ( UTCTime )
59import Data.Time.LocalTime
60 ( CalendarDiffTime( CalendarDiffTime )
61 , LocalTime
62 , TimeOfDay
63 )
64import Data.Time.Format ( formatTime, defaultTimeLocale )
66-- uuid
67import Data.UUID ( UUID )
68import qualified Data.UUID as UUID
71-- | Haskell types that can be represented as expressions in a database. There
72-- should be an instance of @DBType@ for all column types in your database
73-- schema (e.g., @int@, @timestamptz@, etc).
74--
75-- Rel8 comes with stock instances for most default types in PostgreSQL, so you
76-- should only need to derive instances of this class for custom database
77-- types, such as types defined in PostgreSQL extensions, or custom domain
78-- types.
79type DBType :: Type -> Constraint
80class NotNull a => DBType a where
81 typeInformation :: TypeInformation a
84-- | Corresponds to @bool@
85instance DBType Bool where
86 typeInformation = TypeInformation
87 { encode = Opaleye.ConstExpr . Opaleye.BoolLit
88 , decode = Hasql.bool
89 , typeName = "bool"
90 }
93-- | Corresponds to @char@
94instance DBType Char where
95 typeInformation = TypeInformation
96 { encode = Opaleye.ConstExpr . Opaleye.StringLit . pure
97 , decode = Hasql.char
98 , typeName = "char"
99 }
102-- | Corresponds to @int2@
103instance DBType Int16 where
104 typeInformation = TypeInformation
105 { encode = Opaleye.ConstExpr . Opaleye.IntegerLit . toInteger
106 , decode = Hasql.int2
107 , typeName = "int2"
108 }
111-- | Corresponds to @int4@
112instance DBType Int32 where
113 typeInformation = TypeInformation
114 { encode = Opaleye.ConstExpr . Opaleye.IntegerLit . toInteger
115 , decode = Hasql.int4
116 , typeName = "int4"
117 }
120-- | Corresponds to @int8@
121instance DBType Int64 where
122 typeInformation = TypeInformation
123 { encode = Opaleye.ConstExpr . Opaleye.IntegerLit . toInteger
124 , decode = Hasql.int8
125 , typeName = "int8"
126 }
129-- | Corresponds to @float4@
130instance DBType Float where
131 typeInformation = TypeInformation
132 { encode = Opaleye.ConstExpr . Opaleye.NumericLit . realToFrac
133 , decode = Hasql.float4
134 , typeName = "float4"
135 }
138-- | Corresponds to @float8@
139instance DBType Double where
140 typeInformation = TypeInformation
141 { encode = Opaleye.ConstExpr . Opaleye.NumericLit . realToFrac
142 , decode = Hasql.float8
143 , typeName = "float8"
144 }
147-- | Corresponds to @numeric@
148instance DBType Scientific where
149 typeInformation = TypeInformation
150 { encode = Opaleye.ConstExpr . Opaleye.NumericLit
151 , decode = Hasql.numeric
152 , typeName = "numeric"
153 }
156-- | Corresponds to @timestamptz@
157instance DBType UTCTime where
158 typeInformation = TypeInformation
159 { encode =
160 Opaleye.ConstExpr . Opaleye.OtherLit .
161 formatTime defaultTimeLocale "'%FT%T%QZ'"
162 , decode = Hasql.timestamptz
163 , typeName = "timestamptz"
164 }
167-- | Corresponds to @date@
168instance DBType Day where
169 typeInformation = TypeInformation
170 { encode =
171 Opaleye.ConstExpr . Opaleye.OtherLit .
172 formatTime defaultTimeLocale "'%F'"
173 , decode = Hasql.date
174 , typeName = "date"
175 }
178-- | Corresponds to @timestamp@
179instance DBType LocalTime where
180 typeInformation = TypeInformation
181 { encode =
182 Opaleye.ConstExpr . Opaleye.OtherLit .
183 formatTime defaultTimeLocale "'%FT%T%Q'"
184 , decode = Hasql.timestamp
185 , typeName = "timestamp"
186 }
189-- | Corresponds to @time@
190instance DBType TimeOfDay where
191 typeInformation = TypeInformation
192 { encode =
193 Opaleye.ConstExpr . Opaleye.OtherLit .
194 formatTime defaultTimeLocale "'%T%Q'"
195 , decode = Hasql.time
196 , typeName = "time"
197 }
200-- | Corresponds to @interval@
201instance DBType CalendarDiffTime where
202 typeInformation = TypeInformation
203 { encode =
204 Opaleye.ConstExpr . Opaleye.OtherLit .
205 formatTime defaultTimeLocale "'%bmon %0Es'"
206 , decode = CalendarDiffTime 0 . realToFrac <$> Hasql.interval
207 , typeName = "interval"
208 }
211-- | Corresponds to @text@
212instance DBType Text where
213 typeInformation = TypeInformation
214 { encode = Opaleye.ConstExpr . Opaleye.StringLit . Text.unpack
215 , decode = Hasql.text
216 , typeName = "text"
217 }
220-- | Corresponds to @text@
221instance DBType Lazy.Text where
222 typeInformation =
223 mapTypeInformation Text.fromStrict Text.toStrict typeInformation
226-- | Corresponds to @citext@
227instance DBType (CI Text) where
228 typeInformation = mapTypeInformation CI.mk CI.original typeInformation
229 { typeName = "citext"
230 }
233-- | Corresponds to @citext@
234instance DBType (CI Lazy.Text) where
235 typeInformation = mapTypeInformation CI.mk CI.original typeInformation
236 { typeName = "citext"
237 }
240-- | Corresponds to @bytea@
241instance DBType ByteString where
242 typeInformation = TypeInformation
243 { encode = Opaleye.ConstExpr . Opaleye.ByteStringLit
244 , decode = Hasql.bytea
245 , typeName = "bytea"
246 }
249-- | Corresponds to @bytea@
250instance DBType Lazy.ByteString where
251 typeInformation =
252 mapTypeInformation ByteString.fromStrict ByteString.toStrict
253 typeInformation
256-- | Corresponds to @uuid@
257instance DBType UUID where
258 typeInformation = TypeInformation
259 { encode = Opaleye.ConstExpr . Opaleye.StringLit . UUID.toString
260 , decode = Hasql.uuid
261 , typeName = "uuid"
262 }
265-- | Corresponds to @jsonb@
266instance DBType Value where
267 typeInformation = TypeInformation
268 { encode =
269 Opaleye.ConstExpr . Opaleye.OtherLit .
270 Opaleye.quote .
271 Lazy.unpack . Lazy.decodeUtf8 . Aeson.encode
272 , decode = Hasql.jsonb
273 , typeName = "jsonb"
274 }
277instance Sql DBType a => DBType [a] where
278 typeInformation = listTypeInformation nullabilization typeInformation
281instance Sql DBType a => DBType (NonEmpty a) where
282 typeInformation = nonEmptyTypeInformation nullabilization typeInformation