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
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
singleton :: a -> PointedList a
singleton x = PointedList [] x []
fromList :: [a] -> Maybe (PointedList a)
fromList [] = Nothing
fromList (x:xs) = Just $ PointedList [] x xs
fromListEnd :: [a] -> Maybe (PointedList a)
fromListEnd [] = Nothing
fromListEnd xs = Just $ PointedList xs' x []
where (x:xs') = reverse xs
focus :: PointedList a -> a
focus (PointedList _ x _) = x
next :: PointedList a -> Maybe (PointedList a)
next (PointedList _ _ []) = Nothing
next p = (Just . tryNext) p
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
previous :: PointedList a -> Maybe (PointedList a)
previous (PointedList [] _ _ ) = Nothing
previous p = (Just . tryPrevious) p
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)
insert :: a -> PointedList a -> PointedList a
insert = insertRight
insertLeft :: a -> PointedList a -> PointedList a
insertLeft y (PointedList ls x rs) = PointedList ls y (x:rs)
insertRight :: a -> PointedList a -> PointedList a
insertRight y (PointedList ls x rs) = PointedList (x:ls) y rs
delete :: PointedList a -> Maybe (PointedList a)
delete = deleteRight
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
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 []
length :: PointedList a -> Int
length = foldr (const (+1)) 0
atStart :: PointedList a -> Bool
atStart (PointedList [] _ _) = True
atStart _ = False
atEnd :: PointedList a -> Bool
atEnd (PointedList _ _ []) = True
atEnd _ = False
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
contextMap :: (PointedList a -> b) -> PointedList a -> PointedList b
contextMap f z = fmap f $ positions z