Playing with zipper, witch is a new concept for me

ListZipper.hs

module ListZipper (
    focused, focusedIndex,setFocusedIndex, setUnfocused,
    forward, backward,
    append,
    toList, fromList
    )
where


type Zipper a = ([a], [a])


focused :: Zipper a -> Maybe a
focused (_, x:_) = Just x
focused (_, []) = Nothing


focusedIndex :: Zipper a -> Maybe Int
focusedIndex (_, []) = Nothing
focusedIndex (path, _) = Just (length path)


setFocusedIndex :: Zipper a -> Int -> Zipper a
setFocusedIndex zipper@([],[]) _  = zipper
setFocusedIndex zipper index | index >= 0  && index < length (toList zipper) =  splitAt index (toList zipper)
                             | index >= length (toList zipper)               = zipper
                             | otherwise                                     = zipper


setUnfocused :: Zipper a -> Zipper a
setUnfocused zipper = (reverse (toList zipper), [])


forward :: Zipper a -> Zipper a
forward zipper@(_, [_]) = zipper
forward (path, []) = (path, [])
forward (path, x:xs) = (x:path, xs)



backward :: Zipper a -> Zipper a
backward (x:xs, lst) = (xs, x:lst)
backward ([], lst) = ([], lst)


append :: Zipper a -> a -> Zipper a 
append (path, lst) elt = (path, lst ++ [elt])


toList :: Zipper a -> [a]
toList (path, lst) = reverse path ++ lst


fromList :: [a] -> Zipper a
fromList lst = ([], lst)

ListZipperQuickCheck.hs

import Test.QuickCheck

import ListZipper

type Zipper a = ([a], [a])

prop_focused :: Zipper Int -> Bool
prop_focused z@(_, x:_) = focused z == Just x
prop_focused z@(_, []) = focused z == Nothing


prop_focusedIndex :: Zipper Int -> Bool
prop_focusedIndex z@(_, []) = focusedIndex z == Nothing
prop_focusedIndex z@(path, _) = focusedIndex z == Just (length path)


prop_setFocusedIndex :: Zipper Int -> Int -> Bool
prop_setFocusedIndex z@([], []) i = setFocusedIndex z i == z
prop_setFocusedIndex z i | i >= 0 && i < length (toList z) = focusedIndex (setFocusedIndex z i) == Just i
                         | i >= length (toList z)          = setFocusedIndex z i == z
                         | otherwise                       = setFocusedIndex z i == z
                         

prop_setUnfocused :: Zipper Int -> Bool
prop_setUnfocused z = focused (setUnfocused z) == Nothing


forwardBackward :: Zipper Int -> Property
forwardBackward z@(path, lst) = 
    path /= [] && length lst > 1 ==> (forward . backward) z == (backward . forward) z && (backward . forward ) z == z
    
    
prop_forward :: Zipper Int -> Bool
prop_forward z@(_, []) = forward z == z
prop_forward z@(_, [_]) = forward z == z
prop_forward z@(path, x:xs) = forward z == (x:path, xs)

   
prop_backward :: Zipper Int -> Bool
prop_backward z@([], _) = backward z == z
prop_backward z@(x:xs, lst) = backward z == (xs, x:lst)


prop_fromListToList :: [Int] -> Bool
prop_fromListToList lst = toList (fromList lst) == lst

prop_listLoosesFocus :: [Int] -> Bool
prop_listLoosesFocus lst = (toList . forward . fromList) lst == lst


prop_append :: Zipper Int -> Int -> Bool
prop_append z e = toList (append z e) == (toList z) ++ [e]


main :: IO()
main = do
    run "prop_focused" prop_focused
    run "prop_focusedIndex" prop_focusedIndex
    run "prop_setFocusedIndex" prop_setFocusedIndex
    run "prop_setUnfocused" prop_setUnfocused
    run "forwardBackward" forwardBackward
    run "prop_forward" prop_forward
    run "prop_backward" prop_backward
    run "prop_fromListToList" prop_fromListToList
    run "prop_listLoosesFocus" prop_listLoosesFocus
    run "prop_append" prop_append
    
   
    
run :: Testable t => String -> t -> IO()
run message testable = do
    putStr $ message ++ ": "
    quickCheck testable