ListZipper.hs

module Helper.ListZipper 
    ( 
     ListZipper(..)
    , focus
    , left
    , right
    , reset
    , fromList
    , toZippers
    , toList
    , next
    , atEnd 
    , at
    )
where
import Data.Maybe
import Data.Monoid
import Data.Foldable (Foldable,foldMap)


data ListZipper a = LZ [a] (Maybe a) [a]  deriving (Show,Eq,Ord)

left :: ListZipper a -> [a]
left  (LZ xs _ _) = xs

focus :: ListZipper a -> Maybe a
focus (LZ _ x _)  = x

right :: ListZipper a -> [a]
right (LZ _ _ ys) = ys

fromList []     = LZ [] Nothing [] 
fromList (x:xs) = LZ [] (Just x) xs

toZippers xs = let zs = iterate next . fromList $ xs
               in map snd . zip xs $ zs

toList (LZ xs (Just x) ys) = reverse xs ++ [x] ++ ys
toList (LZ xs Nothing [])  = reverse xs

next :: ListZipper a -> ListZipper a
next = nextWith id id
nextWith f g (LZ lxs (Just x) rxs)  =
    case rxs of
      y:ys -> LZ (f x:lxs) (Just (g y)) ys
      []   -> LZ (f x:lxs) Nothing []

atEnd :: ListZipper a -> Bool
atEnd = isNothing . focus

reset (LZ [] (Just y) ys)     = LZ [] (Just y) ys
reset (LZ [] Nothing [])      = LZ [] Nothing []
reset (LZ xs (Just y) ys) = LZ [] (Just z) (zs++[y]++ys)
    where z:zs = reverse xs                    
reset (LZ xs Nothing [])  = LZ [] (Just z) zs
    where z:zs = reverse xs

from :: (Monoid m) => Maybe m -> m
from Nothing  = mempty
from (Just x) = x

index 1 (x:xs)  = Just x
index i []  = Nothing
index i (x:xs) = index (i-1) xs

at :: (Monoid m) =>  ListZipper m -> Int -> m
at  z 0 = from . focus $ z
at  z i | i < 0 = from .  index (negate i) . left  $ z
at  z i         = from .  index i          . right $ z

instance Functor ListZipper where
    fmap f (LZ ls x rs) = LZ (fmap f ls) (fmap f x) (fmap f rs) 
instance Foldable ListZipper where
    foldMap f (LZ ls x rs) = mconcat $ fmap f (reverse ls) 
                             ++ [from $ fmap f x] ++ fmap f rs