-- | An implementation of a zipper-like non-empty list structure that tracks -- an index position in the list (the 'focus'). module Data.List.PointedList where import Prelude hiding (foldl, foldr) import Control.Applicative import Control.Monad import Data.Foldable import Data.List hiding (foldl, foldr) import Data.Maybe import Data.Traversable -- | The implementation of the pointed list structure which tracks the current -- position in the list structure. data PointedList a = PointedList [a] a [a] deriving (Eq, Ord) instance (Show a) => Show (PointedList a) where show (PointedList ls x rs) = show (reverse ls) ++ " " ++ show x ++ " " ++ show rs instance Functor PointedList where fmap f (PointedList ls x rs) = PointedList (map f ls) (f x) (map f rs) instance Foldable PointedList where foldr f z (PointedList ls x rs) = foldl (flip f) (foldr f z (x:rs)) ls instance Traversable PointedList where traverse f (PointedList ls x rs) = PointedList <$> (reverse <$> traverse f (reverse ls)) <*> f x <*> traverse f rs -- | Create a @PointedList@ with a single element. singleton :: a -> PointedList a singleton x = PointedList [] x [] -- | Possibly create a @Just PointedList@ if the provided list has at least one -- element; otherwise, return Nothing. -- -- The provided list's head will be the focus of the list, and the rest of -- list will follow on the right side. fromList :: [a] -> Maybe (PointedList a) fromList [] = Nothing fromList (x:xs) = Just $ PointedList [] x xs -- | Possibly create a @Just PointedList@ if the provided list has at least one -- element; otherwise, return Nothing. -- -- The provided list's last element will be the focus of the list, following -- the rest of the list in order, to the left. fromListEnd :: [a] -> Maybe (PointedList a) fromListEnd [] = Nothing fromListEnd xs = Just $ PointedList xs' x [] where (x:xs') = reverse xs -- | The focus element of the pointed list. focus :: PointedList a -> a focus (PointedList _ x _) = x -- | Possibly move the focus to the next element in the list. next :: PointedList a -> Maybe (PointedList a) next (PointedList _ _ []) = Nothing next p = (Just . tryNext) p -- GHC doesn't allow PL form here -- | Attempt to move the focus to the next element, or 'error' if there are -- no more elements. tryNext :: PointedList a -> PointedList a tryNext p@(PointedList _ _ [] ) = error "cannot move to next element" tryNext (PointedList ls x (r:rs)) = PointedList (x:ls) r rs -- | Possibly move the focus to the previous element in the list. previous :: PointedList a -> Maybe (PointedList a) previous (PointedList [] _ _ ) = Nothing previous p = (Just . tryPrevious) p -- | Attempt to move the focus to the previous element, or 'error' if there are -- no more elements. tryPrevious :: PointedList a -> PointedList a tryPrevious p@(PointedList [] _ _ ) = error "cannot move to previous element" tryPrevious (PointedList (l:ls) x rs) = PointedList ls l (x:rs) -- | An alias for 'insertRight'. insert :: a -> PointedList a -> PointedList a insert = insertRight -- | Insert an element to the left of the focus, then move the focus to the new -- element. insertLeft :: a -> PointedList a -> PointedList a insertLeft y (PointedList ls x rs) = PointedList ls y (x:rs) -- | Insert an element to the right of the focus, then move the focus to the -- new element. insertRight :: a -> PointedList a -> PointedList a insertRight y (PointedList ls x rs) = PointedList (x:ls) y rs -- | An alias of 'deleteRight'. delete :: PointedList a -> Maybe (PointedList a) delete = deleteRight -- | Possibly delete the element at the focus, then move the element on the -- left to the focus. If no element is on the left, focus on the element to -- the right. If the deletion will cause the list to be empty, return -- @Nothing@. deleteLeft :: PointedList a -> Maybe (PointedList a) deleteLeft (PointedList [] _ [] ) = Nothing deleteLeft (PointedList (l:ls) _ rs) = Just $ PointedList ls l rs deleteLeft (PointedList [] _ (r:rs)) = Just $ PointedList [] r rs -- | Possibly delete the element at the focus, then move the element on the -- right to the focus. If no element is on the right, focus on the element to -- the left. If the deletion will cause the list to be empty, return -- @Nothing@. deleteRight :: PointedList a -> Maybe (PointedList a) deleteRight (PointedList [] _ [] ) = Nothing deleteRight (PointedList ls _ (r:rs)) = Just $ PointedList ls r rs deleteRight (PointedList (l:ls) _ []) = Just $ PointedList ls l [] -- | The length of the list. length :: PointedList a -> Int length = foldr (const (+1)) 0 -- | Whether the focus is the first element. atStart :: PointedList a -> Bool atStart (PointedList [] _ _) = True atStart _ = False -- | Whether the focus is the last element. atEnd :: PointedList a -> Bool atEnd (PointedList _ _ []) = True atEnd _ = False -- | Create a @PointedList@ of variations of the provided @PointedList@, in -- which each element is focused, with the provided @PointedList@ as the -- focus of the sets. positions :: PointedList a -> PointedList (PointedList a) positions p@(PointedList ls x rs) = PointedList left p right where left = unfoldr (\p -> fmap (join (,)) $ previous p) p right = unfoldr (\p -> fmap (join (,)) $ next p) p -- | Map over the @PointedList@s created via 'positions', such that @f@ is -- called with each element of the list focused in the provided -- @PointedList@. An example makes this easier to understand: -- -- > contextMap atStart (fromJust $ fromList [1..5]) contextMap :: (PointedList a -> b) -> PointedList a -> PointedList b contextMap f z = fmap f $ positions z