feat: make CLI commands fail where appropriate (#9)

compat - when there is no full compatibility
diff - when there are some differences
validate - when JSON value is incompatible with a schema

Author: mstream

.gitignore

@@ -1,4 +1,5 @@
 .psc-ide-port
 .spago
+dist
 output*
 result

cli.sh

@@ -2,9 +2,10 @@
 
 set -e
 
-EXEC_ARGS=()
-for ARG in "$@"; do
-	EXEC_ARGS+=("--exec-args" "$ARG")
-done
+spago bundle-app \
+	--main Main.CLI \
+	--platform node \
+	--to dist/cli.mjs \
+	1>dist/last-build.log 2>&1
 
-spago run --main Main.CLI "${EXEC_ARGS[@]}"
+node dist/cli.mjs "$@"

snapshots/json/differences/no-differences.json

@@ -0,0 +1 @@
+[]

src/purs/CLI.purs

@@ -1,4 +1,10 @@
-module CLI (runProgram, OutputFormat(..), Program, ProgramOutput) where
+module CLI
+  ( runProgram
+  , OutputFormat(..)
+  , Program
+  , ProgramOutput
+  , PureProgram
+  ) where
 
 import Prelude
 
@@ -16,21 +22,27 @@ type ProgramOutput =
 
 type Program i = i → ProgramOutput
 
+type PureProgram i o =
+  i → String \/ { expectedError ∷ Boolean, output ∷ o }
+
 data OutputFormat = Json | Markdown
 
 runProgram
   ∷ ∀ i o
   . Document o
   ⇒ EncodeJson o
   ⇒ OutputFormat
-  → (i → String \/ o)
+  → PureProgram i o
   → i
   → ProgramOutput
 runProgram outputFormat compute = compute >>> case _ of
   Left errorMessage →
-    { exitCode: 1, stderr: errorMessage <> "\n", stdout: "" }
-  Right output →
-    { exitCode: 0, stderr: "", stdout: renderOutput output <> "\n" }
+    { exitCode: 2, stderr: errorMessage <> "\n", stdout: "" }
+  Right { expectedError, output } →
+    { exitCode: if expectedError then 1 else 0
+    , stderr: ""
+    , stdout: renderOutput output <> "\n"
+    }
   where
   renderOutput ∷ o → String
   renderOutput = case outputFormat of

src/purs/CLI/Compat.purs

@@ -6,14 +6,14 @@ module CLI.Compat
 
 import Prelude
 
-import CLI (OutputFormat)
+import CLI (OutputFormat, PureProgram)
 import Data.Argonaut.Parser as AP
 import Data.Either (Either(..))
 import Data.Either.Nested (type (\/))
 import Data.Newtype (wrap)
 import JsonSchema (JsonSchema)
 import JsonSchema.Codec.Parsing as Parsing
-import JsonSchema.Compatibility (Compatibility)
+import JsonSchema.Compatibility (Compatibility(..))
 import JsonSchema.Compatibility as Compatibility
 import JsonSchema.Difference as Difference
 
@@ -28,7 +28,9 @@ type ProgramInput =
   , rightSchemaText ∷ String
   }
 
-compute ∷ ProgramInput → String \/ Compatibility
+type ProgramOutput = Compatibility
+
+compute ∷ PureProgram ProgramInput ProgramOutput
 compute { leftSchemaText, rightSchemaText } = do
   leftSchema ← case parseSchema leftSchemaText of
     Left errorMessage →
@@ -44,9 +46,18 @@ compute { leftSchemaText, rightSchemaText } = do
     Right schema →
       Right schema
 
-  Right
-    $ Compatibility.calculate
-    $ Difference.calculate leftSchema rightSchema
+  let
+    differences = Difference.calculate leftSchema rightSchema
+
+  Right case Compatibility.calculate differences of
+    Backward details →
+      { expectedError: true, output: Backward details }
+    Forward details →
+      { expectedError: true, output: Forward details }
+    Full →
+      { expectedError: false, output: Full }
+    None details →
+      { expectedError: true, output: None details }
   where
   parseSchema ∷ String → String \/ JsonSchema
   parseSchema s = do

src/purs/CLI/Diff.purs

@@ -6,12 +6,13 @@ module CLI.Diff
 
 import Prelude
 
-import CLI (OutputFormat)
+import CLI (OutputFormat, PureProgram)
 import Data.Argonaut.Parser as AP
 import Data.Either (Either(..))
 import Data.Either.Nested (type (\/))
 import Data.Newtype (wrap)
 import Data.Set (Set)
+import Data.Set as Set
 import JsonSchema (JsonSchema)
 import JsonSchema.Codec.Parsing as Parsing
 import JsonSchema.Difference (Difference)
@@ -28,7 +29,9 @@ type ProgramInput =
   , rightSchemaText ∷ String
   }
 
-compute ∷ ProgramInput → String \/ Set Difference
+type ProgramOutput = Set Difference
+
+compute ∷ PureProgram ProgramInput ProgramOutput
 compute { leftSchemaText, rightSchemaText } = do
   leftSchema ← case parseSchema leftSchemaText of
     Left errorMessage →
@@ -44,7 +47,13 @@ compute { leftSchemaText, rightSchemaText } = do
     Right schema →
       Right schema
 
-  Right $ Difference.calculate leftSchema rightSchema
+  let
+    differences = Difference.calculate leftSchema rightSchema
+
+  Right
+    { expectedError: not $ Set.isEmpty differences
+    , output: differences
+    }
   where
   parseSchema ∷ String → String \/ JsonSchema
   parseSchema s = do

src/purs/CLI/Validate.purs

@@ -6,12 +6,13 @@ module CLI.Validate
 
 import Prelude
 
-import CLI (OutputFormat)
+import CLI (OutputFormat, PureProgram)
 import Data.Argonaut.Parser as AP
 import Data.Either (Either(..))
 import Data.Either.Nested (type (\/))
 import Data.Newtype (wrap)
 import Data.Set (Set)
+import Data.Set as Set
 import JsonSchema (JsonSchema)
 import JsonSchema.Codec.Parsing as Parsing
 import JsonSchema.Validation (Violation)
@@ -29,7 +30,9 @@ type ProgramInput =
   , schemaText ∷ String
   }
 
-compute ∷ ProgramInput → String \/ Set Violation
+type ProgramOutput = Set Violation
+
+compute ∷ PureProgram ProgramInput ProgramOutput
 compute { jsonText, schemaText } = do
   schema ← case parseSchema schemaText of
     Left errorMessage →
@@ -45,7 +48,11 @@ compute { jsonText, schemaText } = do
     Right json →
       Right json
 
-  Right $ jsonValue `Validation.validateAgainst` schema
+  let
+    violations = jsonValue `Validation.validateAgainst` schema
+
+  Right
+    { expectedError: not $ Set.isEmpty violations, output: violations }
   where
   parseJson ∷ String → String \/ JsonValue
   parseJson = map wrap <<< AP.jsonParser

src/purs/Main/CLI.purs

@@ -109,11 +109,6 @@ run { command } = Aff.catchError executeProgram fallbackProgram
   executeProgram ∷ Aff ProgramOutput
   executeProgram = case command of
     Compat { leftSchemaPath, outputFormat, rightSchemaPath } → do
-      Console.error $ "calculating compatibility between schemata at "
-        <> leftSchemaPath
-        <> " and "
-        <> rightSchemaPath
-
       leftSchemaText ← FS.readTextFile UTF8 leftSchemaPath
       rightSchemaText ← FS.readTextFile UTF8 rightSchemaPath
 
@@ -123,11 +118,6 @@ run { command } = Aff.catchError executeProgram fallbackProgram
         { leftSchemaText, rightSchemaText }
 
     Diff { leftSchemaPath, outputFormat, rightSchemaPath } → do
-      Console.error $ "calculating difference between schemata at "
-        <> leftSchemaPath
-        <> " and "
-        <> rightSchemaPath
-
       leftSchemaText ← FS.readTextFile UTF8 leftSchemaPath
       rightSchemaText ← FS.readTextFile UTF8 rightSchemaPath
 
@@ -137,11 +127,6 @@ run { command } = Aff.catchError executeProgram fallbackProgram
         { leftSchemaText, rightSchemaText }
 
     Validate { jsonPath, outputFormat, schemaPath } → do
-      Console.error $ "validating JSON at "
-        <> jsonPath
-        <> " against schema at "
-        <> schemaPath
-
       schemaText ← FS.readTextFile UTF8 schemaPath
       jsonText ← FS.readTextFile UTF8 jsonPath
 

test/snapshot/purs/Test/Spec/CLI.purs

@@ -4,6 +4,7 @@ import Prelude
 
 import Control.Monad.Error.Class (throwError)
 import Data.Foldable (foldMap)
+import Data.Maybe (Maybe(..))
 import Data.String as String
 import Data.String.NonEmpty (NonEmptyString)
 import Data.String.NonEmpty as StringNE
@@ -18,6 +19,7 @@ import Type.Proxy (Proxy(..))
 type Input =
   { command ∷ NonEmptyString
   , parameters ∷ Array Parameter
+  , shouldFail ∷ Boolean
   }
 
 type Parameter = NonEmptyString /\ NonEmptyString
@@ -42,24 +44,35 @@ fixtures =
           )
       , leftSchemaFile: StringNE.nes (Proxy ∷ Proxy "any-number.json")
       , rightSchemaFile: StringNE.nes (Proxy ∷ Proxy "any-string.json")
+      , shouldFail: true
       }
     ]
 
   diffFixtures ∷ Array (Fixture Input)
   diffFixtures = diffFixture <$>
     [ { differencesFile: StringNE.nes
+          ( Proxy
+              ∷ Proxy "no-differences.json"
+          )
+      , leftSchemaFile: StringNE.nes (Proxy ∷ Proxy "any-number.json")
+      , rightSchemaFile: StringNE.nes (Proxy ∷ Proxy "any-number.json")
+      , shouldFail: false
+      }
+    , { differencesFile: StringNE.nes
           ( Proxy
               ∷ Proxy "allowed-types-change-from-number-to-string.json"
           )
       , leftSchemaFile: StringNE.nes (Proxy ∷ Proxy "any-number.json")
       , rightSchemaFile: StringNE.nes (Proxy ∷ Proxy "any-string.json")
+      , shouldFail: true
       }
     ]
 
   validateFixtures ∷ Array (Fixture Input)
   validateFixtures = validateFixture <$>
     [ { jsonFile: StringNE.nes (Proxy ∷ Proxy "string.json")
       , schemaFile: StringNE.nes (Proxy ∷ Proxy "any-number.json")
+      , shouldFail: true
       , violationsFile: StringNE.nes
           (Proxy ∷ Proxy "string-is-not-a-number.json")
       }
@@ -69,15 +82,18 @@ compatFixture
   ∷ { compatibilitiesFile ∷ NonEmptyString
     , leftSchemaFile ∷ NonEmptyString
     , rightSchemaFile ∷ NonEmptyString
+    , shouldFail ∷ Boolean
     }
   → Fixture Input
-compatFixture { compatibilitiesFile, leftSchemaFile, rightSchemaFile } =
+compatFixture
+  { compatibilitiesFile, leftSchemaFile, rightSchemaFile, shouldFail } =
   { input:
       { command: StringNE.nes (Proxy ∷ Proxy "compat")
       , parameters:
           [ StringNE.nes (Proxy ∷ Proxy "left") /\ leftSchemaPath
           , StringNE.nes (Proxy ∷ Proxy "right") /\ rightSchemaPath
           ]
+      , shouldFail
       }
   , outputPath
   }
@@ -100,15 +116,18 @@ diffFixture
   ∷ { differencesFile ∷ NonEmptyString
     , leftSchemaFile ∷ NonEmptyString
     , rightSchemaFile ∷ NonEmptyString
+    , shouldFail ∷ Boolean
     }
   → Fixture Input
-diffFixture { differencesFile, leftSchemaFile, rightSchemaFile } =
+diffFixture
+  { differencesFile, leftSchemaFile, rightSchemaFile, shouldFail } =
   { input:
       { command: StringNE.nes (Proxy ∷ Proxy "diff")
       , parameters:
           [ StringNE.nes (Proxy ∷ Proxy "left") /\ leftSchemaPath
           , StringNE.nes (Proxy ∷ Proxy "right") /\ rightSchemaPath
           ]
+      , shouldFail
       }
   , outputPath
   }
@@ -130,16 +149,18 @@ diffFixture { differencesFile, leftSchemaFile, rightSchemaFile } =
 validateFixture
   ∷ { jsonFile ∷ NonEmptyString
     , schemaFile ∷ NonEmptyString
+    , shouldFail ∷ Boolean
     , violationsFile ∷ NonEmptyString
     }
   → Fixture Input
-validateFixture { jsonFile, schemaFile, violationsFile } =
+validateFixture { jsonFile, schemaFile, shouldFail, violationsFile } =
   { input:
       { command: StringNE.nes (Proxy ∷ Proxy "validate")
       , parameters:
           [ StringNE.nes (Proxy ∷ Proxy "json") /\ jsonPath
           , StringNE.nes (Proxy ∷ Proxy "schema") /\ schemaPath
           ]
+      , shouldFail
       }
   , outputPath
   }
@@ -167,15 +188,31 @@ describeInput { command, parameters } = "a CLI invocation of '"
     StringNE.toString k <> "=" <> StringNE.toString v
 
 executeCommand ∷ Input → Aff String
-executeCommand { command, parameters } = do
+executeCommand { command, parameters, shouldFail } = do
   result ← runCliProcess `pipe` runPrettierProcess
-  case result.exit of
+  let
+    { escapedCommand, exit, stderr, stdout } = result
+  case exit of
     BySignal _ →
-      throwError $ error $ "process killed: " <> result.escapedCommand
-    Normally 0 → do
-      pure $ result.stdout <> "\n"
-    Normally _ →
-      pure $ result.stderr <> "\n"
+      throwError $ error $ "process killed: " <> escapedCommand
+    Normally 0 →
+      if shouldFail then throwError
+        $ error
+        $ "command should fail but it did not: "
+            <> show { stderr, stdout }
+      else pure $ stdout <> "\n"
+    Normally 1 →
+      if shouldFail then pure $ stdout <> "\n"
+      else throwError
+        $ error
+        $ "command should not fail but it did: "
+            <> show { exitCode: 1, stderr, stdout }
+    Normally exitCode →
+      if shouldFail then pure $ stderr <> "\n"
+      else throwError
+        $ error
+        $ "command should not fail but it did: "
+            <> show { exitCode, stderr, stdout }
   where
   runCliProcess ∷ Aff ExecaProcess
   runCliProcess = E.execa
@@ -203,9 +240,11 @@ pipe runProcess1 runProcess2 = do
   process1 ← runProcess1
   result1 ← process1.getResult
   case result1.exit of
-    Normally 0 → do
+    Normally exitCode → do
       process2 ← runProcess2
       process2.stdin.writeUtf8End result1.stdout
-      process2.getResult
+      result2 ← process2.getResult
+      pure $ result1
+        { exitCode = Just exitCode, stdout = result2.stdout }
     _ →
       pure result1