1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
|
module Postgres.Decoder where
import Control.Applicative (Alternative)
import Data.Aeson qualified as Json
import Data.Aeson.BetterErrors qualified as Json
import Data.Error.Tree
import Data.Typeable (Typeable)
import Database.PostgreSQL.Simple (Binary (fromBinary))
import Database.PostgreSQL.Simple.FromField qualified as PG
import Database.PostgreSQL.Simple.FromRow qualified as PG
import FieldParser (FieldParser)
import FieldParser qualified as Field
import Json qualified
import Label
import PossehlAnalyticsPrelude
-- | A Decoder of postgres values. Allows embedding more complex parsers (like a 'Json.ParseT').
newtype Decoder a = Decoder (PG.RowParser a)
deriving newtype (Functor, Applicative, Alternative, Monad)
-- | Parse a `bytea` field, equivalent to @Binary ByteString@ but avoids the pitfall of having to use 'Binary'.
bytea :: Decoder ByteString
bytea = fromField @(Binary ByteString) <&> (.fromBinary)
-- | Parse a nullable `bytea` field, equivalent to @Binary ByteString@ but avoids the pitfall of having to use 'Binary'.
byteaMay :: Decoder (Maybe ByteString)
byteaMay = fromField @(Maybe (Binary ByteString)) <&> fmap (.fromBinary)
-- | Parse a `text` field.
text :: Decoder Text
text = fromField @Text
-- | Parse a nullable `text` field.
textMay :: Decoder (Maybe Text)
textMay = fromField @(Maybe Text)
-- | Parse a `text` field, and then use a 'FieldParser' to convert the result further.
textParse :: (Typeable to) => FieldParser Text to -> Decoder to
textParse = parse @Text
-- | Parse a nullable `text` field, and then use a 'FieldParser' to convert the result further.
textParseMay :: (Typeable to) => FieldParser Text to -> Decoder (Maybe to)
textParseMay = parseMay @Text
-- | Parse a type implementing 'FromField', and then use a 'FieldParser' to convert the result further.
parse ::
forall from to.
( PG.FromField from,
Typeable to
) =>
FieldParser from to ->
Decoder to
parse parser = Decoder $ PG.fieldWith $ \field bytes -> do
val <- PG.fromField @from field bytes
case Field.runFieldParser parser val of
Left err ->
PG.returnError
PG.ConversionFailed
field
(err & prettyError & textToString)
Right a -> pure a
-- | Parse a nullable type implementing 'FromField', and then use a 'FieldParser' to convert the result further.
parseMay ::
forall from to.
( PG.FromField from,
Typeable to
) =>
FieldParser from to ->
Decoder (Maybe to)
parseMay parser = Decoder $ PG.fieldWith $ \field bytes -> do
val <- PG.fromField @(Maybe from) field bytes
case Field.runFieldParser parser <$> val of
Nothing -> pure Nothing
Just (Left err) ->
PG.returnError
PG.ConversionFailed
field
(err & prettyError & textToString)
Just (Right a) -> pure (Just a)
-- | Turn any type that implements 'PG.fromField' into a 'Decoder'. Use type applications to prevent accidental conversions:
--
-- @
-- fromField @Text :: Decoder Text
-- @
fromField :: (PG.FromField a) => Decoder a
fromField = Decoder $ PG.fieldWith PG.fromField
-- | Turn any type that implements 'PG.fromField' into a 'Decoder' and wrap the result into the given 'Label'. Use type applications to prevent accidental conversions:
--
-- @
-- fromField @"myField" @Text :: Decoder (Label "myField" Text)
-- @
fromFieldLabel :: forall lbl a. (PG.FromField a) => Decoder (Label lbl a)
fromFieldLabel = label @lbl <$> fromField
-- | Parse fields out of a json value returned from the database.
--
-- ATTN: The whole json record has to be transferred before it is parsed,
-- so if you only need a tiny bit of it, use `->` and `->>` in your SQL statement
-- and return only the fields you need from the query.
--
-- In that case pay attention to NULL though:
--
-- @
-- SELECT '{"foo": {}}'::jsonb->>'foo' IS NULL
-- → TRUE
-- @
--
-- Also note: `->>` will coerce the json value to @text@, regardless of the content.
-- So the JSON object @{"foo": {}}"@ would be returned as the text: @"{\"foo\": {}}"@.
json :: (Typeable a) => Json.ParseT ErrorTree Identity a -> Decoder a
json parser = Decoder $ PG.fieldWith $ \field bytes -> do
val <- PG.fromField @Json.Value field bytes
case Json.parseValue parser val of
Left err ->
PG.returnError
PG.ConversionFailed
field
(err & Json.parseErrorTree "Cannot decode jsonb column" & prettyErrorTree & textToString)
Right a -> pure a
-- | Parse fields out of a nullable json value returned from the database.
--
-- ATTN: The whole json record has to be transferred before it is parsed,
-- so if you only need a tiny bit of it, use `->` and `->>` in your SQL statement
-- and return only the fields you need from the query.
--
-- In that case pay attention to NULL though:
--
-- @
-- SELECT '{"foo": {}}'::jsonb->>'foo' IS NULL
-- → TRUE
-- @
--
-- Also note: `->>` will coerce the json value to @text@, regardless of the content.
-- So the JSON object @{"foo": {}}"@ would be returned as the text: @"{\"foo\": {}}"@.
jsonMay :: (Typeable a) => Json.ParseT ErrorTree Identity a -> Decoder (Maybe a)
jsonMay parser = Decoder $ PG.fieldWith $ \field bytes -> do
val <- PG.fromField @(Maybe Json.Value) field bytes
case Json.parseValue parser <$> val of
Nothing -> pure Nothing
Just (Left err) ->
PG.returnError
PG.ConversionFailed
field
(err & Json.parseErrorTree "Cannot decode jsonb column" & prettyErrorTree & textToString)
Just (Right a) -> pure (Just a)
|
