diff --git a/documentation/ErrorCodes.md b/documentation/ErrorCodes.md index 5f2e1b1..e4da212 100644 --- a/documentation/ErrorCodes.md +++ b/documentation/ErrorCodes.md @@ -3,7 +3,7 @@ A list of `replica` error codes: | Error Code | Meaning | -|:----------:|:--------| +| :---------: | :------ | | 0 | Success | | 1 to 127 | Number of failing tests (wrong expectation or test error) | | 128 | More than 127 failing tests | diff --git a/documentation/TestSpecification.md b/documentation/TestSpecification.md index 22258c4..c9e95f0 100644 --- a/documentation/TestSpecification.md +++ b/documentation/TestSpecification.md @@ -19,24 +19,23 @@ Here is the list of available fields: | Field name | JSON Type | Dhall Type | Mandatory | Default | Description | | :--------- | --------- | ---------- | :-------: | ------- | ----------- | -| `description` | String | Optional Text | | Use when you display text info | -| `command` | String | Text | Yes | | The tested command. | -| `workingDir` | String | Optional Text | No | `.` | The directory where the test is executed | +| `description` | String | Optional Text | No | | Use when you display text info | +| `command` | String | Text | Yes | | The tested command. | +| `workingDir` | String | Optional Text | No | `.` | The directory where the test is executed | | `beforeTest` | Array String | List Text | No | `[]` | A list of command to execute before the test.
It is ran in a separated shell and thus you can't declare environment variables needed for the test here. | | `afterTest` | Array String | List Text | No | `[]` | A list of command to execute after the test.
It is ran in a separated shell and thus you can't access the environment variables declared in the test here. | | `input` | String | Optional Text | No | | Text that is sent to the test command as standard input | -| `require` | Array String | List Text | No | `[]` | A list of tests that must succeed before this one can be triggered +| `require` | Array String | List Text | No | `[]` | A list of tests that must succeed before this one can be triggered | | `tags` | Array String | List Text | No | `[]` | Used to classify tests | | `pending` | Boolean | Bool | No | `False` | Pending tests won't be executed | | `succeed` | Boolean | Optional Bool | No | | If set, REPLica will check the value returned by the command | | `spaceSensitive` | Boolean | Bool | No | `True` | If set, the spaces are normalized before comparing the given and expected output: each chunk of space-like character are replaced by a single space and empty-lines are not considered | | `stdOut` | Anything but an integer | Optional Expectation | No | True | set the expectation for `stdOut`, see [Expectation](#expectation) | | `stdErr` | Anything but an integer | Optional Expectation | No | False | set the expectation for `stdErr`, see [Expectation](#expectation) | -| `files` | Object | Map Text Expectation | No | | List the files to check, and set the -corresponding expectation, see [Expectation](#expectation) | +| `files` | Object | Map Text Expectation | No | | List the files to check, and set the corresponding expectation, see [Expectation](#expectation) | -The default value are infered in JSON. +The default value are inferred in JSON. In Dhall, you need to use `Replica.Test` a schema that populate a test record with the default values. @@ -48,7 +47,7 @@ which respectively set the `succeed` value to `Some True` and `Some False`. By default the behaviour of REPLica is to wait for a golden value for `stdOut` to be saved -(generaly thanks to `replica run --interactive`) +(generally thanks to `replica run --interactive`) and then to compare the output of the next runs with this _golden value_. However, users may wants to inline their own expectations directly in the test. @@ -58,7 +57,7 @@ The semantic of an `expectation` depends on the type of its value. ### JSON -There is three types of values that are supported for expactations: +There is three types of values that are supported for expectations: - **Booleans.** If true, use a golden value. If false, explicitly skip this source. @@ -71,7 +70,7 @@ There is three types of values that are supported for expactations: the result of the command must contain each member of the array. If `spaceSensitive` is set to false, both the output and the expectations are normalized before comparison. -- **An object**: allow the defitinion of several requirements that must all be satisfied. +- **An object**: allow the definition of several requirements that must all be satisfied. The recognised fields are: - `generated`: A boolean that indicates whether or not we use a golden value @@ -85,7 +84,7 @@ There is three types of values that are supported for expactations: ### Dhall -The corresponding specification in dhall is the following: +The corresponding specification in Dhall is the following: ```dhall let Replica.Expectation diff --git a/flake.lock b/flake.lock index c3677a8..47f5b30 100644 --- a/flake.lock +++ b/flake.lock @@ -3,11 +3,11 @@ "flake-compat": { "flake": false, "locked": { - "lastModified": 1696426674, - "narHash": "sha256-kvjfFW7WAETZlt09AgDn1MrtKzP7t90Vf7vypd3OL1U=", + "lastModified": 1761588595, + "narHash": "sha256-XKUZz9zewJNUj46b4AJdiRZJAvSZ0Dqj2BNfXvFlJC4=", "owner": "edolstra", "repo": "flake-compat", - "rev": "0f9255e01c2351cc7d116c072cb317785dd33b33", + "rev": "f387cd2afec9419c8ee37694406ca490c3f34ee5", "type": "github" }, "original": { @@ -21,11 +21,11 @@ "systems": "systems" }, "locked": { - "lastModified": 1705309234, - "narHash": "sha256-uNRRNRKmJyCRC/8y1RqBkqWBLM034y4qN7EprSdmgyA=", + "lastModified": 1731533236, + "narHash": "sha256-l0KFg5HjrsfsO/JpG+r7fRrqm12kzFHyUHqHCVpMMbI=", "owner": "numtide", "repo": "flake-utils", - "rev": "1ef2e671c3b0c19053962c07dbda38332dcebf26", + "rev": "11707dc2f618dd54ca8739b309ec4fc024de578b", "type": "github" }, "original": { @@ -39,26 +39,11 @@ "systems": "systems_2" }, "locked": { - "lastModified": 1701680307, - "narHash": "sha256-kAuep2h5ajznlPMD9rnQyffWG8EM/C73lejGofXvdM8=", - "owner": "numtide", - "repo": "flake-utils", - "rev": "4022d587cbbfd70fe950c1e2083a02621806a725", - "type": "github" - }, - "original": { - "owner": "numtide", - "repo": "flake-utils", - "type": "github" - } - }, - "flake-utils_3": { - "locked": { - "lastModified": 1667395993, - "narHash": "sha256-nuEHfE/LcWyuSWnS8t12N1wc105Qtau+/OdUAjtQ0rA=", + "lastModified": 1705309234, + "narHash": "sha256-uNRRNRKmJyCRC/8y1RqBkqWBLM034y4qN7EprSdmgyA=", "owner": "numtide", "repo": "flake-utils", - "rev": "5aed5285a952e0b949eb3ba02c12fa4fcfef535f", + "rev": "1ef2e671c3b0c19053962c07dbda38332dcebf26", "type": "github" }, "original": { @@ -75,11 +60,11 @@ ] }, "locked": { - "lastModified": 1703887061, - "narHash": "sha256-gGPa9qWNc6eCXT/+Z5/zMkyYOuRZqeFZBDbopNZQkuY=", + "lastModified": 1709087332, + "narHash": "sha256-HG2cCnktfHsKV0s4XW83gU3F57gaTljL9KNSuG6bnQs=", "owner": "hercules-ci", "repo": "gitignore.nix", - "rev": "43e1aa1308018f37118e34d3a9cb4f5e75dc11d5", + "rev": "637db329424fd7e46cf4185293b9cc8c88c95394", "type": "github" }, "original": { @@ -99,11 +84,11 @@ ] }, "locked": { - "lastModified": 1708006606, - "narHash": "sha256-UyhP0NsunLq+NIYzEgVRjXuXhTPpQYFwqGL65rPa3qw=", + "lastModified": 1765964722, + "narHash": "sha256-NBXSDN9oNXP7Q3SWocvMXdwQP+pAEOBnHLA0dBqnjVY=", "owner": "idris-lang", "repo": "Idris2", - "rev": "034f1e89c4c58cdd59aabe2b0d0fe4e9ff3411f6", + "rev": "0e9b01d0400593fa99b320c56f6e77406a4eb968", "type": "github" }, "original": { @@ -115,26 +100,26 @@ "idris-emacs-src": { "flake": false, "locked": { - "lastModified": 1666078909, - "narHash": "sha256-oYNHFIpcrFfPb4sXJwEBFKeH+PB4AGCrAFrfBrSTCeo=", - "owner": "redfish64", + "lastModified": 1734683778, + "narHash": "sha256-8SIseFPHpdDO0uG3u65xJ0CHNfVu5O36meONZI7oorw=", + "owner": "idris-community", "repo": "idris2-mode", - "rev": "3bcb52a65c488f31c99d20f235f6050418a84c9d", + "rev": "5b4513692124de34aac13985bf48f756d9a8248f", "type": "github" }, "original": { - "owner": "redfish64", + "owner": "idris-community", "repo": "idris2-mode", "type": "github" } }, "nixpkgs": { "locked": { - "lastModified": 1708247094, - "narHash": "sha256-H2VS7VwesetGDtIaaz4AMsRkPoSLEVzL/Ika8gnbUnE=", + "lastModified": 1766125104, + "narHash": "sha256-l/YGrEpLromL4viUo5GmFH3K5M1j0Mb9O+LiaeCPWEM=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "045b51a3ae66f673ed44b5bbd1f4a341d96703bf", + "rev": "7d853e518814cca2a657b72eeba67ae20ebf7059", "type": "github" }, "original": { @@ -142,29 +127,13 @@ "type": "indirect" } }, - "nixpkgs-stable": { - "locked": { - "lastModified": 1704874635, - "narHash": "sha256-YWuCrtsty5vVZvu+7BchAxmcYzTMfolSPP5io8+WYCg=", - "owner": "NixOS", - "repo": "nixpkgs", - "rev": "3dc440faeee9e889fe2d1b4d25ad0f430d449356", - "type": "github" - }, - "original": { - "owner": "NixOS", - "ref": "nixos-23.11", - "repo": "nixpkgs", - "type": "github" - } - }, "nixpkgs_2": { "locked": { - "lastModified": 1704842529, - "narHash": "sha256-OTeQA+F8d/Evad33JMfuXC89VMetQbsU4qcaePchGr4=", + "lastModified": 1764947035, + "narHash": "sha256-EYHSjVM4Ox4lvCXUMiKKs2vETUSL5mx+J2FfutM7T9w=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "eabe8d3eface69f5bb16c18f8662a702f50c20d5", + "rev": "a672be65651c80d3f592a89b3945466584a22069", "type": "github" }, "original": { @@ -176,11 +145,11 @@ }, "nixpkgs_3": { "locked": { - "lastModified": 1672428209, - "narHash": "sha256-eejhqkDz2cb2vc5VeaWphJz8UXNuoNoM8/Op8eWv2tQ=", + "lastModified": 1708247094, + "narHash": "sha256-H2VS7VwesetGDtIaaz4AMsRkPoSLEVzL/Ika8gnbUnE=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "293a28df6d7ff3dec1e61e37cc4ee6e6c0fb0847", + "rev": "045b51a3ae66f673ed44b5bbd1f4a341d96703bf", "type": "github" }, "original": { @@ -188,38 +157,18 @@ "type": "indirect" } }, - "papers": { - "flake": false, - "locked": { - "dir": "libs/papers", - "lastModified": 1708006606, - "narHash": "sha256-UyhP0NsunLq+NIYzEgVRjXuXhTPpQYFwqGL65rPa3qw=", - "owner": "idris-lang", - "repo": "Idris2", - "rev": "034f1e89c4c58cdd59aabe2b0d0fe4e9ff3411f6", - "type": "github" - }, - "original": { - "dir": "libs/papers", - "owner": "idris-lang", - "repo": "Idris2", - "type": "github" - } - }, "pre-commit-hooks": { "inputs": { "flake-compat": "flake-compat", - "flake-utils": "flake-utils_2", "gitignore": "gitignore", - "nixpkgs": "nixpkgs_2", - "nixpkgs-stable": "nixpkgs-stable" + "nixpkgs": "nixpkgs_2" }, "locked": { - "lastModified": 1708018599, - "narHash": "sha256-M+Ng6+SePmA8g06CmUZWi1AjG2tFBX9WCXElBHEKnyM=", + "lastModified": 1765911976, + "narHash": "sha256-t3T/xm8zstHRLx+pIHxVpQTiySbKqcQbK+r+01XVKc0=", "owner": "cachix", "repo": "pre-commit-hooks.nix", - "rev": "5df5a70ad7575f6601d91f0efec95dd9bc619431", + "rev": "b68b780b69702a090c8bb1b973bab13756cc7a27", "type": "github" }, "original": { @@ -230,15 +179,15 @@ }, "replicadhall": { "inputs": { - "flake-utils": "flake-utils_3", + "flake-utils": "flake-utils_2", "nixpkgs": "nixpkgs_3" }, "locked": { - "lastModified": 1673631378, - "narHash": "sha256-b4PO6un9kCx736oxSxmZHEmai9YrhGY70xQUX9sTe9s=", + "lastModified": 1765888424, + "narHash": "sha256-BQaB5jEc1glmAMwmIsd3X1vffwEW3rLfKNXtoS7/fN8=", "owner": "ReplicaTest", "repo": "replica-dhall", - "rev": "38430dd1485cc787532a3ebd19dce3ce2d059bcc", + "rev": "bc9dab8bc42facf946513fc370d96d8beceeda84", "type": "github" }, "original": { @@ -252,7 +201,6 @@ "flake-utils": "flake-utils", "idris": "idris", "nixpkgs": "nixpkgs", - "papers": "papers", "pre-commit-hooks": "pre-commit-hooks", "replicadhall": "replicadhall" } diff --git a/flake.nix b/flake.nix index e54bb6b..c0d1461 100644 --- a/flake.nix +++ b/flake.nix @@ -2,20 +2,16 @@ description = "Golden tests for command-line interfaces."; inputs = { - flake-utils.url = github:numtide/flake-utils; + flake-utils.url = "github:numtide/flake-utils"; idris = { url = "github:idris-lang/Idris2"; inputs.nixpkgs.follows = "nixpkgs"; inputs.flake-utils.follows = "flake-utils"; }; - papers = { - url = "github:idris-lang/Idris2?dir=libs/papers"; - flake = false; - }; pre-commit-hooks.url = "github:cachix/pre-commit-hooks.nix"; replicadhall.url = "github:ReplicaTest/replica-dhall"; }; - outputs = { self, nixpkgs, idris, papers, flake-utils, pre-commit-hooks, replicadhall }: + outputs = { self, nixpkgs, idris, flake-utils, pre-commit-hooks, replicadhall }: flake-utils.lib.eachDefaultSystem (system: let npkgs = import nixpkgs { inherit system; }; @@ -27,14 +23,12 @@ dhall-json; version = import ./version.nix; - idrisPkgs = papers; callPackage = lib.callPackageWith (npkgs // packages); packages = { inherit version; buildIdris = idris.buildIdris.${system}; - papersLib = callPackage ./nix/papersLib.nix { inherit papers; }; replica_dhall = replicadhall.packages.${system}.default; buildReplica = callPackage ./nix/buildReplica.nix { }; replica = callPackage ./nix/replica.nix { }; @@ -43,9 +37,7 @@ inherit (packages) replica - replicaTest - replica_dhall - papersLib; + replicaTest; dockerImage = npkgs.dockerTools.buildImage { name = "replica"; @@ -77,7 +69,7 @@ }; devShells.default = npkgs.mkShell { - packages = [ idris2 papersLib npkgs.rlwrap dhall dhall-json ]; + packages = [ idris2 npkgs.rlwrap dhall dhall-json ]; shellHook = '' alias idris2="rlwrap -s 1000 idris2 --no-banner" ${self.checks.${system}.pre-commit-check.shellHook} diff --git a/nix/buildReplica.nix b/nix/buildReplica.nix index bc790ae..6c27da9 100644 --- a/nix/buildReplica.nix +++ b/nix/buildReplica.nix @@ -1,6 +1,6 @@ -{ buildIdris, papersLib }: +{ buildIdris }: buildIdris { ipkgName = "replica"; src = ../.; - idrisLibraries = [ papersLib ]; + idrisLibraries = [ ]; } diff --git a/nix/online-tests.nix b/nix/online-tests.nix index b462632..a9a6469 100644 --- a/nix/online-tests.nix +++ b/nix/online-tests.nix @@ -11,5 +11,5 @@ make test RUN="-t online" ''; pass_filenames = false; - stages = [ "push" ]; + stages = [ "pre-push" ]; } diff --git a/nix/papersLib.nix b/nix/papersLib.nix deleted file mode 100644 index c0b387f..0000000 --- a/nix/papersLib.nix +++ /dev/null @@ -1,10 +0,0 @@ -{ system, buildIdris, papers }: -let - version = import ../version.nix; - papersPkg = buildIdris { - ipkgName = "papers"; - src = papers; - idrisLibraries = [ ]; - }; -in -papersPkg.library { } diff --git a/nix/replica.nix b/nix/replica.nix index 6174ea7..a7b0947 100644 --- a/nix/replica.nix +++ b/nix/replica.nix @@ -2,6 +2,7 @@ buildReplica.build.overrideAttrs (attrs: { pname = "replica"; version = version; + __intentionallyOverridingVersion = true; buildPhase = '' make ''; diff --git a/replica.ipkg b/replica.ipkg index d0ac27f..5aaef3b 100644 --- a/replica.ipkg +++ b/replica.ipkg @@ -1,11 +1,11 @@ package replica -version = 0.6.0 +version = 0.6.1 sourcedir = "src" -depends = papers, contrib -langversion >= 0.6.0 +depends = contrib +langversion >= 0.8.0 modules = Replica diff --git a/src/Replica/Command.idr b/src/Replica/Command.idr index d8fea47..6ff2437 100644 --- a/src/Replica/Command.idr +++ b/src/Replica/Command.idr @@ -18,17 +18,17 @@ import public Replica.Command.Version public export Commands : Type -Commands = Union Prelude.id [RunCommand, InfoCommand, SetCommand, NewCommand, Help, Version] +Commands = Union [RunCommand, InfoCommand, SetCommand, NewCommand, Help, Version] export parseArgs : Default Global' -> List1 String -> ParseResult Commands parseArgs g xs = foldl1 go $ InvalidOption (pure help) xs ::: map (flip apply xs) - [ map inj . parseRun g - , map inj . parseInfo g - , map inj . parseSet - , map inj . parseNew - , map inj . parseHelp - , map inj . parseVersion + [ map (inj 0 Z) . parseRun g + , map (inj 1 (S Z)) . parseInfo g + , map (inj 2 (S $ S Z)) . parseSet + , map (inj 3 (S $ S $ S Z)) . parseNew + , map (inj 4 (S $ S $ S $ S Z)) . parseHelp + , map (inj 5 (S $ S $ S $ S $ S Z)) . parseVersion ] where go : ParseResult Commands -> ParseResult Commands -> ParseResult Commands diff --git a/src/Replica/Command/Info/Test.idr b/src/Replica/Command/Info/Test.idr index e94231a..876f632 100644 --- a/src/Replica/Command/Info/Test.idr +++ b/src/Replica/Command/Info/Test.idr @@ -42,7 +42,7 @@ Show TestInfoCommand where , show i.global] showExpectationPart : Part (Builder TestInfoCommand') Bool -showExpectationPart = inj $ MkOption +showExpectationPart = optionPart $ MkOption ( singleton $ MkMod (singleton "expectations") ['e'] (Left True) "show expectation for each test") diff --git a/src/Replica/Command/New.idr b/src/Replica/Command/New.idr index 6d06999..c4f034e 100644 --- a/src/Replica/Command/New.idr +++ b/src/Replica/Command/New.idr @@ -52,7 +52,7 @@ Show NewCommand where ] formatPart : Part (Builder NewCommand') FileFormat -formatPart = inj $ MkOption +formatPart = optionPart $ MkOption (singleton $ MkMod (singleton "format") ['f'] (Right $ MkValue "FORMAT" (parseFormat . toLower)) "format of the file to create (json|dhall)") @@ -69,7 +69,7 @@ formatPart = inj $ MkOption (\x, y => "More than one format given: \{show y}, \{show x}") includeSamplePart : Part (Builder NewCommand') Bool -includeSamplePart = inj $ MkOption (toList1 +includeSamplePart = optionPart $ MkOption (toList1 [ MkMod (singleton "includeSample") ['s'] (Left True) "include a sample test" , MkMod (singleton "noSample") ['S'] (Left False) @@ -84,7 +84,7 @@ includeSamplePart = inj $ MkOption (toList1 (const $ const "Contradictory values for includeSample") fileParamPart : Part (Builder NewCommand') String -fileParamPart = inj $ MkParam1 "NEW_TEST_FILE" Just go +fileParamPart = paramPart $ MkParam1 "NEW_TEST_FILE" Just go where checkFileType : String -> Maybe FileFormat checkFileType "json" = Just JSON diff --git a/src/Replica/Command/Run.idr b/src/Replica/Command/Run.idr index 4b17041..1684131 100644 --- a/src/Replica/Command/Run.idr +++ b/src/Replica/Command/Run.idr @@ -69,7 +69,7 @@ Show RunCommand where ||| `Run` option that handle if we run in interactive mode interactivePart : Part (Builder RunCommand') Bool -interactivePart = inj $ MkOption +interactivePart = optionPart $ MkOption (singleton $ MkMod (singleton "interactive") ['i'] (Left True) "(re)generate golden number if different/missing") False @@ -82,7 +82,7 @@ interactivePart = inj $ MkOption ||| `Run` option that handle if we display execution time timingPart : Part (Builder RunCommand') Bool -timingPart = inj $ MkOption +timingPart = optionPart $ MkOption (toList1 [ MkMod ("timing" ::: ["duration"]) ['d'] (Left True) "display execution time of each tests" @@ -100,7 +100,7 @@ timingPart = inj $ MkOption ||| `Run` option that define the working directory for the tests workingDirPart : Part (Builder RunCommand') String -workingDirPart = inj $ MkOption +workingDirPart = optionPart $ MkOption (singleton $ MkMod ("working-dir" ::: ["wdir"]) ['w'] (Right $ MkValue "DIR" Just) "set where is the test working directory") @@ -115,7 +115,7 @@ workingDirPart = inj $ MkOption ||| `Run` option for the parralelism level threadsPart : Part (Builder RunCommand') Nat -threadsPart = inj $ MkOption +threadsPart = optionPart $ MkOption (singleton $ MkMod (singleton "threads") ['x'] (Right $ MkValue "N" parsePositive) "max number of threads (default 1; 0 for no thread limit)") @@ -129,7 +129,7 @@ threadsPart = inj $ MkOption ||| `Run` option to decide if we stop execution on the first failure punitivePart : Part (Builder RunCommand') Bool -punitivePart = inj $ MkOption +punitivePart = optionPart $ MkOption (singleton $ MkMod ("punitive" ::: ["fail-fast"]) ['p'] (Left True) "fail fast mode: stops on the first test that fails") @@ -143,7 +143,7 @@ punitivePart = inj $ MkOption ||| `Run` option to decide if we hide successful tests in the report hideSuccessPart : Part (Builder RunCommand') Bool -hideSuccessPart = inj $ MkOption +hideSuccessPart = optionPart $ MkOption (singleton $ MkMod (toList1 ["hide-success", "fail-only"]) [] (Left True) "hide successful tests in the report") diff --git a/src/Replica/Command/Set.idr b/src/Replica/Command/Set.idr index ee4c8b1..4fa0a63 100644 --- a/src/Replica/Command/Set.idr +++ b/src/Replica/Command/Set.idr @@ -62,7 +62,7 @@ Show SetCommand where show x = "MkSetCommand \{show x.target} (\{show x.setter})" targetPart : Part (Builder SetCommand') TargetConfig -targetPart = inj $ MkOption +targetPart = optionPart $ MkOption (toList1 [ MkMod (singleton "local") ['l'] (Left Local) "Set a local config value (in `./.replica.json`) (default)" @@ -77,7 +77,7 @@ targetPart = inj $ MkOption (const $ const "Contradictory target") setterPart : Part (Builder SetCommand') Setter -setterPart = inj $ MkParam1 +setterPart = paramPart $ MkParam1 "KEY=VALUE" parseKV go diff --git a/src/Replica/Option/Filter.idr b/src/Replica/Option/Filter.idr index be5fc94..5f19430 100644 --- a/src/Replica/Option/Filter.idr +++ b/src/Replica/Option/Filter.idr @@ -60,7 +60,7 @@ Show Filter where ] onlyPart : Part (Builder Filter') (List String) -onlyPart = inj $ MkOption +onlyPart = optionPart $ MkOption (singleton $ MkMod (singleton "only") ['n'] (Right $ MkValue "testX,testY" $ Just . go) "a comma separated list of the tests to run") @@ -75,7 +75,7 @@ onlyPart = inj $ MkOption excludePart : Part (Builder Filter') (List String) -excludePart = inj $ MkOption +excludePart = optionPart $ MkOption (singleton $ MkMod (singleton "exclude") ['N'] (Right $ MkValue "testX,testY" $ Just . go) "a comma separated list of the tests to exclude") @@ -89,7 +89,7 @@ excludePart = inj $ MkOption xs => Left "Some tests were both included and excluded: \{joinBy ", " xs}" onlyTagsPart : Part (Builder Filter') (List String) -onlyTagsPart = inj $ MkOption +onlyTagsPart = optionPart $ MkOption (singleton $ MkMod ("tags" ::: ["only-tags"]) ['t'] (Right $ MkValue "TAGS" $ Just . go) "a comma separated list of the tags to run") @@ -103,7 +103,7 @@ onlyTagsPart = inj $ MkOption xs => Left "Some tags were both included and excluded: \{joinBy ", " xs}" excludeTagsPart : Part (Builder Filter') (List String) -excludeTagsPart = inj $ MkOption +excludeTagsPart = optionPart $ MkOption (singleton $ MkMod (singleton "exclude-tags") ['T'] (Right $ MkValue "TAGS" $ Just . go) "a comma separated list of the tags to exclude") @@ -118,7 +118,7 @@ excludeTagsPart = inj $ MkOption xs => Left "Some tags were both included and excluded: \{joinBy ", " xs}" onlySuitesPart : Part (Builder Filter') (List String) -onlySuitesPart = inj $ MkOption +onlySuitesPart = optionPart $ MkOption (singleton $ MkMod ("suites" ::: ["only-suites"]) ['s'] (Right $ MkValue "SUITES" $ Just . go) "a comma separated list of the suites to run") @@ -132,7 +132,7 @@ onlySuitesPart = inj $ MkOption xs => Left "Some tags were both included and excluded: \{joinBy ", " xs}" excludeSuitesPart : Part (Builder Filter') (List String) -excludeSuitesPart = inj $ MkOption +excludeSuitesPart = optionPart $ MkOption (singleton $ MkMod (singleton "exclude-suites") ['S'] (Right $ MkValue "SUITES" $ Just . go) "a comma separated list of the suites to exclude") @@ -147,7 +147,7 @@ excludeSuitesPart = inj $ MkOption xs => Left "Some tags were both included and excluded: \{joinBy ", " xs}" lastFailuresPart : Part (Builder Filter') Bool -lastFailuresPart = inj $ MkOption +lastFailuresPart = optionPart $ MkOption (singleton $ MkMod (singleton "last-fails") ['l'] (Left True) "if a previous run fails, rerun only the tests that failed") diff --git a/src/Replica/Option/Global.idr b/src/Replica/Option/Global.idr index 85db95d..7982ee4 100644 --- a/src/Replica/Option/Global.idr +++ b/src/Replica/Option/Global.idr @@ -7,7 +7,7 @@ import Data.String import Replica.Help import Replica.Option.Types -import Replica.Other.Decorated +import public Replica.Other.Decorated public export data LogLevel = Debug | Info | Warning | Critical @@ -100,7 +100,7 @@ replicaDefaultDir : String replicaDefaultDir = ".replica" replicaDirPart : Part (Builder Global') String -replicaDirPart = inj $ MkOption +replicaDirPart = optionPart $ MkOption (singleton $ MkMod (singleton "replica-dir") [] (Right $ MkValue "DIR" Just) "set the location of replica store (default: \".replica\")") @@ -112,7 +112,7 @@ replicaDirPart = inj $ MkOption (\x, y => "More than one replica dir were given: \{y}, \{x}") goldenDirPart : Part (Builder Global') (Maybe String) -goldenDirPart = inj $ MkOption +goldenDirPart = optionPart $ MkOption (singleton $ MkMod (singleton "golden-dir") [] (Right $ MkValue "DIR" (Just . Just)) "set the location of golden values (default: \"REPLICA_DIR/test\")") @@ -136,7 +136,7 @@ readLogLevel = readLogLevel' . toLower readLogLevel' _ = Nothing logLevelPart : Part (Builder Global') (Maybe LogLevel) -logLevelPart = inj $ MkOption +logLevelPart = optionPart $ MkOption (toList1 [ MkMod (singleton "log") [] (Right logLevelValue) #""" @@ -156,7 +156,7 @@ logLevelPart = inj $ MkOption (const $ const "Contradictory log level") colourPart : Part (Builder Global') Bool -colourPart = inj $ MkOption +colourPart = optionPart $ MkOption (toList1 [ MkMod (toList1 ["color", "colour"]) ['c'] (Left True) "activate colour in output (default)" @@ -171,7 +171,7 @@ colourPart = inj $ MkOption (const $ const "Contradictory colour settings") asciiPart : Part (Builder Global') Bool -asciiPart = inj $ MkOption +asciiPart = optionPart $ MkOption (toList1 [ MkMod (singleton "utf8") [] (Left False) "allow emojis in reports (default)" @@ -197,7 +197,7 @@ readDiffCommand x = fromMaybe (Custom x) $ go $ toLower x go x = Nothing diffPart : Part (Builder Global') DiffCommand -diffPart = inj $ MkOption +diffPart = optionPart $ MkOption (toList1 [ MkMod (singleton "diff") ['d'] (Right parseDiff) #""" @@ -218,7 +218,7 @@ diffPart = inj $ MkOption export filesParamPart : Part (Builder Global') (List String) -filesParamPart = inj $ MkParam "JSON_FILE(S)" (traverse checkNotOption) go +filesParamPart = paramPart $ MkParam "JSON_FILE(S)" (traverse checkNotOption) go where checkNotOption : String -> Maybe String checkNotOption x = guard (not $ "-" `isPrefixOf` x) $> x diff --git a/src/Replica/Option/Types.idr b/src/Replica/Option/Types.idr index 9823203..4f6e0d7 100644 --- a/src/Replica/Option/Types.idr +++ b/src/Replica/Option/Types.idr @@ -99,16 +99,27 @@ namespace Parts ||| It's used to list indifferently options and parameters as a part of a command. public export Part : Type -> Type -> Type - Part b a = Union (\p => p b a) [Param, Option] + Part b a = UnionT (\p => p b a) [Param, Option] + + + ||| embed a `Param` + export + paramPart : Param b a -> Part b a + paramPart = inj 0 Z + + ||| embed an `Option` + export + optionPart : Option b a -> Part b a + optionPart = inj 1 (S Z) ||| Reuse a generic `Part` in a specific setting export embedPart : (c -> b) -> (b -> c -> c) -> Part b a -> Part c a embedPart get set x = let Left x1 = decomp x - | Right v => inj $ embedParam get set v + | Right v => paramPart $ embedParam get set v v = decomp0 x1 - in inj $ embedOption get set v + in optionPart $ embedOption get set v ||| A Free applicative of Parts public export