From 35174820863701698a595f4a2d6a3a027f517bef Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= <marko.d@juspay.in>
Date: Mon, 25 Nov 2019 14:56:48 +0100
Subject: [PATCH] Issue #26: precise matching on error results in rule tests

---
 lib/Fencer/Rules.hs               | 12 ++++++----
 test/Fencer/Rules/Test.hs         |  4 +++-
 test/Fencer/Rules/Test/Helpers.hs | 39 +++++++++++++++----------------
 3 files changed, 29 insertions(+), 26 deletions(-)

diff --git a/lib/Fencer/Rules.hs b/lib/Fencer/Rules.hs
index 2fd372c..475ce50 100644
--- a/lib/Fencer/Rules.hs
+++ b/lib/Fencer/Rules.hs
@@ -6,6 +6,7 @@
 module Fencer.Rules
     ( LoadRulesError(..)
     , prettyPrintErrors
+    , showError
     , loadRulesFromDirectory
     , definitionsToRuleTree
     , domainToRuleTree
@@ -32,14 +33,15 @@ data LoadRulesError
   | LoadRulesIOError IOException
   deriving stock (Show)
 
+-- | Pretty-print a 'LoadRulesError'.
+showError :: LoadRulesError -> String
+showError (LoadRulesParseError file yamlEx) =
+  show file ++ ", " ++ (Yaml.prettyPrintParseException yamlEx)
+showError (LoadRulesIOError ex) = "IO error: " ++ displayException ex
+
 -- | Pretty-print a list of 'LoadRulesError's.
 prettyPrintErrors :: [LoadRulesError] -> String
 prettyPrintErrors = intercalate ", " . fmap showError
-  where
-    showError (LoadRulesParseError file yamlEx) =
-      show file ++ ", " ++ (Yaml.prettyPrintParseException yamlEx)
-    showError (LoadRulesIOError ex) =
-      "IO error: " ++ displayException ex
 
 -- | Read rate limiting rules from a directory, recursively. Files are
 -- assumed to be YAML, but do not have to have a @.yml@ extension. If
diff --git a/test/Fencer/Rules/Test.hs b/test/Fencer/Rules/Test.hs
index ef8b69b..6bc2e34 100644
--- a/test/Fencer/Rules/Test.hs
+++ b/test/Fencer/Rules/Test.hs
@@ -137,7 +137,9 @@ test_rulesLoadRulesException =
         ]
       )
       (#result $ Left
-         [LoadRulesParseError "faultyDomain.yaml" $ Yaml.AesonException ""])
+         [LoadRulesParseError "faultyDomain.yaml" $
+           Yaml.AesonException
+             "Error in $.descriptors[1]: key \"key\" not present"])
 
 -- | test that 'loadRulesFromDirectory' accepts a minimal
 -- configuration containing only the domain id.
diff --git a/test/Fencer/Rules/Test/Helpers.hs b/test/Fencer/Rules/Test/Helpers.hs
index eda2491..7528bca 100644
--- a/test/Fencer/Rules/Test/Helpers.hs
+++ b/test/Fencer/Rules/Test/Helpers.hs
@@ -3,8 +3,7 @@
 
 -- | Module with helper functions used in rules and other testing.
 module Fencer.Rules.Test.Helpers
-  ( toErrorList
-  , writeContentsToFile
+  ( writeContentsToFile
   , writeAndLoadRules
   , expectLoadRules
   )
@@ -15,19 +14,14 @@ import           BasePrelude
 import qualified Data.Text.IO as TIO
 import           Named ((:!), arg)
 import qualified System.Directory as Dir
-import           System.FilePath (FilePath, takeDirectory, (</>))
+import           System.FilePath (FilePath, takeDirectory, takeFileName, (</>))
 import qualified System.IO.Temp as Temp
-import           Test.Tasty.HUnit (assertBool, assertEqual, Assertion)
+import           Test.Tasty.HUnit (assertBool, assertFailure, Assertion)
 
-import           Fencer.Rules (LoadRulesError(..), loadRulesFromDirectory)
+import           Fencer.Rules (LoadRulesError(..), loadRulesFromDirectory, prettyPrintErrors, showError)
 import           Fencer.Rules.Test.Types (RuleFile(..))
 import           Fencer.Types (DomainDefinition(..))
 
--- | Get a list of values on the Left or an empty list if it is a
--- Right value.
-toErrorList :: Either [a] [b] -> [a]
-toErrorList (Right _) = []
-toErrorList (Left xs) = xs
 
 -- | Write contents to a path in the given root and modify file
 -- permissions.
@@ -84,17 +78,22 @@ expectLoadRules
       (#root tempDir)
       (#files files)
       >>= \case
-      f@(Left _) ->
-        -- Paths to temporary files vary and there is not much point
-        -- in writing down exact expected exception messages so the
-        -- only assertion made is that the number of exceptions is the
-        -- same.
-        assertEqual
-          "unexpected failure"
-          (length . toErrorList $ result)
-          (length . toErrorList $ f)
+      Left errs -> do
+        case result of
+          Right _ ->
+            assertFailure "Expected failures, got domain definitions!"
+          Left expectedErrs -> do
+            assertBool ("Exceptions differ! Expected: " ++
+                        (prettyPrintErrors expectedErrs) ++ "\nGot: " ++
+                        (prettyPrintErrors errs))
+              (((==) `on` (fmap showError))
+               (sortBy (compare `on` showError) (trimPath <$> expectedErrs))
+               (sortBy (compare `on` showError) (trimPath <$> errs)))
       Right definitions -> assertBool "unexpected definitions"
         (((==) `on` show)
         (sortOn domainDefinitionId <$> result)
         (Right $ sortOn domainDefinitionId definitions))
-
+ where
+  trimPath :: LoadRulesError -> LoadRulesError
+  trimPath (LoadRulesParseError p ex) = LoadRulesParseError (takeFileName p) ex
+  trimPath e                          = e