data ZipList a = ZL [a] a [a] deriving (Eq, Show)
test :: ZipList Int
test = ZL [3,2,1] 4 [5,6,7]
-- Create a new empty list and make e the default item that is
newZipList :: a -> ZipList a
newZipList x = ZL [] x []
-- Returns true if only one item present
-- i.e. the left and right lists are empty
isSingleton :: ZipList a -> Bool
isSingleton (ZL [] _ []) = True
isSingleton _ = False
-- Move the current item one place forwards in the list
after :: ZipList a -> ZipList a
after (ZL ls x []) = ZL ls x [] -- Can't go any further right
after (ZL ls x (r:rs)) = ZL (x:ls) r rs
-- Move the current item one place backwards in the list
before :: ZipList a -> ZipList a
before (ZL [] x rs) = ZL [] x rs -- Can't go any further left
before (ZL (l:ls) x rs) = ZL ls l (x:rs)
-- Get the current item
get :: ZipList a -> a
get (ZL _ x _) = x
-- Replace the current item
set :: a -> ZipList a -> ZipList a
set y (ZL ls x rs) = ZL ls y rs
-- Inserts an item after the current item and makes it the current item
insertAfter :: a -> ZipList a -> ZipList a
insertAfter y (ZL ls x rs) = ZL (x:ls) y rs
-- Inserts an item before the current item and makes it the current item
insertBefore :: a -> ZipList a -> ZipList a
insertBefore y (ZL ls x rs) = ZL ls y (x:rs)
-- Delete the current item and make its successor the current item.
-- If deleteToAfter is called while there is only one item left,
-- keep the zip list the same (there must always be at least one item).
-- If deleteToAfter is called while there are no successors, but there
-- is at least one predecessor, delete the current item and make the
-- predecessor the current item.
deleteToAfter :: ZipList a -> ZipList a
deleteToAfter (ZL [] x []) = ZL [] x [] -- Not allowed to delete last element, must have at least one
deleteToAfter (ZL (l:ls) x []) = ZL ls l []
deleteToAfter (ZL ls x (r:rs)) = ZL ls r rs
-- Delete the current item and make its predecessor the current item.
-- If deleteToBefore is called while there is only one item left,
-- keep the zip list the same (there must always be at least one item).
-- If deleteToAfter is called while there are no predecessors, but there
-- is at least one successor, delete the current item and make the
-- successor the current item.
deleteToBefore :: ZipList a -> ZipList a
deleteToBefore (ZL [] x []) = ZL [] x [] -- Not allowed to delete last element, must have at least one
deleteToBefore (ZL (l:ls) x rs) = ZL ls l rs
deleteToBefore (ZL [] x (r:rs)) = ZL [] r rs
-- Set the current item to the first item
firstZ :: ZipList a -> ZipList a
firstZ (ZL [] x rs) = ZL [] x rs
firstZ (ZL (l:ls) x rs) = firstZ (ZL ls l (x:rs))
-- Set the current item to the last item
lastZ :: ZipList a -> ZipList a
lastZ (ZL ls x []) = ZL ls x []
lastZ (ZL ls x (r:rs)) = lastZ (ZL (x:ls) r rs)
-- Pretty printing
data ZipElem a = Focus a | NotFocus a
instance Show a => Show (ZipElem a) where
show (Focus x) = "(" ++ show x ++ ")"
show (NotFocus x) = " " ++ show x ++ " "
pretty :: Show a => ZipList a -> String
pretty (ZL ls x rs) = show $ map NotFocus (reverse ls) ++ [Focus x] ++ map NotFocus rs
prettyPrint :: Show a => ZipList a -> IO ()
prettyPrint = putStrLn . pretty