git.iko.soy/rel8
on 06f67cf help sign in
rel8/src/Rel8/Type.hs
255 lines 6.4 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 }
77instance DBType Char where
78 typeInformation = TypeInformation
79 { encode = Opaleye.ConstExpr . Opaleye.StringLit . pure
80 , decode = Hasql.char
81 , typeName = "char"
82 }
85instance DBType Int16 where
86 typeInformation = TypeInformation
87 { encode = Opaleye.ConstExpr . Opaleye.IntegerLit . toInteger
88 , decode = Hasql.int2
89 , typeName = "int2"
90 }
93instance DBType Int32 where
94 typeInformation = TypeInformation
95 { encode = Opaleye.ConstExpr . Opaleye.IntegerLit . toInteger
96 , decode = Hasql.int4
97 , typeName = "int4"
98 }
101instance DBType Int64 where
102 typeInformation = TypeInformation
103 { encode = Opaleye.ConstExpr . Opaleye.IntegerLit . toInteger
104 , decode = Hasql.int8
105 , typeName = "int8"
106 }
109instance DBType Float where
110 typeInformation = TypeInformation
111 { encode = Opaleye.ConstExpr . Opaleye.NumericLit . realToFrac
112 , decode = Hasql.float4
113 , typeName = "float4"
114 }
117instance DBType Double where
118 typeInformation = TypeInformation
119 { encode = Opaleye.ConstExpr . Opaleye.NumericLit . realToFrac
120 , decode = Hasql.float8
121 , typeName = "float8"
122 }
125instance DBType Scientific where
126 typeInformation = TypeInformation
127 { encode = Opaleye.ConstExpr . Opaleye.NumericLit
128 , decode = Hasql.numeric
129 , typeName = "numeric"
130 }
133instance DBType UTCTime where
134 typeInformation = TypeInformation
135 { encode =
136 Opaleye.ConstExpr . Opaleye.OtherLit .
137 formatTime defaultTimeLocale "'%FT%T%QZ'"
138 , decode = Hasql.timestamptz
139 , typeName = "timestamptz"
140 }
143instance DBType Day where
144 typeInformation = TypeInformation
145 { encode =
146 Opaleye.ConstExpr . Opaleye.OtherLit .
147 formatTime defaultTimeLocale "'%F'"
148 , decode = Hasql.date
149 , typeName = "date"
150 }
153instance DBType LocalTime where
154 typeInformation = TypeInformation
155 { encode =
156 Opaleye.ConstExpr . Opaleye.OtherLit .
157 formatTime defaultTimeLocale "'%FT%T%Q'"
158 , decode = Hasql.timestamp
159 , typeName = "timestamp"
160 }
163instance DBType TimeOfDay where
164 typeInformation = TypeInformation
165 { encode =
166 Opaleye.ConstExpr . Opaleye.OtherLit .
167 formatTime defaultTimeLocale "'%T%Q'"
168 , decode = Hasql.time
169 , typeName = "time"
170 }
173instance DBType DiffTime where
174 typeInformation = TypeInformation
175 { encode =
176 Opaleye.ConstExpr . Opaleye.OtherLit .
177 formatTime defaultTimeLocale "'%-6Es'"
178 , decode = Hasql.interval
179 , typeName = "interval"
180 }
183instance DBType NominalDiffTime where
184 typeInformation =
185 mapTypeInformation @DiffTime realToFrac realToFrac typeInformation
188instance DBType Text where
189 typeInformation = TypeInformation
190 { encode = Opaleye.ConstExpr . Opaleye.StringLit . Text.unpack
191 , decode = Hasql.text
192 , typeName = "text"
193 }
196instance DBType Lazy.Text where
197 typeInformation =
198 mapTypeInformation Text.fromStrict Text.toStrict typeInformation
201instance DBType (CI Text) where
202 typeInformation = mapTypeInformation CI.mk CI.original typeInformation
203 { typeName = "citext"
204 }
207instance DBType (CI Lazy.Text) where
208 typeInformation = mapTypeInformation CI.mk CI.original typeInformation
209 { typeName = "citext"
210 }
213instance DBType ByteString where
214 typeInformation = TypeInformation
215 { encode = Opaleye.ConstExpr . Opaleye.ByteStringLit
216 , decode = Hasql.bytea
217 , typeName = "bytea"
218 }
221instance DBType Lazy.ByteString where
222 typeInformation =
223 mapTypeInformation ByteString.fromStrict ByteString.toStrict
224 typeInformation
227instance DBType UUID where
228 typeInformation = TypeInformation
229 { encode = Opaleye.ConstExpr . Opaleye.StringLit . UUID.toString
230 , decode = Hasql.uuid
231 , typeName = "uuid"
232 }
235instance DBType Value where
236 typeInformation = TypeInformation
237 { encode =
238 Opaleye.ConstExpr . Opaleye.OtherLit .
239 Opaleye.quote .
240 Lazy.unpack . Lazy.decodeUtf8 . Aeson.encode
241 , decode = Hasql.jsonb
242 , typeName = "jsonb"
243 }
246instance (DBType db, Nullabilizes db a) => DBType [a] where
247 typeInformation = listTypeInformation nullabilization typeInformation
250instance (DBType db, Nullabilizes db a) => DBType (NonEmpty a) where
251 typeInformation = nonEmptyTypeInformation nullabilization typeInformation
254instance {-# OVERLAPPING #-} DBType Opaque where
255 typeInformation = error "opaque"