implement missing quickcheck props + tests

2 files changed, 112 insertions, 20 deletions

diff --git a/AufgabeFFP7.hs b/AufgabeFFP7.hs
index fc9d594..43e8014 100644
--- a/AufgabeFFP7.hs
+++ b/AufgabeFFP7.hs
@@ -2,7 +2,7 @@ module AufgabeFFP7
 where
 
 import Data.Char
-import Data.List hiding ((\\), insert)
+import Data.List hiding ((\\), insert, delete)
 import Test.QuickCheck
 
 type Buffer = (Int, String)
@@ -55,26 +55,29 @@ insertI :: Char -> BufferI -> BufferI
 insertI c (beforeC, afterC) = ([c] ++ beforeC, afterC)
 
 -- delete character before cursor
---TODO deleteI :: BufferI -> BufferI
+deleteI :: BufferI -> BufferI
+deleteI (beforeC, "") = (beforeC, "")
+deleteI (beforeC, last:afterC) = (beforeC, afterC)
 
 -- move cursor left one character
 leftI :: BufferI -> BufferI
-leftI ([], afterC) = ([], afterC)
+leftI ("", afterC) = ("", afterC)
 leftI (last:beforeC, afterC) = (beforeC, [last] ++ afterC)
 
 -- move cursor right one character
---TODO rightI :: BufferI -> BufferI
+rightI :: BufferI -> BufferI
+rightI (beforeC, "") = (beforeC, "")
+rightI (beforeC, last:afterC) = ([last] ++ beforeC, afterC)
 
 -- is cursor at left end?
 atLeftI :: BufferI -> Bool
-atLeftI ([], _) = True
-atLeftI (_, _) = False
+atLeftI ("", _) = True
+atLeftI (_, _)  = False
 
 -- is cursor at right end?
 atRightI :: BufferI -> Bool
-atRightI (_, []) = True
-atRightI (_, _) = False
-
+atRightI (_, "") = True
+atRightI (_, _)  = False
 
 --------------------------------------------------------------------------------
 
@@ -88,25 +91,50 @@ retrieve (beforeC, afterC) = (length beforeC, (reverse beforeC) ++ afterC)
 bufEqual :: BufferI -> Buffer -> Bool
 bufEqual bi b = (retrieve bi) == b
 
+(<==>) = bufEqual
+
 -- generator for equal data
 genEqualBuf :: Gen(Buffer, BufferI)
-genEqualBuf = do s <- arbitrary ; c <- choose (0, length s) ; return ( (c, s), revFst (splitAt c s) )
-                where 
-                revFst = \(a, b) -> (reverse a, b)
+genEqualBuf = do
+  s <- arbitrary
+  c <- choose (0, length s)
+  return ((c, s), revFst (splitAt c s))
+  where
+    revFst = \(a, b) -> (reverse a, b)
 
 instance Arbitrary Char where
-        arbitrary = elements $ ['a'..'z'] ++ ['A'..'Z']
+  arbitrary = elements $ ['a'..'z'] ++ ['A'..'Z']
+
+prop_empty :: Bool
+prop_empty = emptyI <==> empty
 
 -- naive insert test, will exhaust
-prop_insert :: BufferI -> Buffer -> Char -> Property
-prop_insert bi b c = bufEqual bi b
-        ==> bufEqual (insertI c bi) (insert c b)
+--prop_insert :: BufferI -> Buffer -> Char -> Property
+--prop_insert bi b c = bi <==> b
+--  ==> insertI c bi <==> insert c b
+
+prop_insert :: BufferI -> Char -> Bool
+prop_insert bi c = insertI c bi <==> insert c (retrieve bi)
 
 -- use equal data generator
 prop_insert2 :: Char -> Property
-prop_insert2 c =
-        forAll (genEqualBuf) $ \(b, bi) -> bufEqual (insertI c bi) (insert c b)
+prop_insert2 c = forAll (genEqualBuf) $ \(b, bi) ->
+  insertI c bi <==> insert c b
+
+prop_delete :: BufferI -> Bool
+prop_delete bi = deleteI bi <==> delete (retrieve bi)
+
+prop_left :: BufferI -> Bool
+prop_left bi = leftI bi <==> left (retrieve bi)
+
+prop_right :: BufferI -> Bool
+prop_right bi = rightI bi <==> right (retrieve bi)
+
+prop_atLeft :: BufferI -> Bool
+prop_atLeft bi = atLeftI bi == atLeft (retrieve bi)
 
+prop_atRight :: BufferI -> Bool
+prop_atRight bi = atRightI bi == atRight (retrieve bi)
 
 --------------------------------------------------------------------------------
 
diff --git a/TestAufgabeFFP7.hs b/TestAufgabeFFP7.hs
index 1bbd10e..bbe3540 100755
--- a/TestAufgabeFFP7.hs
+++ b/TestAufgabeFFP7.hs
@@ -70,7 +70,71 @@ cases1 = TestLabel "buffer" $ TestList [
 
 --------------------------------------------------------------------------------
 
-cases2 = TestLabel "ssfn/minfree" $ TestList [
+cases2 = TestLabel "bufferI" $ TestList [
+  TestCase $ assertEqual "emptyI"  ("", "")
+    (emptyI),
+
+  TestCase $ assertEqual "insertI1" ("a", "")
+    (insertI 'a' emptyI),
+  TestCase $ assertEqual "insertI2" ("ba", "")
+    (insertI 'b' (insertI 'a' emptyI)),
+  TestCase $ assertEqual "insertI3" ("ba", "c")
+    (insertI 'b' ("a", "c")),
+
+  TestCase $ assertEqual "deleteI1" ("", "bc")
+    (deleteI ("", "abc")),
+  TestCase $ assertEqual "deleteI2" ("cba", "")
+    (deleteI ("cba", "")),
+  TestCase $ assertEqual "deleteI3" ("", "")
+    (deleteI ("", "")),
+
+  TestCase $ assertEqual "leftI1" ("", "abc")
+    (leftI ("", "abc")),
+  TestCase $ assertEqual "leftI2" ("a", "bc")
+    (leftI ("ba", "c")),
+  TestCase $ assertEqual "leftI3" ("ba", "c")
+    (leftI ("cba", "")),
+
+  TestCase $ assertEqual "rightI1" ("a", "bc")
+    (rightI ("", "abc")),
+  TestCase $ assertEqual "rightI2" ("ba", "c")
+    (rightI ("a", "bc")),
+  TestCase $ assertEqual "rightI3" ("cba", "")
+    (rightI ("cba", "")),
+
+  TestCase $ assertEqual "atLeftI1" (True)
+    (atLeftI ("", "abc")),
+  TestCase $ assertEqual "atLeftI2" (False)
+    (atLeftI ("a", "bc")),
+
+  TestCase $ assertEqual "atRightI1" (True)
+    (atRightI ("cba", "")),
+  TestCase $ assertEqual "atRightI2" (False)
+    (atRightI ("a", "bc"))
+  ]
+
+--------------------------------------------------------------------------------
+
+cases3 = TestLabel "buffer/I_quickCheck" $ TestList [
+  TestCase $ assertEqual "empty" ()
+    (unsafePerformIO (quickCheck prop_empty)),
+  TestCase $ assertEqual "insert" ()
+    (unsafePerformIO (quickCheck prop_insert)),
+  TestCase $ assertEqual "delete" ()
+    (unsafePerformIO (quickCheck prop_delete)),
+  TestCase $ assertEqual "left" ()
+    (unsafePerformIO (quickCheck prop_left)),
+  TestCase $ assertEqual "right" ()
+    (unsafePerformIO (quickCheck prop_right)),
+  TestCase $ assertEqual "atLeft" ()
+    (unsafePerformIO (quickCheck prop_atLeft)),
+  TestCase $ assertEqual "atRight" ()
+    (unsafePerformIO (quickCheck prop_atRight))
+  ]
+
+--------------------------------------------------------------------------------
+
+cases4 = TestLabel "ssfn/minfree" $ TestList [
   TestCase $ assertEqual "ssfn1"    (5) (ssfn [0,1,2,3,4,6,7,8,9]),
   TestCase $ assertEqual "minfree1" (5) (minfree [0,1,2,3,4,6,7,8,9]),
   TestCase $ assertEqual "ssfn2"    (0) (ssfn [1,2,3,4,5,6,7,8,9]),
@@ -87,7 +151,7 @@ cases2 = TestLabel "ssfn/minfree" $ TestList [
 --------------------------------------------------------------------------------
 
 tests :: [Test]
-tests = [cases1, cases2]
+tests = [cases1, cases2, cases3, cases4]
 
 isSuccess :: Counts -> Bool
 isSuccess Counts{ cases = _, tried = _, errors = 0, failures = 0 } = True