From 05b9aee4eaaa00377486c6ec4c74de939801ab86 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 4 Aug 2016 10:34:14 -0400 Subject: [PATCH] Guard `recur` on the comparability of its operands. --- src/Interpreter.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/Interpreter.hs b/src/Interpreter.hs index 2b2f773b1..2705bf29a 100644 --- a/src/Interpreter.hs +++ b/src/Interpreter.hs @@ -58,7 +58,9 @@ algorithmWithTerms t1 t2 = case (unwrap t1, unwrap t2) of -- | Runs the diff algorithm run :: (Eq leaf, Hashable leaf, Eq (Record fields), HasField fields Category) => DiffConstructor leaf (Record fields) -> Comparable leaf (Record fields) -> SES.Cost (Diff leaf (Record fields)) -> Algorithm (Term leaf (Record fields)) (Diff leaf (Record fields)) (Diff leaf (Record fields)) -> Maybe (Diff leaf (Record fields)) run construct comparable cost = runAlgorithm construct recur cost getLabel . fmap Just - where recur = constructAndRun construct comparable cost + where recur a b = do + guard (comparable a b) + constructAndRun construct comparable cost a b getLabel (h :< t) = (category h, case t of Leaf s -> Just s _ -> Nothing)