module Data.List.Zipper where import Control.Monad (liftM2) import Test.QuickCheck (Arbitrary(..), CoArbitrary(..)) import Data.Maybe (listToMaybe) data Zipper a = Zip ![a] ![a] deriving (Eq,Show) instance Arbitrary a => Arbitrary (Zipper a) where arbitrary = liftM2 Zip arbitrary arbitrary shrink (Zip ls rs) = [Zip ls' rs | ls' <- shrink ls] ++ [Zip ls rs' | rs' <- shrink rs] instance CoArbitrary a => CoArbitrary (Zipper a) where coarbitrary (Zip ls rs) = coarbitrary rs . coarbitrary ls instance Functor Zipper where fmap f (Zip ls rs) = Zip (map f ls) (map f rs) -- | @empty@ is an empty zipper empty :: Zipper a empty = Zip [] [] -- | @fromList xs@ returns a zipper containing the elements of xs, -- focused on the first element. fromList :: [a] -> Zipper a fromList as = Zip [] as -- | @fromListEnd xs@ returns a zipper containing the elements of xs, -- focused just off the right end of the list. fromListEnd :: [a] -> Zipper a fromListEnd as = Zip (reverse as) [] toList :: Zipper a -> [a] toList (Zip ls rs) = reverse ls ++ rs -- | @beginp z@ returns @True@ if the zipper is at the start. beginp :: Zipper a -> Bool beginp (Zip [] _ ) = True beginp _ = False -- | @endp z@ returns @True@ if the zipper is at the end. -- It is not safe to call @cursor@ on @z@ if @endp z@ returns @True@. endp :: Zipper a -> Bool endp (Zip _ []) = True endp _ = False -- | @emptyp z@ returns @True@ if the zipper is completely empty. -- forall z. emptyp z == beginp z && endp z emptyp :: Zipper a -> Bool emptyp (Zip [] []) = True emptyp _ = False start, end :: Zipper a -> Zipper a start (Zip ls rs) = Zip [] (reverse ls ++ rs) end (Zip ls rs) = Zip (reverse rs ++ ls) [] -- | @cursor z@ returns the targeted element in @z@. -- -- This function is not total, but the invariant is that -- @endp z == False@ means that you can safely call -- @cursor z@. cursor :: Zipper a -> a cursor (Zip _ (a:_)) = a -- | @safeCursor@ is like @cursor@ but total. safeCursor :: Zipper a -> Maybe a safeCursor (Zip _ rs) = listToMaybe rs -- | @left z@ returns the zipper with the focus -- shifted left one element. left :: Zipper a -> Zipper a left (Zip (a:ls) rs) = Zip ls (a:rs) left z = z -- | @right z@ returns the zipper with the focus -- shifted right one element; this can move the -- cursor off the end. right :: Zipper a -> Zipper a right (Zip ls (a:rs)) = Zip (a:ls) rs right z = z -- | @insert x z@ adds x at the cursor. insert :: a -> Zipper a -> Zipper a insert a (Zip ls rs) = Zip ls (a:rs) -- | @delete z@ removes the element at the cursor (if any). -- Safe to call on an empty zipper. -- forall x z. delete (insert x z) == z delete :: Zipper a -> Zipper a delete (Zip ls (_:rs)) = Zip ls rs delete z = z -- | @push x z@ inserts x into the zipper, and advances -- the cursor past it. push :: a -> Zipper a -> Zipper a push a (Zip ls rs) = Zip (a:ls) rs -- | @pop z@ removes the element before the cursor (if any). -- Safe to call on an empty zipper. -- forall x z. pop (push x z) == z pop :: Zipper a -> Zipper a pop (Zip (_:ls) rs) = Zip ls rs pop z = z -- | @replace a z@ changes the current element in the zipper -- to the passed in value. If there is no current element, -- the zipper is unchanged. If you want to add the element -- in that case instead, use @insert a (delete z)@. replace :: a -> Zipper a -> Zipper a replace a (Zip ls (_:rs)) = Zip ls (a:rs) replace _ z = z -- | @reversez z@ returns the zipper with the elements in -- the reverse order. O(1). The cursor is moved to the -- previous element, so if the cursor was at the start, -- it's now off the right end, and if it was off the -- right end, it's now at the start of the reversed list. reversez :: Zipper a -> Zipper a reversez (Zip ls rs) = Zip rs ls -- | @foldrz f x zip@ calls @f@ with the zipper focused on -- each element in order, starting with the current. -- You are guaranteed that f can safely call "cursor" on -- its argument; the zipper won't be at the end. foldrz :: (Zipper a -> b -> b) -> b -> Zipper a -> b foldrz f x = go where go z | endp z = x | otherwise = f z (go $ right z) -- | @foldlz f x zip@ calls f with the zipper focused on -- each element in order, starting with the current. -- You are guaranteed that f can safely call "cursor" on -- its argument; the zipper won't be at the end. foldlz :: (b -> Zipper a -> b) -> b -> Zipper a -> b foldlz f x z | endp z = x | otherwise = foldlz f (f x z) (right z) -- | @foldlz'@ is foldlz with a strict accumulator foldlz' :: (b -> Zipper a -> b) -> b -> Zipper a -> b foldlz' f x z | endp z = x | otherwise = acc `seq` foldlz' f acc (right z) where acc = f x z -- | @extractz@, @extendz@, and @duplicatez@ can be used to -- implement Copointed and Comonad from category-extras. I didn't -- add the instances here so as not to introduce a dependency -- on that package. extractz :: Zipper a -> a extractz = cursor duplicatez :: Zipper a -> Zipper (Zipper a) duplicatez z@(Zip ls rs) = Zip ls' rs' where rs' = foldrz (:) [] z ls' = map reversez $ foldrz (\z' xs -> right z' : xs) [] $ reversez z extendz :: (Zipper a -> b) -> Zipper a -> Zipper b extendz f z@(Zip ls rs) = Zip ls' rs' where rs' = foldrz (\z' xs -> f z' : xs) [] z ls' = foldrz (\z' xs -> f (reversez $ right z') : xs) [] $ reversez z