chore(third_party/haskell): update pa packages r/6816

Change-Id: I8abcb479b0f5c0bd6ed1abc3c9618c2362ff835a
Reviewed-on: https://cl.tvl.fyi/c/depot/+/9740
Autosubmit: Profpatsch <mail@profpatsch.de>
Tested-by: BuildkiteCI
Reviewed-by: Profpatsch <mail@profpatsch.de>

2 files changed, 7 insertions, 8 deletions

diff --git a/users/Profpatsch/my-prelude/src/Tool.hs b/users/Profpatsch/my-prelude/src/Tool.hs
index 066f68bbe0..b773f4444e 100644
--- a/users/Profpatsch/my-prelude/src/Tool.hs
+++ b/users/Profpatsch/my-prelude/src/Tool.hs
@@ -31,12 +31,12 @@ readTools env toolParser =
       Exit.die [fmt|Please set {env.toolsEnvVar} to a directory with all tools we need (see `Tools` in the code).|]
     Just toolsDir ->
       (Posix.fileExist toolsDir & ifTrueOrErr () [fmt|{env.toolsEnvVar} directory does not exist: {toolsDir}|])
-        & thenValidate
+        & thenValidateM
           ( \() ->
               (Posix.getFileStatus toolsDir <&> Posix.isDirectory)
                 & ifTrueOrErr () [fmt|{env.toolsEnvVar} does not point to a directory: {toolsDir}|]
           )
-        & thenValidate
+        & thenValidateM
           (\() -> toolParser.unToolParser toolsDir)
         <&> first (errorTree [fmt|Could not find all tools in {env.toolsEnvVar}|])
         >>= \case
@@ -61,14 +61,14 @@ readTool exeName = ToolParserT $ \toolDir -> do
   let exec = True
   Posix.fileExist toolPath
     & ifTrueOrErr () [fmt|Tool does not exist: {toolPath}|]
-    & thenValidate
+    & thenValidateM
       ( \() ->
           Posix.fileAccess toolPath read' write exec
             & ifTrueOrErr (Tool {..}) [fmt|Tool is not readable/executable: {toolPath}|]
       )
 
 -- | helper
-ifTrueOrErr :: Functor f => a -> Text -> f Bool -> f (Validation (NonEmpty Error) a)
+ifTrueOrErr :: (Functor f) => a -> Text -> f Bool -> f (Validation (NonEmpty Error) a)
 ifTrueOrErr true err io =
   io <&> \case
     True -> Success true
diff --git a/users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs b/users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs
index 82b4911787..3b1dec9669 100644
--- a/users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs
+++ b/users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs
@@ -19,7 +19,6 @@ import Data.List.NonEmpty qualified as NonEmpty
 import Data.Map.Strict qualified as Map
 import Data.Pool (Pool)
 import Data.Pool qualified as Pool
-import Data.Scientific (Scientific)
 import Data.Text qualified as Text
 import Database.PostgreSQL.Simple (Binary (Binary), Only (..))
 import Database.PostgreSQL.Simple qualified as Postgres
@@ -364,7 +363,7 @@ getAndUpdateTransmissionTorrentsStatus knownTorrents = do
             )
             $ do
               torrentHash <- Json.keyLabel @"torrentHash" "hashString" Json.asText
-              percentDone <- Json.keyLabel @"percentDone" "percentDone" (Field.jsonParser $ Field.jsonNumber >>> scientificPercentage)
+              percentDone <- Json.keyLabel @"percentDone" "percentDone" (Field.toJsonParser $ Field.jsonNumber >>> scientificPercentage)
               pure (torrentHash, percentDone)
         )
         <&> Map.fromList
@@ -621,7 +620,7 @@ doTransmissionRequest span dat (req, parser) = do
               tag <-
                 Json.keyMay
                   "tag"
-                  (Field.jsonParser (Field.jsonNumber >>> Field.boundedScientificIntegral "tag too long"))
+                  (Field.toJsonParser (Field.jsonNumber >>> Field.boundedScientificIntegral "tag too long"))
               pure TransmissionResponse {..}
           )
         & first (Json.parseErrorTree "Cannot parse transmission RPC response")
@@ -747,7 +746,7 @@ redactedSearchAndInsert extraArguments = do
               Json.throwCustomError [fmt|Status was not "success", but {status}|]
             Json.key "response" $ do
               pages <-
-                Json.keyMay "pages" (Field.jsonParser (Field.mapError singleError $ Field.jsonNumber >>> Field.boundedScientificIntegral @Int "not an Integer" >>> Field.integralToNatural))
+                Json.keyMay "pages" (Field.toJsonParser (Field.mapError singleError $ Field.jsonNumber >>> Field.boundedScientificIntegral @Int "not an Integer" >>> Field.integralToNatural))
                   -- in case the field is missing, let’s assume there is only one page
                   <&> fromMaybe 1
               Json.key "results" $ do