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 :: Zipper a
empty = Zip [] []
fromList :: [a] -> Zipper a
fromList as = Zip [] as
fromListEnd :: [a] -> Zipper a
fromListEnd as = Zip (reverse as) []
toList :: Zipper a -> [a]
toList (Zip ls rs) = reverse ls ++ rs
beginp :: Zipper a -> Bool
beginp (Zip [] _ ) = True
beginp _ = False
endp :: Zipper a -> Bool
endp (Zip _ []) = True
endp _ = False
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 :: Zipper a -> a
cursor (Zip _ (a:_)) = a
safeCursor :: Zipper a -> Maybe a
safeCursor (Zip _ rs) = listToMaybe rs
left :: Zipper a -> Zipper a
left (Zip (a:ls) rs) = Zip ls (a:rs)
left z = z
right :: Zipper a -> Zipper a
right (Zip ls (a:rs)) = Zip (a:ls) rs
right z = z
insert :: a -> Zipper a -> Zipper a
insert a (Zip ls rs) = Zip ls (a:rs)
delete :: Zipper a -> Zipper a
delete (Zip ls (_:rs)) = Zip ls rs
delete z = z
push :: a -> Zipper a -> Zipper a
push a (Zip ls rs) = Zip (a:ls) rs
pop :: Zipper a -> Zipper a
pop (Zip (_:ls) rs) = Zip ls rs
pop z = z
replace :: a -> Zipper a -> Zipper a
replace a (Zip ls (_:rs)) = Zip ls (a:rs)
replace _ z = z
reversez :: Zipper a -> Zipper a
reversez (Zip ls rs) = Zip rs ls
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 :: (b -> Zipper a -> b) -> b -> Zipper a -> b
foldlz f x z
| endp z = x
| otherwise = foldlz f (f x z) (right z)
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 :: 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