git.iko.soy/rel8
on a683d3c help sign in
rel8/src/Rel8/Type.hs
293 lines 7.6 kB history raw
1{-# language FlexibleInstances #-}
2{-# language MultiParamTypeClasses #-}
3{-# language StandaloneKindSignatures #-}
4{-# language TypeApplications #-}
5{-# language UndecidableInstances #-}
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.Opaque ( Opaque )
41import Rel8.Schema.Nullability
42 ( NotNull, Unnullify
43 , HasNullability, nullabilization
44 , Sql
45 )
46import Rel8.Type.Array ( listTypeInformation, nonEmptyTypeInformation )
47import Rel8.Type.Information ( TypeInformation(..), mapTypeInformation )
49-- scientific
50import Data.Scientific ( Scientific )
52-- text
53import Data.Text ( Text )
54import qualified Data.Text as Text
55import qualified Data.Text.Lazy as Lazy ( Text, unpack )
56import qualified Data.Text.Lazy as Text ( fromStrict, toStrict )
57import qualified Data.Text.Lazy.Encoding as Lazy ( decodeUtf8 )
59-- time
60import Data.Time.Calendar ( Day )
61import Data.Time.Clock ( UTCTime )
62import Data.Time.LocalTime
63 ( CalendarDiffTime( CalendarDiffTime )
64 , LocalTime
65 , TimeOfDay
66 )
67import Data.Time.Format ( formatTime, defaultTimeLocale )
69-- uuid
70import Data.UUID ( UUID )
71import qualified Data.UUID as UUID
74-- | Haskell types that can be represented as expressions in a database. There
75-- should be an instance of @DBType@ for all column types in your database
76-- schema (e.g., @int@, @timestamptz@, etc).
77--
78-- Rel8 comes with stock instances for most default types in PostgreSQL, so you
79-- should only need to derive instances of this class for custom database
80-- types, such as types defined in PostgreSQL extensions, or custom domain
81-- types.
82type DBType :: Type -> Constraint
83class NotNull a => DBType a where
84 typeInformation :: TypeInformation a
87-- | Corresponds to @bool@
88instance DBType Bool where
89 typeInformation = TypeInformation
90 { encode = Opaleye.ConstExpr . Opaleye.BoolLit
91 , decode = Hasql.bool
92 , typeName = "bool"
93 }
96-- | Corresponds to @char@
97instance DBType Char where
98 typeInformation = TypeInformation
99 { encode = Opaleye.ConstExpr . Opaleye.StringLit . pure
100 , decode = Hasql.char
101 , typeName = "char"
102 }
105-- | Corresponds to @int2@
106instance DBType Int16 where
107 typeInformation = TypeInformation
108 { encode = Opaleye.ConstExpr . Opaleye.IntegerLit . toInteger
109 , decode = Hasql.int2
110 , typeName = "int2"
111 }
114-- | Corresponds to @int4@
115instance DBType Int32 where
116 typeInformation = TypeInformation
117 { encode = Opaleye.ConstExpr . Opaleye.IntegerLit . toInteger
118 , decode = Hasql.int4
119 , typeName = "int4"
120 }
123-- | Corresponds to @int8@
124instance DBType Int64 where
125 typeInformation = TypeInformation
126 { encode = Opaleye.ConstExpr . Opaleye.IntegerLit . toInteger
127 , decode = Hasql.int8
128 , typeName = "int8"
129 }
132-- | Corresponds to @float4@
133instance DBType Float where
134 typeInformation = TypeInformation
135 { encode = Opaleye.ConstExpr . Opaleye.NumericLit . realToFrac
136 , decode = Hasql.float4
137 , typeName = "float4"
138 }
141-- | Corresponds to @float8@
142instance DBType Double where
143 typeInformation = TypeInformation
144 { encode = Opaleye.ConstExpr . Opaleye.NumericLit . realToFrac
145 , decode = Hasql.float8
146 , typeName = "float8"
147 }
150-- | Corresponds to @numeric@
151instance DBType Scientific where
152 typeInformation = TypeInformation
153 { encode = Opaleye.ConstExpr . Opaleye.NumericLit
154 , decode = Hasql.numeric
155 , typeName = "numeric"
156 }
159-- | Corresponds to @timestamptz@
160instance DBType UTCTime where
161 typeInformation = TypeInformation
162 { encode =
163 Opaleye.ConstExpr . Opaleye.OtherLit .
164 formatTime defaultTimeLocale "'%FT%T%QZ'"
165 , decode = Hasql.timestamptz
166 , typeName = "timestamptz"
167 }
170-- | Corresponds to @date@
171instance DBType Day where
172 typeInformation = TypeInformation
173 { encode =
174 Opaleye.ConstExpr . Opaleye.OtherLit .
175 formatTime defaultTimeLocale "'%F'"
176 , decode = Hasql.date
177 , typeName = "date"
178 }
181-- | Corresponds to @timestamp@
182instance DBType LocalTime where
183 typeInformation = TypeInformation
184 { encode =
185 Opaleye.ConstExpr . Opaleye.OtherLit .
186 formatTime defaultTimeLocale "'%FT%T%Q'"
187 , decode = Hasql.timestamp
188 , typeName = "timestamp"
189 }
192-- | Corresponds to @time@
193instance DBType TimeOfDay where
194 typeInformation = TypeInformation
195 { encode =
196 Opaleye.ConstExpr . Opaleye.OtherLit .
197 formatTime defaultTimeLocale "'%T%Q'"
198 , decode = Hasql.time
199 , typeName = "time"
200 }
203-- | Corresponds to @interval@
204instance DBType CalendarDiffTime where
205 typeInformation = TypeInformation
206 { encode =
207 Opaleye.ConstExpr . Opaleye.OtherLit .
208 formatTime defaultTimeLocale "'%bmon %0Es'"
209 , decode = CalendarDiffTime 0 . realToFrac <$> Hasql.interval
210 , typeName = "interval"
211 }
214-- | Corresponds to @text@
215instance DBType Text where
216 typeInformation = TypeInformation
217 { encode = Opaleye.ConstExpr . Opaleye.StringLit . Text.unpack
218 , decode = Hasql.text
219 , typeName = "text"
220 }
223-- | Corresponds to @text@
224instance DBType Lazy.Text where
225 typeInformation =
226 mapTypeInformation Text.fromStrict Text.toStrict typeInformation
229-- | Corresponds to @citext@
230instance DBType (CI Text) where
231 typeInformation = mapTypeInformation CI.mk CI.original typeInformation
232 { typeName = "citext"
233 }
236-- | Corresponds to @citext@
237instance DBType (CI Lazy.Text) where
238 typeInformation = mapTypeInformation CI.mk CI.original typeInformation
239 { typeName = "citext"
240 }
243-- | Corresponds to @bytea@
244instance DBType ByteString where
245 typeInformation = TypeInformation
246 { encode = Opaleye.ConstExpr . Opaleye.ByteStringLit
247 , decode = Hasql.bytea
248 , typeName = "bytea"
249 }
252-- | Corresponds to @bytea@
253instance DBType Lazy.ByteString where
254 typeInformation =
255 mapTypeInformation ByteString.fromStrict ByteString.toStrict
256 typeInformation
259-- | Corresponds to @uuid@
260instance DBType UUID where
261 typeInformation = TypeInformation
262 { encode = Opaleye.ConstExpr . Opaleye.StringLit . UUID.toString
263 , decode = Hasql.uuid
264 , typeName = "uuid"
265 }
268-- | Corresponds to @jsonb@
269instance DBType Value where
270 typeInformation = TypeInformation
271 { encode =
272 Opaleye.ConstExpr . Opaleye.OtherLit .
273 Opaleye.quote .
274 Lazy.unpack . Lazy.decodeUtf8 . Aeson.encode
275 , decode = Hasql.jsonb
276 , typeName = "jsonb"
277 }
280instance Sql DBType a => DBType [a] where
281 typeInformation = listTypeInformation nullabilization typeInformation
284instance Sql DBType a => DBType (NonEmpty a) where
285 typeInformation = nonEmptyTypeInformation nullabilization typeInformation
288instance {-# OVERLAPPING #-} DBType Opaque where
289 typeInformation = error "opaque"
292instance {-# INCOHERENT #-} (HasNullability a, DBType (Unnullify a)) =>
293 Sql DBType a