From: Simon Huber <hubsim@gmail.com>
Date: Mon, 19 Sep 2016 09:26:00 +0000 (+0200)
Subject: Fix insertSystem to maintain invariant for systems
X-Git-Url: https://git.ak3n.com/?a=commitdiff_plain;h=533c9950f4c44363622ebc443fa2987cf08b1318;p=cubicaltt.git

Fix insertSystem to maintain invariant for systems

Closes #52.
---

diff --git a/Connections.hs b/Connections.hs
index 077d575..a6196f9 100644
--- a/Connections.hs
+++ b/Connections.hs
@@ -388,10 +388,10 @@ showSystem :: Show a => System a -> String
 showSystem = showListSystem . toList
 
 insertSystem :: Face -> a -> System a -> System a
-insertSystem alpha v ts = case find (comparable alpha) (keys ts) of
-  Just beta | alpha `leq` beta -> ts
-            | otherwise        -> Map.insert alpha v (Map.delete beta ts)
-  Nothing -> Map.insert alpha v ts
+insertSystem alpha v ts
+  | any (leq alpha) (keys ts) = ts
+  | otherwise = Map.insert alpha v
+                (Map.filterWithKey (\gamma _ -> not (gamma `leq` alpha)) ts)
 
 insertsSystem :: [(Face, a)] -> System a -> System a
 insertsSystem faces us = foldr (uncurry insertSystem) us faces