d15fae7 · rel8 · git.iko.soy

git.iko.soy/rel8

Add an output function to TypeInformation

This allows DBType to be coerced.

commitd15fae73e592a2bdb6b5f49de5be2fb0718677c9 authorOllie Charles <ollie@ocharles.org.uk> dateTue 23 Mar 2021, 15:33 (6 years ago) parent8fefc24

6 files changed+56−30

compare with master

unifiedsplit

src/Rel8/Expr/Serialize.hs+3−3 src/Rel8/Type.hs+17 src/Rel8/Type/Array.hs+12−10 src/Rel8/Type/Array1D.hs+12−10 src/Rel8/Type/Information.hs+11−7 src/Rel8/Type/JSONBEncoded.hs+1

src/Rel8/Expr/Serialize.hs+3−3

@@ -42,6 +42,6 @@ slitExpr nullable info@TypeInformation {encode} =

4242

4343

4444sparseValue :: Nullability db a -> TypeInformation db -> Hasql.Row a

45−sparseValue nullability TypeInformation {decode} = case nullability of

46− Nullable -> Hasql.column $ Hasql.nullable decode

47− NonNullable -> Hasql.column $ Hasql.nonNullable decode

45+sparseValue nullability TypeInformation {decode, out} = case nullability of

46+ Nullable -> Hasql.column $ Hasql.nullable $ out <$> decode

47+ NonNullable -> Hasql.column $ Hasql.nonNullable $ out <$> decode

src/Rel8/Type.hs+17

@@ -71,6 +71,7 @@ instance DBType Bool where

7171 { encode = Opaleye.ConstExpr . Opaleye.BoolLit

7272 , decode = Hasql.bool

7373 , typeName = "bool"

74+ , out = id

7475 }

7576

7677

@@ -79,6 +80,7 @@ instance DBType Char where

7980 { encode = Opaleye.ConstExpr . Opaleye.StringLit . pure

8081 , decode = Hasql.char

8182 , typeName = "char"

83+ , out = id

8284 }

8385

8486

@@ -87,6 +89,7 @@ instance DBType Int16 where

8789 { encode = Opaleye.ConstExpr . Opaleye.IntegerLit . toInteger

8890 , decode = Hasql.int2

8991 , typeName = "int2"

92+ , out = id

9093 }

9194

9295

@@ -95,6 +98,7 @@ instance DBType Int32 where

9598 { encode = Opaleye.ConstExpr . Opaleye.IntegerLit . toInteger

9699 , decode = Hasql.int4

97100 , typeName = "int4"

101+ , out = id

98102 }

99103

100104

@@ -103,6 +107,7 @@ instance DBType Int64 where

103107 { encode = Opaleye.ConstExpr . Opaleye.IntegerLit . toInteger

104108 , decode = Hasql.int8

105109 , typeName = "int8"

110+ , out = id

106111 }

107112

108113

@@ -111,6 +116,7 @@ instance DBType Float where

111116 { encode = Opaleye.ConstExpr . Opaleye.NumericLit . realToFrac

112117 , decode = Hasql.float4

113118 , typeName = "float4"

119+ , out = id

114120 }

115121

116122

@@ -119,6 +125,7 @@ instance DBType Double where

119125 { encode = Opaleye.ConstExpr . Opaleye.NumericLit . realToFrac

120126 , decode = Hasql.float8

121127 , typeName = "float8"

128+ , out = id

122129 }

123130

124131

@@ -127,6 +134,7 @@ instance DBType Scientific where

127134 { encode = Opaleye.ConstExpr . Opaleye.NumericLit

128135 , decode = Hasql.numeric

129136 , typeName = "numeric"

137+ , out = id

130138 }

131139

132140

@@ -137,6 +145,7 @@ instance DBType UTCTime where

137145 formatTime defaultTimeLocale "'%FT%T%QZ'"

138146 , decode = Hasql.timestamptz

139147 , typeName = "timestamptz"

148+ , out = id

140149 }

141150

142151

@@ -147,6 +156,7 @@ instance DBType Day where

147156 formatTime defaultTimeLocale "'%F'"

148157 , decode = Hasql.date

149158 , typeName = "date"

159+ , out = id

150160 }

151161

152162

@@ -157,6 +167,7 @@ instance DBType LocalTime where

157167 formatTime defaultTimeLocale "'%FT%T%Q'"

158168 , decode = Hasql.timestamp

159169 , typeName = "timestamp"

170+ , out = id

160171 }

161172

162173

@@ -167,6 +178,7 @@ instance DBType TimeOfDay where

167178 formatTime defaultTimeLocale "'%T%Q'"

168179 , decode = Hasql.time

169180 , typeName = "time"

181+ , out = id

170182 }

171183

172184

@@ -177,6 +189,7 @@ instance DBType DiffTime where

177189 formatTime defaultTimeLocale "'%-6Es'"

178190 , decode = Hasql.interval

179191 , typeName = "interval"

192+ , out = id

180193 }

181194

182195

@@ -190,6 +203,7 @@ instance DBType Text where

190203 { encode = Opaleye.ConstExpr . Opaleye.StringLit . Text.unpack

191204 , decode = Hasql.text

192205 , typeName = "text"

206+ , out = id

193207 }

194208

195209

@@ -215,6 +229,7 @@ instance DBType ByteString where

215229 { encode = Opaleye.ConstExpr . Opaleye.ByteStringLit

216230 , decode = Hasql.bytea

217231 , typeName = "bytea"

232+ , out = id

218233 }

219234

220235

@@ -229,6 +244,7 @@ instance DBType UUID where

229244 { encode = Opaleye.ConstExpr . Opaleye.StringLit . UUID.toString

230245 , decode = Hasql.uuid

231246 , typeName = "uuid"

247+ , out = id

232248 }

233249

234250

@@ -240,6 +256,7 @@ instance DBType Value where

240256 Lazy.unpack . Lazy.decodeUtf8 . Aeson.encode

241257 , decode = Hasql.jsonb

242258 , typeName = "jsonb"

259+ , out = id

243260 }

244261

245262

src/Rel8/Type/Array.hs+12−10

@@ -38,17 +38,19 @@ listTypeInformation :: ()

3838 => Nullability a ma

3939 -> TypeInformation a

4040 -> TypeInformation [ma]

41−listTypeInformation nullability info = TypeInformation

42− { decode = row $ case nullability of

43− Nullable -> Hasql.listArray (Hasql.nullable decode)

44− NonNullable -> Hasql.listArray (Hasql.nonNullable decode)

45− , encode = case nullability of

46− Nullable -> array info . fmap (maybe null encode)

47− NonNullable -> array info . fmap encode

48− , typeName = "record"

49− }

41+listTypeInformation nullability info =

42+ case info of

43+ TypeInformation{ encode, decode, out } -> TypeInformation

44+ { decode = row $ case nullability of

45+ Nullable -> Hasql.listArray (Hasql.nullable (out <$> decode))

46+ NonNullable -> Hasql.listArray (Hasql.nonNullable (out <$> decode))

47+ , encode = case nullability of

48+ Nullable -> array info . fmap (maybe null encode)

49+ NonNullable -> array info . fmap encode

50+ , typeName = "record"

51+ , out = id

52+ }

5053 where

51− TypeInformation {encode, decode} = info

5254 row = Hasql.composite . Hasql.field . Hasql.nonNullable

5355 null = Opaleye.ConstExpr Opaleye.NullLit

5456

src/Rel8/Type/Array1D.hs+12−10

@@ -95,17 +95,19 @@ array1DTypeInformation :: IsArray1D db ~ 'False

9595 => Nullability db a

9696 -> TypeInformation db

9797 -> TypeInformation (Array1D a)

98−array1DTypeInformation nullability info = TypeInformation

99− { decode = case nullability of

100− Nullable -> Array1D <$> Hasql.listArray (Hasql.nullable decode)

101− NonNullable -> Array1D <$> Hasql.listArray (Hasql.nonNullable decode)

102− , encode = case nullability of

103− Nullable -> Opaleye.ArrayExpr . fmap (maybe null encode) . getArray1D

104− NonNullable -> Opaleye.ArrayExpr . fmap encode . getArray1D

105− , typeName = typeName <> "[]"

106− }

98+array1DTypeInformation nullability info =

99+ case info of

100+ TypeInformation{ encode, decode, typeName, out } -> TypeInformation

101+ { decode = case nullability of

102+ Nullable -> Array1D <$> Hasql.listArray (Hasql.nullable (out <$> decode))

103+ NonNullable -> Array1D <$> Hasql.listArray (Hasql.nonNullable (out <$> decode))

104+ , encode = case nullability of

105+ Nullable -> Opaleye.ArrayExpr . fmap (maybe null encode) . getArray1D

106+ NonNullable -> Opaleye.ArrayExpr . fmap encode . getArray1D

107+ , typeName = typeName <> "[]"

108+ , out = id

109+ }

107110 where

108− TypeInformation {encode, decode, typeName} = info

109111 null = Opaleye.ConstExpr Opaleye.NullLit

110112

111113

src/Rel8/Type/Information.hs+11−7

@@ -1,3 +1,4 @@

1+{-# language GADTs #-}

12{-# language NamedFieldPuns #-}

23{-# language StandaloneKindSignatures #-}

@@ -24,11 +25,13 @@ import qualified Data.Text as Text

2425

2526

2627type TypeInformation :: Type -> Type

27−data TypeInformation a = TypeInformation

28− { encode :: a -> Opaleye.PrimExpr

29− , decode :: Hasql.Value a

30− , typeName :: String

31− }

28+data TypeInformation a where

29+ TypeInformation ::

30+ { encode :: a -> Opaleye.PrimExpr

31+ , decode :: Hasql.Value x

32+ , typeName :: String

33+ , out :: x -> a

34+ } -> TypeInformation a

3235

3336

3437mapTypeInformation :: ()

@@ -40,9 +43,10 @@ mapTypeInformation = parseTypeInformation . fmap pure

4043parseTypeInformation :: ()

4144 => (a -> Either String b) -> (b -> a)

4245 -> TypeInformation a -> TypeInformation b

43−parseTypeInformation to from TypeInformation {encode, decode, typeName} =

46+parseTypeInformation to from TypeInformation {encode, decode, typeName, out} =

4447 TypeInformation

4548 { encode = encode . from

46− , decode = Hasql.refine (first Text.pack . to) decode

49+ , decode = Hasql.refine (first Text.pack . to) (out <$> decode)

4750 , typeName

51+ , out = id

4852 }

src/Rel8/Type/JSONBEncoded.hs+1

@@ -28,4 +28,5 @@ instance (FromJSON a, ToJSON a) => DBType (JSONBEncoded a) where

2828 { encode = encode typeInformation . toJSON . fromJSONBEncoded

2929 , decode = Hasql.refine (first pack . fmap JSONBEncoded . parseEither parseJSON) Hasql.jsonb

3030 , typeName = "jsonb"

31+ , out = id

3132 }