-- | Discovered changes to every value the model declares observable.
module Conformance.Compare.Perturbation
    ( Step (..)
    , leafPaths
    , arrayPaths
    , perturbAt
    , appendAt
    , isLovelaceFloor
    , reportedDifferences
    , differingPaths
    , replacing
    , discoveredChanges
    , checkPerturbations
    ) where

import Conformance.Compare.Registration
    ( Declared (..)
    , Difference (..)
    , compareRegistration
    , outputFloorAgrees
    )
import Data.Aeson (Value (..))
import Data.Aeson.Key qualified as Key
import Data.Aeson.KeyMap qualified as KM
import Data.Foldable (toList)
import Data.List (nub)
import Data.Map.Strict qualified as Map
import Data.Maybe (catMaybes)
import Data.Text (Text)
import Data.Vector qualified as V

data Step = Field Text | Index Int
    deriving (Step -> Step -> Bool
(Step -> Step -> Bool) -> (Step -> Step -> Bool) -> Eq Step
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Step -> Step -> Bool
== :: Step -> Step -> Bool
$c/= :: Step -> Step -> Bool
/= :: Step -> Step -> Bool
Eq, Int -> Step -> ShowS
[Step] -> ShowS
Step -> String
(Int -> Step -> ShowS)
-> (Step -> String) -> ([Step] -> ShowS) -> Show Step
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Step -> ShowS
showsPrec :: Int -> Step -> ShowS
$cshow :: Step -> String
show :: Step -> String
$cshowList :: [Step] -> ShowS
showList :: [Step] -> ShowS
Show)

leafPaths :: Value -> [[Step]]
leafPaths :: Value -> [[Step]]
leafPaths Value
value = case Value
value of
    Object Object
fields ->
        [ Text -> Step
Field (Key -> Text
Key.toText Key
name) Step -> [Step] -> [Step]
forall a. a -> [a] -> [a]
: [Step]
rest
        | (Key
name, Value
inner) <- Object -> [(Key, Value)]
forall v. KeyMap v -> [(Key, v)]
KM.toList Object
fields
        , [Step]
rest <- Value -> [[Step]]
leafPaths Value
inner
        ]
    Array Array
entries ->
        [ Int -> Step
Index Int
index Step -> [Step] -> [Step]
forall a. a -> [a] -> [a]
: [Step]
rest
        | (Int
index, Value
inner) <- [Int] -> [Value] -> [(Int, Value)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] (Array -> [Value]
forall a. Vector a -> [a]
V.toList Array
entries)
        , [Step]
rest <- Value -> [[Step]]
leafPaths Value
inner
        ]
    Value
_ -> [[]]

arrayPaths :: Value -> [[Step]]
arrayPaths :: Value -> [[Step]]
arrayPaths Value
value = case Value
value of
    Object Object
fields ->
        [ Text -> Step
Field (Key -> Text
Key.toText Key
name) Step -> [Step] -> [Step]
forall a. a -> [a] -> [a]
: [Step]
rest
        | (Key
name, Value
inner) <- Object -> [(Key, Value)]
forall v. KeyMap v -> [(Key, v)]
KM.toList Object
fields
        , [Step]
rest <- Value -> [[Step]]
arrayPaths Value
inner
        ]
    Array Array
entries ->
        []
            [Step] -> [[Step]] -> [[Step]]
forall a. a -> [a] -> [a]
: [ Int -> Step
Index Int
index Step -> [Step] -> [Step]
forall a. a -> [a] -> [a]
: [Step]
rest
              | (Int
index, Value
inner) <- [Int] -> [Value] -> [(Int, Value)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] (Array -> [Value]
forall a. Vector a -> [a]
V.toList Array
entries)
              , [Step]
rest <- Value -> [[Step]]
arrayPaths Value
inner
              ]
    Value
_ -> []

perturbAt :: [Step] -> Value -> Value
perturbAt :: [Step] -> Value -> Value
perturbAt [] Value
value = case Value
value of
    Number Scientific
n -> Scientific -> Value
Number (Scientific
n Scientific -> Scientific -> Scientific
forall a. Num a => a -> a -> a
+ Scientific
1)
    String Text
s -> Text -> Value
String (Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-changed")
    Bool Bool
b -> Bool -> Value
Bool (Bool -> Bool
not Bool
b)
    Value
Null -> Text -> Value
String Text
"changed"
    Value
other -> Value
other
perturbAt (Field Text
name : [Step]
rest) Value
value = case Value
value of
    Object Object
fields -> case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup (Text -> Key
Key.fromText Text
name) Object
fields of
        Just Value
inner ->
            Object -> Value
Object (Key -> Value -> Object -> Object
forall v. Key -> v -> KeyMap v -> KeyMap v
KM.insert (Text -> Key
Key.fromText Text
name) ([Step] -> Value -> Value
perturbAt [Step]
rest Value
inner) Object
fields)
        Maybe Value
Nothing -> Value
value
    Value
_ -> Value
value
perturbAt (Index Int
index : [Step]
rest) Value
value = case Value
value of
    Array Array
entries
        | Int
index Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Array -> Int
forall a. Vector a -> Int
V.length Array
entries ->
            Array -> Value
Array (Array
entries Array -> [(Int, Value)] -> Array
forall a. Vector a -> [(Int, a)] -> Vector a
V.// [(Int
index, [Step] -> Value -> Value
perturbAt [Step]
rest (Array
entries Array -> Int -> Value
forall a. Vector a -> Int -> a
V.! Int
index))])
    Value
_ -> Value
value

appendAt :: [Step] -> Value -> Value
appendAt :: [Step] -> Value -> Value
appendAt [] Value
value = case Value
value of
    Array Array
entries -> Array -> Value
Array (Array -> Value -> Array
forall a. Vector a -> a -> Vector a
V.snoc Array
entries (Text -> Value
String Text
"appended"))
    Value
other -> Value
other
appendAt (Field Text
name : [Step]
rest) Value
value = case Value
value of
    Object Object
fields -> case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup (Text -> Key
Key.fromText Text
name) Object
fields of
        Just Value
inner ->
            Object -> Value
Object (Key -> Value -> Object -> Object
forall v. Key -> v -> KeyMap v -> KeyMap v
KM.insert (Text -> Key
Key.fromText Text
name) ([Step] -> Value -> Value
appendAt [Step]
rest Value
inner) Object
fields)
        Maybe Value
Nothing -> Value
value
    Value
_ -> Value
value
appendAt (Index Int
index : [Step]
rest) Value
value = case Value
value of
    Array Array
entries
        | Int
index Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Array -> Int
forall a. Vector a -> Int
V.length Array
entries ->
            Array -> Value
Array (Array
entries Array -> [(Int, Value)] -> Array
forall a. Vector a -> [(Int, a)] -> Vector a
V.// [(Int
index, [Step] -> Value -> Value
appendAt [Step]
rest (Array
entries Array -> Int -> Value
forall a. Vector a -> Int -> a
V.! Int
index))])
    Value
_ -> Value
value

{- | A leaf the model states as a lovelace floor: a transaction output's
lovelace, and a payment's value in @paid@ and in the transaction's refunds.
-}
isLovelaceFloor :: Text -> [Step] -> Bool
isLovelaceFloor :: Text -> [Step] -> Bool
isLovelaceFloor Text
"tx" [Field Text
"outputs", Index Int
_, Field Text
"lovelace"] = Bool
True
isLovelaceFloor Text
"tx" [Field Text
"refunds", Index Int
_, Field Text
"value"] = Bool
True
isLovelaceFloor Text
"paid" [Index Int
_, Field Text
"value"] = Bool
True
isLovelaceFloor Text
_ [Step]
_ = Bool
False

{- | Every path at which a reported difference's two sides differ, down to a
leaf or to an array whose length differs.
-}
reportedDifferences :: [Difference] -> [(Text, [Step])]
reportedDifferences :: [Difference] -> [(Text, [Step])]
reportedDifferences [Difference]
differences =
    [ (Text
name, [Step]
path)
    | Difference
difference <- [Difference]
differences
    , let name :: Text
name = Difference -> Text
differenceObservation Difference
difference
    , [Step]
path <-
        Value -> Value -> [[Step]]
differingPaths
            (Difference -> Value
differenceExpected Difference
difference)
            (Difference -> Value
differenceObserved Difference
difference)
    , Bool -> Bool
not (Text -> [Step] -> Difference -> Bool
surplusFloor Text
name [Step]
path Difference
difference)
    ]

surplusFloor :: Text -> [Step] -> Difference -> Bool
surplusFloor :: Text -> [Step] -> Difference -> Bool
surplusFloor Text
name [Step]
path Difference
difference
    | Text -> [Step] -> Bool
isLovelaceFloor Text
name [Step]
path = case ( [Step] -> Value -> Maybe Value
valueAt [Step]
path (Difference -> Value
differenceExpected Difference
difference)
                                       , [Step] -> Value -> Maybe Value
valueAt [Step]
path (Difference -> Value
differenceObserved Difference
difference)
                                       ) of
        (Just Value
expected, Just Value
observed) -> Value -> Value -> Bool
outputFloorAgrees Value
expected Value
observed
        (Maybe Value, Maybe Value)
_ -> Bool
False
    | Bool
otherwise = Bool
False

differingPaths :: Value -> Value -> [[Step]]
differingPaths :: Value -> Value -> [[Step]]
differingPaths Value
left Value
right
    | Value
left Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value
right = []
    | Bool
otherwise = case (Value
left, Value
right) of
        (Object Object
l, Object Object
r) ->
            [ Text -> Step
Field (Key -> Text
Key.toText Key
name) Step -> [Step] -> [Step]
forall a. a -> [a] -> [a]
: [Step]
rest
            | Key
name <- [Key] -> [Key]
forall a. Eq a => [a] -> [a]
nub (Object -> [Key]
forall v. KeyMap v -> [Key]
KM.keys Object
l [Key] -> [Key] -> [Key]
forall a. Semigroup a => a -> a -> a
<> Object -> [Key]
forall v. KeyMap v -> [Key]
KM.keys Object
r)
            , [Step]
rest <- case (Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
name Object
l, Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
name Object
r) of
                (Just Value
a, Just Value
b) -> Value -> Value -> [[Step]]
differingPaths Value
a Value
b
                (Maybe Value, Maybe Value)
_ -> [[]]
            ]
        (Array Array
l, Array Array
r)
            | Array -> Int
forall a. Vector a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Array
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Array -> Int
forall a. Vector a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Array
r ->
                [ Int -> Step
Index Int
index Step -> [Step] -> [Step]
forall a. a -> [a] -> [a]
: [Step]
rest
                | (Int
index, Value
a, Value
b) <- [Int] -> [Value] -> [Value] -> [(Int, Value, Value)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Int
0 ..] (Array -> [Value]
forall a. Vector a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Array
l) (Array -> [Value]
forall a. Vector a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Array
r)
                , [Step]
rest <- Value -> Value -> [[Step]]
differingPaths Value
a Value
b
                ]
        (Value, Value)
_ -> [[]]

replacing :: Text -> Value -> Value -> Value
replacing :: Text -> Value -> Value -> Value
replacing Text
name Value
inner Value
value = case Value
value of
    Object Object
fields -> Object -> Value
Object (Key -> Value -> Object -> Object
forall v. Key -> v -> KeyMap v -> KeyMap v
KM.insert (Text -> Key
Key.fromText Text
name) Value
inner Object
fields)
    Value
_ -> Value
value

-- | The same walk is used by the appendix and every live comparison.
discoveredChanges :: Declared -> Value -> [(Text, [Step], Value)]
discoveredChanges :: Declared -> Value -> [(Text, [Step], Value)]
discoveredChanges Declared
declared Value
observations =
    [ (Text
name, [Step]
path, Text -> Value -> Value -> Value
replacing Text
name ([Step] -> Value -> Value
perturbAt [Step]
path Value
inner) Value
observations)
    | Text
name <- Declared -> [Text]
declaredObservations Declared
declared
    , Just Value
inner <- [Text -> Value -> Maybe Value
observationAt Text
name Value
observations]
    , [Step]
path <- Value -> [[Step]]
leafPaths Value
inner
    ]
        [(Text, [Step], Value)]
-> [(Text, [Step], Value)] -> [(Text, [Step], Value)]
forall a. Semigroup a => a -> a -> a
<> [ (Text
name, [Step]
path, Text -> Value -> Value -> Value
replacing Text
name ([Step] -> Value -> Value
appendAt [Step]
path Value
inner) Value
observations)
           | Text
name <- Declared -> [Text]
declaredObservations Declared
declared
           , Just Value
inner <- [Text -> Value -> Maybe Value
observationAt Text
name Value
observations]
           , [Step]
path <- Value -> [[Step]]
arrayPaths Value
inner
           ]

observationAt :: Text -> Value -> Maybe Value
observationAt :: Text -> Value -> Maybe Value
observationAt Text
name Value
value = case Value
value of
    Object Object
fields -> Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup (Text -> Key
Key.fromText Text
name) Object
fields
    Value
_ -> Maybe Value
forall a. Maybe a
Nothing

valueAt :: [Step] -> Value -> Maybe Value
valueAt :: [Step] -> Value -> Maybe Value
valueAt [] Value
value = Value -> Maybe Value
forall a. a -> Maybe a
Just Value
value
valueAt (Field Text
name : [Step]
rest) Value
value = case Value
value of
    Object Object
fields -> Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup (Text -> Key
Key.fromText Text
name) Object
fields Maybe Value -> (Value -> Maybe Value) -> Maybe Value
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Step] -> Value -> Maybe Value
valueAt [Step]
rest
    Value
_ -> Maybe Value
forall a. Maybe a
Nothing
valueAt (Index Int
index : [Step]
rest) Value
value = case Value
value of
    Array Array
entries
        | Int
index Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
index Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Array -> Int
forall a. Vector a -> Int
V.length Array
entries ->
            [Step] -> Value -> Maybe Value
valueAt [Step]
rest (Array
entries Array -> Int -> Value
forall a. Vector a -> Int -> a
V.! Int
index)
    Value
_ -> Maybe Value
forall a. Maybe a
Nothing

replaceAt :: [Step] -> Value -> Value -> Value
replaceAt :: [Step] -> Value -> Value -> Value
replaceAt [] Value
replacement Value
_ = Value
replacement
replaceAt (Field Text
name : [Step]
rest) Value
replacement Value
value = case Value
value of
    Object Object
fields -> case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup (Text -> Key
Key.fromText Text
name) Object
fields of
        Just Value
inner ->
            Object -> Value
Object
                ( Key -> Value -> Object -> Object
forall v. Key -> v -> KeyMap v -> KeyMap v
KM.insert
                    (Text -> Key
Key.fromText Text
name)
                    ([Step] -> Value -> Value -> Value
replaceAt [Step]
rest Value
replacement Value
inner)
                    Object
fields
                )
        Maybe Value
Nothing -> Value
value
    Value
_ -> Value
value
replaceAt (Index Int
index : [Step]
rest) Value
replacement Value
value = case Value
value of
    Array Array
entries
        | Int
index Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
index Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Array -> Int
forall a. Vector a -> Int
V.length Array
entries ->
            Array -> Value
Array
                (Array
entries Array -> [(Int, Value)] -> Array
forall a. Vector a -> [(Int, a)] -> Vector a
V.// [(Int
index, [Step] -> Value -> Value -> Value
replaceAt [Step]
rest Value
replacement (Array
entries Array -> Int -> Value
forall a. Vector a -> Int -> a
V.! Int
index))])
    Value
_ -> Value
value

loweredOutputFloors
    :: Declared -> Value -> Value -> [(Text, [Step], Value)]
loweredOutputFloors :: Declared -> Value -> Value -> [(Text, [Step], Value)]
loweredOutputFloors Declared
declared Value
expected Value
observed =
    [ ( Text
name
      , [Step]
path
      , Text -> Value -> Value -> Value
replacing
            Text
name
            ([Step] -> Value -> Value -> Value
replaceAt [Step]
path (Scientific -> Value
Number (Scientific
modelFloor Scientific -> Scientific -> Scientific
forall a. Num a => a -> a -> a
- Scientific
1)) Value
actual)
            Value
observed
      )
    | Text
name <- Declared -> [Text]
declaredObservations Declared
declared
    , Just Value
model <- [Text -> Value -> Maybe Value
observationAt Text
name Value
expected]
    , Just Value
actual <- [Text -> Value -> Maybe Value
observationAt Text
name Value
observed]
    , [Step]
path <- Value -> [[Step]]
leafPaths Value
model
    , Text -> [Step] -> Bool
isLovelaceFloor Text
name [Step]
path
    , Just (Number Scientific
modelFloor) <- [[Step] -> Value -> Maybe Value
valueAt [Step]
path Value
model]
    ]

{- | Count every refused change by the observation the comparator named.
The sole allowed passing change is surplus above a lovelace floor.
-}
checkPerturbations
    :: Declared
    -> Value
    -> Value
    -> Either String (Int, Map.Map Text Int, [String])
checkPerturbations :: Declared
-> Value -> Value -> Either String (Int, Map Text Int, [String])
checkPerturbations Declared
declared Value
expected Value
observed = do
    let changes :: [(Text, [Step], Value)]
changes = Declared -> Value -> [(Text, [Step], Value)]
discoveredChanges Declared
declared Value
observed
        lowerings :: [(Text, [Step], Value)]
lowerings = Declared -> Value -> Value -> [(Text, [Step], Value)]
loweredOutputFloors Declared
declared Value
expected Value
observed
        absent :: [Text]
absent =
            [ Text
name
            | Text
name <- Declared -> [Text]
declaredObservations Declared
declared
            , ((Text, [Step], Value) -> Bool) -> [(Text, [Step], Value)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\(Text
n, [Step]
_, Value
_) -> Text
n Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
name) [(Text, [Step], Value)]
changes
            ]
    if [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
absent
        then () -> Either String ()
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        else String -> Either String ()
forall a b. a -> Either a b
Left (String
"no discovered changes for " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Text] -> String
forall a. Show a => a -> String
show [Text]
absent)
    results <- ((Text, [Step], Value) -> Either String (Maybe Text))
-> [(Text, [Step], Value)] -> Either String [Maybe Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Text, [Step], Value) -> Either String (Maybe Text)
check [(Text, [Step], Value)]
changes
    lowered <- mapM checkLowering lowerings
    let refused = [Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Text]
results [Maybe Text] -> [Maybe Text] -> [Maybe Text]
forall a. Semigroup a => a -> a -> a
<> [Maybe Text]
lowered)
        exempt =
            [ [Step] -> String
forall a. Show a => a -> String
show [Step]
path
            | ((Text
name, [Step]
path, Value
_), Maybe Text
Nothing) <- [(Text, [Step], Value)]
-> [Maybe Text] -> [((Text, [Step], Value), Maybe Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(Text, [Step], Value)]
changes [Maybe Text]
results
            , Text -> [Step] -> Bool
isLovelaceFloor Text
name [Step]
path
            ]
    pure
        ( length refused
        , Map.fromListWith (+) [(name, 1) | name <- refused]
        , exempt
        )
  where
    check :: (Text, [Step], Value) -> Either String (Maybe Text)
check (Text
name, [Step]
path, Value
changed)
        | Text -> [Step] -> Bool
isLovelaceFloor Text
name [Step]
path = case Declared -> Value -> Value -> Either [Difference] Agreement
compareRegistration Declared
declared Value
expected Value
changed of
            Right Agreement
_ -> Maybe Text -> Either String (Maybe Text)
forall a b. b -> Either a b
Right Maybe Text
forall a. Maybe a
Nothing
            Left [Difference]
differences ->
                String -> Either String (Maybe Text)
forall a b. a -> Either a b
Left
                    ( String
"outputMinimumAda was compared at "
                        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Step] -> String
forall a. Show a => a -> String
show [Step]
path
                        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
": "
                        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Difference] -> String
forall a. Show a => a -> String
show [Difference]
differences
                    )
        | Bool
otherwise = case Declared -> Value -> Value -> Either [Difference] Agreement
compareRegistration Declared
declared Value
expected Value
changed of
            Right Agreement
_ ->
                String -> Either String (Maybe Text)
forall a b. a -> Either a b
Left
                    (String
"changed " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
name String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" at " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Step] -> String
forall a. Show a => a -> String
show [Step]
path String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" was accepted")
            Left [Difference]
differences
                | Text
name Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Difference -> Text) -> [Difference] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Difference -> Text
differenceObservation [Difference]
differences ->
                    Maybe Text -> Either String (Maybe Text)
forall a b. b -> Either a b
Right (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
name)
                | Bool
otherwise ->
                    String -> Either String (Maybe Text)
forall a b. a -> Either a b
Left
                        ( String
"changed "
                            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
name
                            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" at "
                            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Step] -> String
forall a. Show a => a -> String
show [Step]
path
                            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" was attributed elsewhere: "
                            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Difference] -> String
forall a. Show a => a -> String
show [Difference]
differences
                        )
    checkLowering :: (Text, a, Value) -> Either String (Maybe Text)
checkLowering (Text
name, a
path, Value
changed) = case Declared -> Value -> Value -> Either [Difference] Agreement
compareRegistration Declared
declared Value
expected Value
changed of
        Right Agreement
_ ->
            String -> Either String (Maybe Text)
forall a b. a -> Either a b
Left
                ( String
"lowered output lovelace below the model floor at "
                    String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
path
                    String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" was accepted"
                )
        Left [Difference]
differences
            | Text
name Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Difference -> Text) -> [Difference] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Difference -> Text
differenceObservation [Difference]
differences ->
                Maybe Text -> Either String (Maybe Text)
forall a b. b -> Either a b
Right (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
name)
            | Bool
otherwise ->
                String -> Either String (Maybe Text)
forall a b. a -> Either a b
Left
                    ( String
"lowered output lovelace at "
                        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
path
                        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" was attributed elsewhere: "
                        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Difference] -> String
forall a. Show a => a -> String
show [Difference]
differences
                    )