diff options
Diffstat (limited to 'AufgabeFFP7.hs')
| -rw-r--r-- | AufgabeFFP7.hs | 64 |
1 files changed, 46 insertions, 18 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 | |||
| 2 | where | 2 | where |
| 3 | 3 | ||
| 4 | import Data.Char | 4 | import Data.Char |
| 5 | import Data.List hiding ((\\), insert) | 5 | import Data.List hiding ((\\), insert, delete) |
| 6 | import Test.QuickCheck | 6 | import Test.QuickCheck |
| 7 | 7 | ||
| 8 | type Buffer = (Int, String) | 8 | type Buffer = (Int, String) |
| @@ -55,26 +55,29 @@ insertI :: Char -> BufferI -> BufferI | |||
| 55 | insertI c (beforeC, afterC) = ([c] ++ beforeC, afterC) | 55 | insertI c (beforeC, afterC) = ([c] ++ beforeC, afterC) |
| 56 | 56 | ||
| 57 | -- delete character before cursor | 57 | -- delete character before cursor |
| 58 | --TODO deleteI :: BufferI -> BufferI | 58 | deleteI :: BufferI -> BufferI |
| 59 | deleteI (beforeC, "") = (beforeC, "") | ||
| 60 | deleteI (beforeC, last:afterC) = (beforeC, afterC) | ||
| 59 | 61 | ||
| 60 | -- move cursor left one character | 62 | -- move cursor left one character |
| 61 | leftI :: BufferI -> BufferI | 63 | leftI :: BufferI -> BufferI |
| 62 | leftI ([], afterC) = ([], afterC) | 64 | leftI ("", afterC) = ("", afterC) |
| 63 | leftI (last:beforeC, afterC) = (beforeC, [last] ++ afterC) | 65 | leftI (last:beforeC, afterC) = (beforeC, [last] ++ afterC) |
| 64 | 66 | ||
| 65 | -- move cursor right one character | 67 | -- move cursor right one character |
| 66 | --TODO rightI :: BufferI -> BufferI | 68 | rightI :: BufferI -> BufferI |
| 69 | rightI (beforeC, "") = (beforeC, "") | ||
| 70 | rightI (beforeC, last:afterC) = ([last] ++ beforeC, afterC) | ||
| 67 | 71 | ||
| 68 | -- is cursor at left end? | 72 | -- is cursor at left end? |
| 69 | atLeftI :: BufferI -> Bool | 73 | atLeftI :: BufferI -> Bool |
| 70 | atLeftI ([], _) = True | 74 | atLeftI ("", _) = True |
| 71 | atLeftI (_, _) = False | 75 | atLeftI (_, _) = False |
| 72 | 76 | ||
| 73 | -- is cursor at right end? | 77 | -- is cursor at right end? |
| 74 | atRightI :: BufferI -> Bool | 78 | atRightI :: BufferI -> Bool |
| 75 | atRightI (_, []) = True | 79 | atRightI (_, "") = True |
| 76 | atRightI (_, _) = False | 80 | atRightI (_, _) = False |
| 77 | |||
| 78 | 81 | ||
| 79 | -------------------------------------------------------------------------------- | 82 | -------------------------------------------------------------------------------- |
| 80 | 83 | ||
| @@ -88,25 +91,50 @@ retrieve (beforeC, afterC) = (length beforeC, (reverse beforeC) ++ afterC) | |||
| 88 | bufEqual :: BufferI -> Buffer -> Bool | 91 | bufEqual :: BufferI -> Buffer -> Bool |
| 89 | bufEqual bi b = (retrieve bi) == b | 92 | bufEqual bi b = (retrieve bi) == b |
| 90 | 93 | ||
| 94 | (<==>) = bufEqual | ||
| 95 | |||
| 91 | -- generator for equal data | 96 | -- generator for equal data |
| 92 | genEqualBuf :: Gen(Buffer, BufferI) | 97 | genEqualBuf :: Gen(Buffer, BufferI) |
| 93 | genEqualBuf = do s <- arbitrary ; c <- choose (0, length s) ; return ( (c, s), revFst (splitAt c s) ) | 98 | genEqualBuf = do |
| 94 | where | 99 | s <- arbitrary |
| 95 | revFst = \(a, b) -> (reverse a, b) | 100 | c <- choose (0, length s) |
| 101 | return ((c, s), revFst (splitAt c s)) | ||
| 102 | where | ||
| 103 | revFst = \(a, b) -> (reverse a, b) | ||
| 96 | 104 | ||
| 97 | instance Arbitrary Char where | 105 | instance Arbitrary Char where |
| 98 | arbitrary = elements $ ['a'..'z'] ++ ['A'..'Z'] | 106 | arbitrary = elements $ ['a'..'z'] ++ ['A'..'Z'] |
| 107 | |||
| 108 | prop_empty :: Bool | ||
| 109 | prop_empty = emptyI <==> empty | ||
| 99 | 110 | ||
| 100 | -- naive insert test, will exhaust | 111 | -- naive insert test, will exhaust |
| 101 | prop_insert :: BufferI -> Buffer -> Char -> Property | 112 | --prop_insert :: BufferI -> Buffer -> Char -> Property |
| 102 | prop_insert bi b c = bufEqual bi b | 113 | --prop_insert bi b c = bi <==> b |
| 103 | ==> bufEqual (insertI c bi) (insert c b) | 114 | -- ==> insertI c bi <==> insert c b |
| 115 | |||
| 116 | prop_insert :: BufferI -> Char -> Bool | ||
| 117 | prop_insert bi c = insertI c bi <==> insert c (retrieve bi) | ||
| 104 | 118 | ||
| 105 | -- use equal data generator | 119 | -- use equal data generator |
| 106 | prop_insert2 :: Char -> Property | 120 | prop_insert2 :: Char -> Property |
| 107 | prop_insert2 c = | 121 | prop_insert2 c = forAll (genEqualBuf) $ \(b, bi) -> |
| 108 | forAll (genEqualBuf) $ \(b, bi) -> bufEqual (insertI c bi) (insert c b) | 122 | insertI c bi <==> insert c b |
| 123 | |||
| 124 | prop_delete :: BufferI -> Bool | ||
| 125 | prop_delete bi = deleteI bi <==> delete (retrieve bi) | ||
| 126 | |||
| 127 | prop_left :: BufferI -> Bool | ||
| 128 | prop_left bi = leftI bi <==> left (retrieve bi) | ||
| 129 | |||
| 130 | prop_right :: BufferI -> Bool | ||
| 131 | prop_right bi = rightI bi <==> right (retrieve bi) | ||
| 132 | |||
| 133 | prop_atLeft :: BufferI -> Bool | ||
| 134 | prop_atLeft bi = atLeftI bi == atLeft (retrieve bi) | ||
| 109 | 135 | ||
| 136 | prop_atRight :: BufferI -> Bool | ||
| 137 | prop_atRight bi = atRightI bi == atRight (retrieve bi) | ||
| 110 | 138 | ||
| 111 | -------------------------------------------------------------------------------- | 139 | -------------------------------------------------------------------------------- |
| 112 | 140 | ||
