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

fix(users/Profpatsch/whatcd-resolver): reduce json data from db

Browse source 
We’d transfer the full json data for each torrent from the db instead
of just the 2 or 3 fields we need.

Adds some more helpers for parsing database values.

Adds some better logging events & traces.

Change-Id: I5db386c4ea247febf5f9fc3815da2e7f11286d41
Reviewed-on: https://cl.tvl.fyi/c/depot/+/12140
Tested-by: BuildkiteCI
Reviewed-by: Profpatsch <mail@profpatsch.de>
This commit is contained in:
Profpatsch 2024-08-06 11:46:33 +02:00
parent 13d79e04d8
commit f9703a9af5
4 changed files with 104 additions and 20 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -8,6 +8,8 @@ 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
@ -24,12 +26,65 @@ bytea = fromField @(Binary ByteString) <&> (.fromBinary)
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 :: (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:
@ -37,7 +92,7 @@ fromField = Decoder $ PG.fieldWith PG.fromField
-- @
-- fromField @"myField" @Text :: Decoder (Label "myField" Text)
-- @
fromFieldLabel :: forall lbl a. PG.FromField a => Decoder (Label lbl a)
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.
@ -55,7 +110,7 @@ fromFieldLabel = label @lbl <$> fromField
--
-- 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 :: (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
@ -81,7 +136,7 @@ json parser = Decoder $ PG.fieldWith $ \field bytes -> do
--
-- 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 :: (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