d15fae7 · rel8 · git.iko.soy

git.iko.soy/rel8

on master help sign in

Add an output function to TypeInformation

d15fae7Ollie Charles6 years ago

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

compare with master

unifiedsplit

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

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

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

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

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

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

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

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

src/Rel8/Type.hs+17

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

71 { encode = Opaleye.ConstExpr . Opaleye.BoolLit

72 , decode = Hasql.bool

73 , typeName = "bool"

74+ , out = id

74 }

75 }

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

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

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

80 , decode = Hasql.char

81 , decode = Hasql.char

81 , typeName = "char"

82 , typeName = "char"

83+ , out = id

82 }

84 }

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

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

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

88 , decode = Hasql.int2

90 , decode = Hasql.int2

89 , typeName = "int2"

91 , typeName = "int2"

92+ , out = id

90 }

93 }

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

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

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

96 , decode = Hasql.int4

99 , decode = Hasql.int4

97 , typeName = "int4"

100 , typeName = "int4"

101+ , out = id

98 }

102 }

103

100

104

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

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

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

104 , decode = Hasql.int8

108 , decode = Hasql.int8

105 , typeName = "int8"

109 , typeName = "int8"

110+ , out = id

106 }

111 }

107

112

108

113

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

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

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

112 , decode = Hasql.float4

117 , decode = Hasql.float4

113 , typeName = "float4"

118 , typeName = "float4"

119+ , out = id

114 }

120 }

115

121

116

122

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

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

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

120 , decode = Hasql.float8

126 , decode = Hasql.float8

121 , typeName = "float8"

127 , typeName = "float8"

128+ , out = id

122 }

129 }

123

130

124

131

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

127 { encode = Opaleye.ConstExpr . Opaleye.NumericLit

134 { encode = Opaleye.ConstExpr . Opaleye.NumericLit

128 , decode = Hasql.numeric

135 , decode = Hasql.numeric

129 , typeName = "numeric"

136 , typeName = "numeric"

137+ , out = id

130 }

138 }

131

139

132

140

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

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

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

138 , decode = Hasql.timestamptz

146 , decode = Hasql.timestamptz

139 , typeName = "timestamptz"

147 , typeName = "timestamptz"

148+ , out = id

140 }

149 }

141

150

142

151

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

147 formatTime defaultTimeLocale "'%F'"

156 formatTime defaultTimeLocale "'%F'"

148 , decode = Hasql.date

157 , decode = Hasql.date

149 , typeName = "date"

158 , typeName = "date"

159+ , out = id

150 }

160 }

151

161

152

162

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

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

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

158 , decode = Hasql.timestamp

168 , decode = Hasql.timestamp

159 , typeName = "timestamp"

169 , typeName = "timestamp"

170+ , out = id

160 }

171 }

161

172

162

173

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

167 formatTime defaultTimeLocale "'%T%Q'"

178 formatTime defaultTimeLocale "'%T%Q'"

168 , decode = Hasql.time

179 , decode = Hasql.time

169 , typeName = "time"

180 , typeName = "time"

181+ , out = id

170 }

182 }

171

183

172

184

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

177 formatTime defaultTimeLocale "'%-6Es'"

189 formatTime defaultTimeLocale "'%-6Es'"

178 , decode = Hasql.interval

190 , decode = Hasql.interval

179 , typeName = "interval"

191 , typeName = "interval"

192+ , out = id

180 }

193 }

181

194

182

195

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

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

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

191 , decode = Hasql.text

204 , decode = Hasql.text

192 , typeName = "text"

205 , typeName = "text"

206+ , out = id

193 }

207 }

194

208

195

209

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

215 { encode = Opaleye.ConstExpr . Opaleye.ByteStringLit

229 { encode = Opaleye.ConstExpr . Opaleye.ByteStringLit

216 , decode = Hasql.bytea

230 , decode = Hasql.bytea

217 , typeName = "bytea"

231 , typeName = "bytea"

232+ , out = id

218 }

233 }

219

234

220

235

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

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

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

230 , decode = Hasql.uuid

245 , decode = Hasql.uuid

231 , typeName = "uuid"

246 , typeName = "uuid"

247+ , out = id

232 }

248 }

233

249

234

250

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

240 Lazy.unpack . Lazy.decodeUtf8 . Aeson.encode

256 Lazy.unpack . Lazy.decodeUtf8 . Aeson.encode

241 , decode = Hasql.jsonb

257 , decode = Hasql.jsonb

242 , typeName = "jsonb"

258 , typeName = "jsonb"

259+ , out = id

243 }

260 }

244

261

245

262

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

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

38 => Nullability a ma

39 -> TypeInformation a

40 -> TypeInformation [ma]

41−listTypeInformation nullability info = TypeInformation

41+listTypeInformation nullability info =

42+ case info of

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

42− { decode = row $ case nullability of

44+ { decode = row $ case nullability of

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

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

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

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

45− , encode = case nullability of

47+ , encode = case nullability of

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

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

47− NonNullable -> array info . fmap encode

49+ NonNullable -> array info . fmap encode

48− , typeName = "record"

50+ , typeName = "record"

51+ , out = id

49− }

52+ }

50 where

53 where

51− TypeInformation {encode, decode} = info

52 row = Hasql.composite . Hasql.field . Hasql.nonNullable

54 row = Hasql.composite . Hasql.field . Hasql.nonNullable

53 null = Opaleye.ConstExpr Opaleye.NullLit

55 null = Opaleye.ConstExpr Opaleye.NullLit

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

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

95 => Nullability db a

96 -> TypeInformation db

97 -> TypeInformation (Array1D a)

98−array1DTypeInformation nullability info = TypeInformation

98+array1DTypeInformation nullability info =

99+ case info of

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

99− { decode = case nullability of

101+ { decode = case nullability of

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

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

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

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

102− , encode = case nullability of

104+ , encode = case nullability of

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

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

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

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

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

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

108+ , out = id

106− }

109+ }

107 where

110 where

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

109 null = Opaleye.ConstExpr Opaleye.NullLit

111 null = Opaleye.ConstExpr Opaleye.NullLit

110

112

111

113

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

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

1+{-# language GADTs #-}

1{-# language NamedFieldPuns #-}

2{-# language NamedFieldPuns #-}

2{-# language StandaloneKindSignatures #-}

3{-# language StandaloneKindSignatures #-}

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

26type TypeInformation :: Type -> Type

27type TypeInformation :: Type -> Type

27−data TypeInformation a = TypeInformation

28+data TypeInformation a where

29+ TypeInformation ::

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

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

29− , decode :: Hasql.Value a

31+ , decode :: Hasql.Value x

30− , typeName :: String

32+ , typeName :: String

31− }

33+ , out :: x -> a

34+ } -> TypeInformation a

34mapTypeInformation :: ()

37mapTypeInformation :: ()

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

40parseTypeInformation :: ()

43parseTypeInformation :: ()

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

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

42 -> TypeInformation a -> TypeInformation b

45 -> TypeInformation a -> TypeInformation b

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

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

44 TypeInformation

47 TypeInformation

45 { encode = encode . from

48 { encode = encode . from

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

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

47 , typeName

50 , typeName

51+ , out = id

48 }

52 }

src/Rel8/Type/JSONBEncoded.hs+1

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

28 { encode = encode typeInformation . toJSON . fromJSONBEncoded

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

30 , typeName = "jsonb"

31+ , out = id

31 }

32 }