diff options
| -rw-r--r-- | assignment-12/cashModel.icl | 29 |
1 files changed, 27 insertions, 2 deletions
diff --git a/assignment-12/cashModel.icl b/assignment-12/cashModel.icl index c1200be..c9dfc55 100644 --- a/assignment-12/cashModel.icl +++ b/assignment-12/cashModel.icl @@ -50,8 +50,9 @@ model list (Rem p) | otherwise = (list,[]) model list Pay = ([],[euro list]) -derive gen Euro -derive string Euro +derive gEq Action +derive gen Euro, Action, Product, [] +derive string Euro, Action, Product, [] derive bimap [] /** @@ -98,3 +99,27 @@ where prop_neg_distributes_over_plus :: Euro Euro -> Property prop_neg_distributes_over_plus a b = ~(a + b) =.= ~a + ~b + +/** + * Passed + * + * NB: this only checks Rem (as requested). The same property holds for Add. + * For Pay, the output of the model should be negated. + */ +Start = test fairness +where + fairness :: [Product] Product -> Property + fairness ps p = value newps =.= value ps + value out + where (newps, out) = model ps (Rem p) + +class value a :: (a -> Real) +instance value Real where value = id +instance value [a] | value a where value = sum o map value +instance value Euro where value = \e -> toReal e.euro * 100.0 + toReal (sign e.euro * e.cent) +instance value Product where value = value o euro +instance value Action +where + value = \a -> case a of + Add p -> value p + Rem p -> ~(value p) + Pay -> 0.0 |