Setup basic tests for wall carving

src/Dodge/LevelGen/StaticWalls.hs

@@ -48,6 +48,8 @@ checkWallLeft (x,y) wls = case filter (\(a,b) -> b == x ) wls of
 -- given a polygon of points and collection of walls, cuts out the polygon
 -- ie returns a new set of walls with a hole determined by anticlockwise ordering of the points
 cutWalls' :: [Point2] -> [WallP] -> [WallP]
+cutWalls' [] walls = walls
+cutWalls' [x,y] walls = walls
 cutWalls' qs walls = 
 --    nub
 --    . filter (not.wallIsZeroLength) 

test/Spec.hs

@@ -1,4 +1,36 @@
 import Test.QuickCheck
 
+import Dodge.LevelGen.StaticWalls
+import Geometry
+
 main :: IO ()
-main = putStrLn "Test suite not yet implemented"
+main = do
+    putStrLn "Running tests:"
+    quickCheck prop_looping
+
+nextPair :: Eq a => (a,a) -> [(a,a)] -> [(a,a)]
+nextPair (_,y) = filter (\(x,_) -> x == y)
+
+isLooping :: Eq a => [(a,a)] -> Bool
+isLooping xs = all (( == 1) . length . flip nextPair xs) xs
+
+polygonStrictlyConvex :: [Point2] -> Bool
+polygonStrictlyConvex ps = True
+
+--prop_looping :: [Point2] -> [WallP] -> Bool
+
+prop_looping = forAllShrink genTris shrinkTris $ \tris ->
+    isLooping $ foldr cutWalls' [] tris
+
+shrinkTris (x:xs) = xs : map (x :) (shrink xs)
+
+genTri = zip <$> trip <*> trip 
+  where
+    trip = vectorOf 3 $ choose (-500,500::Float)
+
+genTris = listOf genTri
+
+--extractLoops :: Eq a => [(a,a)] -> [[(a,a)]]
+--extractLoops [] = []
+--extractLoops (x:xs) = 
+