Skip to content
This repository
Browse code

Some basic quickcheck properties for zippers. Issue #122.

Lateral movement and saves/restores need love.

Signed-off-by: Austin Seipp <mad.one@gmail.com>
  • Loading branch information...
commit 9ab832c6df722249859334a5b4e1ddadf4245189 1 parent 2ea6dba
Austin Seipp authored January 04, 2013

Showing 1 changed file with 26 additions and 0 deletions. Show diff stats Hide diff stats

  1. 26  tests/properties.hs
26  tests/properties.hs
@@ -15,6 +15,7 @@ import Test.Framework.TH
15 15
 import Test.Framework.Providers.QuickCheck2
16 16
 import Data.Char (isAlphaNum, isAscii, toUpper)
17 17
 import Data.Text.Strict.Lens
  18
+import Data.Maybe
18 19
 import Data.List.Lens
19 20
 import Data.Functor.Compose
20 21
 import Numeric (showHex, showOct, showSigned)
@@ -152,5 +153,30 @@ prop_base_readFail (s :: String) =
152 153
     sPos = case s of { ('-':s') -> s'; _ -> s }
153 154
     isValidChar c = isAscii c && isAlphaNum c
154 155
 
  156
+-- Control.Lens.Zipper
  157
+
  158
+prop_zipper_id (NonEmpty (s :: String)) =
  159
+  (zipper s & fromWithin traverse & rezip) == s &&
  160
+  over traverse id s == s
  161
+
  162
+prop_zipper_rightmost (NonEmpty (s :: String)) =
  163
+  (zipper s & fromWithin traverse & rightmost & view focus) ==
  164
+  (zipper s & fromWithin traverse & farthest rightward & view focus)
  165
+
  166
+prop_zipper_leftmost (NonEmpty (s :: String)) =
  167
+  (zipper s & fromWithin traverse & leftmost & view focus) ==
  168
+  (zipper s & fromWithin traverse & farthest leftward & view focus)
  169
+
  170
+prop_zipper_rightward_fails (NonEmpty (s :: String)) =
  171
+  isNothing (zipper s & rightmost & rightward) &&
  172
+  isNothing (zipper s & fromWithin traverse & rightmost & rightward)
  173
+
  174
+prop_zipper_leftward_fails (NonEmpty (s :: String)) =
  175
+  isNothing (zipper s & leftmost & leftward) &&
  176
+  isNothing (zipper s & fromWithin traverse & leftmost & leftward)
  177
+
  178
+prop_zipper_tooth_id (NonEmpty (s :: String)) =
  179
+  let z = zipper s in isJust (jerkTo (tooth z) z)
  180
+
155 181
 main :: IO ()
156 182
 main = $defaultMainGenerator

0 notes on commit 9ab832c

Please sign in to comment.
Something went wrong with that request. Please try again.