diff options
| -rw-r--r-- | third_party/overlays/haskell/default.nix | 6 | ||||
| -rw-r--r-- | third_party/overlays/haskell/extra-pkgs/pa-field-parser.nix (renamed from third_party/overlays/haskell/extra-pkgs/pa-field-parser-0.1.0.1.nix) | 8 | ||||
| -rw-r--r-- | third_party/overlays/haskell/extra-pkgs/pa-json.nix (renamed from third_party/overlays/haskell/extra-pkgs/pa-json-0.2.1.0.nix) | 10 | ||||
| -rw-r--r-- | third_party/overlays/haskell/extra-pkgs/pa-prelude.nix (renamed from third_party/overlays/haskell/extra-pkgs/pa-prelude-0.1.0.0.nix) | 10 | ||||
| -rw-r--r-- | users/Profpatsch/my-prelude/src/Tool.hs | 8 | ||||
| -rw-r--r-- | users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs | 7 |
6 files changed, 28 insertions, 21 deletions
diff --git a/third_party/overlays/haskell/default.nix b/third_party/overlays/haskell/default.nix index 9841631e73d4..614fc26d5606 100644 --- a/third_party/overlays/haskell/default.nix +++ b/third_party/overlays/haskell/default.nix @@ -44,12 +44,12 @@ in dhall = dhall-source "dhall" hsSuper.dhall; dhall-nix = dhall-source "dhall-nix" hsSuper.dhall-nix; - pa-prelude = hsSelf.callPackage ./extra-pkgs/pa-prelude-0.1.0.0.nix { }; + pa-prelude = hsSelf.callPackage ./extra-pkgs/pa-prelude.nix { }; pa-error-tree = hsSelf.callPackage ./extra-pkgs/pa-error-tree-0.1.0.0.nix { }; - pa-field-parser = hsSelf.callPackage ./extra-pkgs/pa-field-parser-0.1.0.1.nix { }; + pa-field-parser = hsSelf.callPackage ./extra-pkgs/pa-field-parser.nix { }; pa-label = hsSelf.callPackage ./extra-pkgs/pa-label-0.1.0.1.nix { }; pa-pretty = hsSelf.callPackage ./extra-pkgs/pa-pretty-0.1.1.0.nix { }; - pa-json = hsSelf.callPackage ./extra-pkgs/pa-json-0.2.1.0.nix { }; + pa-json = hsSelf.callPackage ./extra-pkgs/pa-json.nix { }; pa-run-command = hsSelf.callPackage ./extra-pkgs/pa-run-command-0.1.0.0.nix { }; }; }; diff --git a/third_party/overlays/haskell/extra-pkgs/pa-field-parser-0.1.0.1.nix b/third_party/overlays/haskell/extra-pkgs/pa-field-parser.nix index b327340d349a..a3c146ee098b 100644 --- a/third_party/overlays/haskell/extra-pkgs/pa-field-parser-0.1.0.1.nix +++ b/third_party/overlays/haskell/extra-pkgs/pa-field-parser.nix @@ -10,12 +10,14 @@ , pa-prelude , scientific , semigroupoids +, template-haskell , text +, time }: mkDerivation { pname = "pa-field-parser"; - version = "0.1.0.1"; - sha256 = "e7fd0369898b6993e6e2aaab43e7cc84d173dc2d21eadca1884d2e7a780ad71f"; + version = "0.3.0.0"; + sha256 = "528c2b6bf5ad6454861b059c7eb6924f4c32bcb5b8faa4c2389d9ddfd92fcd57"; libraryHaskellDepends = [ aeson aeson-better-errors @@ -27,7 +29,9 @@ mkDerivation { pa-prelude scientific semigroupoids + template-haskell text + time ]; homepage = "https://github.com/possehl-analytics/pa-hackage"; description = "“Vertical” parsing of values"; diff --git a/third_party/overlays/haskell/extra-pkgs/pa-json-0.2.1.0.nix b/third_party/overlays/haskell/extra-pkgs/pa-json.nix index 4beeba32fe61..8ce838b22ccc 100644 --- a/third_party/overlays/haskell/extra-pkgs/pa-json-0.2.1.0.nix +++ b/third_party/overlays/haskell/extra-pkgs/pa-json.nix @@ -6,10 +6,9 @@ , base64-bytestring , bytestring , containers -, hspec-core -, hspec-expectations , lib , pa-error-tree +, pa-field-parser , pa-label , pa-prelude , scientific @@ -19,8 +18,8 @@ }: mkDerivation { pname = "pa-json"; - version = "0.2.1.0"; - sha256 = "d0c274fa38c05d38e9c2c15ee9dd4ff3ac369650dbc918c973863457110646c8"; + version = "0.3.0.0"; + sha256 = "45e79765e57e21400f3f3b1e86094473fac61d298618d7e34f6cad4988d8923b"; libraryHaskellDepends = [ aeson aeson-better-errors @@ -29,9 +28,8 @@ mkDerivation { base64-bytestring bytestring containers - hspec-core - hspec-expectations pa-error-tree + pa-field-parser pa-label pa-prelude scientific diff --git a/third_party/overlays/haskell/extra-pkgs/pa-prelude-0.1.0.0.nix b/third_party/overlays/haskell/extra-pkgs/pa-prelude.nix index 765ed31ba6c3..17e1996ab602 100644 --- a/third_party/overlays/haskell/extra-pkgs/pa-prelude-0.1.0.0.nix +++ b/third_party/overlays/haskell/extra-pkgs/pa-prelude.nix @@ -8,15 +8,18 @@ , mtl , profunctors , PyF +, scientific , semigroupoids +, template-haskell , text , these , validation-selective +, vector }: mkDerivation { pname = "pa-prelude"; - version = "0.1.0.0"; - sha256 = "554556e3acbf7154131ed05209d803a19d6aa1c7d675fcb10501de50869c49ab"; + version = "0.2.0.0"; + sha256 = "68015f7c19e9c618fc04e2516baccfce52af24efb9ca1480162c9ea0aef7f301"; libraryHaskellDepends = [ base bytestring @@ -26,10 +29,13 @@ mkDerivation { mtl profunctors PyF + scientific semigroupoids + template-haskell text these validation-selective + vector ]; homepage = "https://github.com/possehl-analytics/pa-hackage"; description = "The Possehl Analytics Prelude"; diff --git a/users/Profpatsch/my-prelude/src/Tool.hs b/users/Profpatsch/my-prelude/src/Tool.hs index 066f68bbe0df..b773f4444e87 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 82b49117874c..3b1dec9669f4 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 |