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

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>

1 files changed, 36 insertions, 0 deletions

diff --git a/users/Profpatsch/my-prelude/src/Postgres/Decoder.hs b/users/Profpatsch/my-prelude/src/Postgres/Decoder.hs
index 2e7fcb8779ed..008b89b4ba3d 100644
--- a/users/Profpatsch/my-prelude/src/Postgres/Decoder.hs
+++ b/users/Profpatsch/my-prelude/src/Postgres/Decoder.hs
@@ -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)