on fadfc3e help sign in
rel8/src/Rel8/Type.hs
272 lines 6.7 kB history raw
1{-# language FlexibleInstances #-}
2{-# language StandaloneKindSignatures #-}
3{-# language TypeApplications #-}
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.Opaque ( Opaque )
39import Rel8.Schema.Nullability ( Nullabilizes, nullabilization )
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 ( DiffTime, NominalDiffTime, UTCTime )
56import Data.Time.LocalTime ( LocalTime, TimeOfDay )
57import Data.Time.Format ( formatTime, defaultTimeLocale )
59-- uuid
60import Data.UUID ( UUID )
61import qualified Data.UUID as UUID
64type DBType :: Type -> Constraint
65class DBType a where
66 typeInformation :: TypeInformation a
69instance DBType Bool where
70 typeInformation = TypeInformation
71 { encode = Opaleye.ConstExpr . Opaleye.BoolLit
72 , decode = Hasql.bool
73 , typeName = "bool"
74 , out = id
75 }
78instance DBType Char where
79 typeInformation = TypeInformation
80 { encode = Opaleye.ConstExpr . Opaleye.StringLit . pure
81 , decode = Hasql.char
82 , typeName = "char"
83 , out = id
84 }
87instance DBType Int16 where
88 typeInformation = TypeInformation
89 { encode = Opaleye.ConstExpr . Opaleye.IntegerLit . toInteger
90 , decode = Hasql.int2
91 , typeName = "int2"
92 , out = id
93 }
96instance DBType Int32 where
97 typeInformation = TypeInformation
98 { encode = Opaleye.ConstExpr . Opaleye.IntegerLit . toInteger
99 , decode = Hasql.int4
100 , typeName = "int4"
101 , out = id
102 }
105instance DBType Int64 where
106 typeInformation = TypeInformation
107 { encode = Opaleye.ConstExpr . Opaleye.IntegerLit . toInteger
108 , decode = Hasql.int8
109 , typeName = "int8"
110 , out = id
111 }
114instance DBType Float where
115 typeInformation = TypeInformation
116 { encode = Opaleye.ConstExpr . Opaleye.NumericLit . realToFrac
117 , decode = Hasql.float4
118 , typeName = "float4"
119 , out = id
120 }
123instance DBType Double where
124 typeInformation = TypeInformation
125 { encode = Opaleye.ConstExpr . Opaleye.NumericLit . realToFrac
126 , decode = Hasql.float8
127 , typeName = "float8"
128 , out = id
129 }
132instance DBType Scientific where
133 typeInformation = TypeInformation
134 { encode = Opaleye.ConstExpr . Opaleye.NumericLit
135 , decode = Hasql.numeric
136 , typeName = "numeric"
137 , out = id
138 }
141instance DBType UTCTime where
142 typeInformation = TypeInformation
143 { encode =
144 Opaleye.ConstExpr . Opaleye.OtherLit .
145 formatTime defaultTimeLocale "'%FT%T%QZ'"
146 , decode = Hasql.timestamptz
147 , typeName = "timestamptz"
148 , out = id
149 }
152instance DBType Day where
153 typeInformation = TypeInformation
154 { encode =
155 Opaleye.ConstExpr . Opaleye.OtherLit .
156 formatTime defaultTimeLocale "'%F'"
157 , decode = Hasql.date
158 , typeName = "date"
159 , out = id
160 }
163instance DBType LocalTime where
164 typeInformation = TypeInformation
165 { encode =
166 Opaleye.ConstExpr . Opaleye.OtherLit .
167 formatTime defaultTimeLocale "'%FT%T%Q'"
168 , decode = Hasql.timestamp
169 , typeName = "timestamp"
170 , out = id
171 }
174instance DBType TimeOfDay where
175 typeInformation = TypeInformation
176 { encode =
177 Opaleye.ConstExpr . Opaleye.OtherLit .
178 formatTime defaultTimeLocale "'%T%Q'"
179 , decode = Hasql.time
180 , typeName = "time"
181 , out = id
182 }
185instance DBType DiffTime where
186 typeInformation = TypeInformation
187 { encode =
188 Opaleye.ConstExpr . Opaleye.OtherLit .
189 formatTime defaultTimeLocale "'%-6Es'"
190 , decode = Hasql.interval
191 , typeName = "interval"
192 , out = id
193 }
196instance DBType NominalDiffTime where
197 typeInformation =
198 mapTypeInformation @DiffTime realToFrac realToFrac typeInformation
201instance DBType Text where
202 typeInformation = TypeInformation
203 { encode = Opaleye.ConstExpr . Opaleye.StringLit . Text.unpack
204 , decode = Hasql.text
205 , typeName = "text"
206 , out = id
207 }
210instance DBType Lazy.Text where
211 typeInformation =
212 mapTypeInformation Text.fromStrict Text.toStrict typeInformation
215instance DBType (CI Text) where
216 typeInformation = mapTypeInformation CI.mk CI.original typeInformation
217 { typeName = "citext"
218 }
221instance DBType (CI Lazy.Text) where
222 typeInformation = mapTypeInformation CI.mk CI.original typeInformation
223 { typeName = "citext"
224 }
227instance DBType ByteString where
228 typeInformation = TypeInformation
229 { encode = Opaleye.ConstExpr . Opaleye.ByteStringLit
230 , decode = Hasql.bytea
231 , typeName = "bytea"
232 , out = id
233 }
236instance DBType Lazy.ByteString where
237 typeInformation =
238 mapTypeInformation ByteString.fromStrict ByteString.toStrict
239 typeInformation
242instance DBType UUID where
243 typeInformation = TypeInformation
244 { encode = Opaleye.ConstExpr . Opaleye.StringLit . UUID.toString
245 , decode = Hasql.uuid
246 , typeName = "uuid"
247 , out = id
248 }
251instance DBType Value where
252 typeInformation = TypeInformation
253 { encode =
254 Opaleye.ConstExpr . Opaleye.OtherLit .
255 Opaleye.quote .
256 Lazy.unpack . Lazy.decodeUtf8 . Aeson.encode
257 , decode = Hasql.jsonb
258 , typeName = "jsonb"
259 , out = id
260 }
263instance (DBType db, Nullabilizes db a) => DBType [a] where
264 typeInformation = listTypeInformation nullabilization typeInformation
267instance (DBType db, Nullabilizes db a) => DBType (NonEmpty a) where
268 typeInformation = nonEmptyTypeInformation nullabilization typeInformation
271instance {-# OVERLAPPING #-} DBType Opaque where
272 typeInformation = error "opaque"