Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

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
@thoughtpolice thoughtpolice authored
Showing with 26 additions and 0 deletions.
  1. +26 −0 tests/properties.hs
View
26 tests/properties.hs
@@ -15,6 +15,7 @@ import Test.Framework.TH
import Test.Framework.Providers.QuickCheck2
import Data.Char (isAlphaNum, isAscii, toUpper)
import Data.Text.Strict.Lens
+import Data.Maybe
import Data.List.Lens
import Data.Functor.Compose
import Numeric (showHex, showOct, showSigned)
@@ -152,5 +153,30 @@ prop_base_readFail (s :: String) =
sPos = case s of { ('-':s') -> s'; _ -> s }
isValidChar c = isAscii c && isAlphaNum c
+-- Control.Lens.Zipper
+
+prop_zipper_id (NonEmpty (s :: String)) =
+ (zipper s & fromWithin traverse & rezip) == s &&
+ over traverse id s == s
+
+prop_zipper_rightmost (NonEmpty (s :: String)) =
+ (zipper s & fromWithin traverse & rightmost & view focus) ==
+ (zipper s & fromWithin traverse & farthest rightward & view focus)
+
+prop_zipper_leftmost (NonEmpty (s :: String)) =
+ (zipper s & fromWithin traverse & leftmost & view focus) ==
+ (zipper s & fromWithin traverse & farthest leftward & view focus)
+
+prop_zipper_rightward_fails (NonEmpty (s :: String)) =
+ isNothing (zipper s & rightmost & rightward) &&
+ isNothing (zipper s & fromWithin traverse & rightmost & rightward)
+
+prop_zipper_leftward_fails (NonEmpty (s :: String)) =
+ isNothing (zipper s & leftmost & leftward) &&
+ isNothing (zipper s & fromWithin traverse & leftmost & leftward)
+
+prop_zipper_tooth_id (NonEmpty (s :: String)) =
+ let z = zipper s in isJust (jerkTo (tooth z) z)
+
main :: IO ()
main = $defaultMainGenerator
Please sign in to comment.
Something went wrong with that request. Please try again.