maurice/snix
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

chore(users/Profpatsch): Update postgres module n stuff

Browse source 
Improvements from “upstream”, fresh served.

Change-Id: I60e02835730f6a65739eaa729f3e3eed1a0693e6
Reviewed-on: https://cl.tvl.fyi/c/depot/+/9025
Autosubmit: Profpatsch <mail@profpatsch.de>
Tested-by: BuildkiteCI
Reviewed-by: Profpatsch <mail@profpatsch.de>
This commit is contained in:
Profpatsch 2023-08-08 21:54:34 +02:00 • committed by clbot
parent fa8288823b
commit 33fa42a1a3
7 changed files with 443 additions and 197 deletions
Download patch file Download diff file Expand all files Collapse all files

36
users/Profpatsch/my-prelude/src/Postgres/Decoder.hs
View file

@ -5,6 +5,7 @@ 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 Json qualified
@ -15,6 +16,14 @@ import PossehlAnalyticsPrelude
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)
-- | Turn any type that implements 'PG.fromField' into a 'Decoder'. Use type applications to prevent accidental conversions:
--
-- @
@ -56,3 +65,30 @@ json parser = Decoder $ PG.fieldWith $ \field bytes -> do
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)