module Gamgine.Zipper where
import qualified Data.List as L
import qualified Data.List.Zipper as LZ


-- | get the elements before the current one
before :: LZ.Zipper a -> LZ.Zipper a
before :: forall a. Zipper a -> Zipper a
before (LZ.Zip     [] [a]
_) = Zipper a
forall a. Zipper a
LZ.empty
before (LZ.Zip (a
a:[a]
ls) [a]
_) = [a] -> [a] -> Zipper a
forall a. [a] -> [a] -> Zipper a
LZ.Zip [a]
ls [a
a]


-- | get the elements after the current one
after :: LZ.Zipper a -> LZ.Zipper a
after :: forall a. Zipper a -> Zipper a
after (LZ.Zip [a]
_     []) = Zipper a
forall a. Zipper a
LZ.empty
after (LZ.Zip [a]
_ (a
a:[a]
rs)) = [a] -> [a] -> Zipper a
forall a. [a] -> [a] -> Zipper a
LZ.Zip [] [a]
rs


-- | get the current element, might fail
current :: LZ.Zipper a -> a
current :: forall a. Zipper a -> a
current = Zipper a -> a
forall a. Zipper a -> a
LZ.cursor


-- | get the previous element, might fail
previous :: LZ.Zipper a -> a
previous :: forall a. Zipper a -> a
previous (LZ.Zip (a
p:[a]
ls) [a]
_) = a
p


-- | get the next element, might fail
next :: LZ.Zipper a -> a
next :: forall a. Zipper a -> a
next (LZ.Zip [a]
_ (a
c:a
n:[a]
_)) = a
n


-- | if the current element is the last of the list
atLast :: LZ.Zipper a -> Bool
atLast :: forall a. Zipper a -> Bool
atLast (LZ.Zip [a]
_ (a
a:[])) = Bool
True
atLast Zipper a
_                 = Bool
False


-- | if the current element is the first of the list
atFirst :: LZ.Zipper a -> Bool
atFirst :: forall a. Zipper a -> Bool
atFirst (LZ.Zip [] (a
a:[a]
ls)) = Bool
True
atFirst Zipper a
_                  = Bool
False