{-# LANGUAGE TypeOperators #-}

-- | 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, elem)

import Control.Applicative
import Control.Monad
import Data.Binary
import Data.Foldable hiding (find)
import Data.List hiding (length, foldl, foldr, find, elem)
import qualified Data.List as List
import Data.Traversable

-- | The implementation of the pointed list structure which tracks the current
--   position in the list structure.
data PointedList a = PointedList
  { PointedList a -> [a]
_reversedPrefix :: [a]
  , PointedList a -> a
_focus          :: a
  , PointedList a -> [a]
_suffix         :: [a]
  } deriving (PointedList a -> PointedList a -> Bool
(PointedList a -> PointedList a -> Bool)
-> (PointedList a -> PointedList a -> Bool) -> Eq (PointedList a)
forall a. Eq a => PointedList a -> PointedList a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PointedList a -> PointedList a -> Bool
$c/= :: forall a. Eq a => PointedList a -> PointedList a -> Bool
== :: PointedList a -> PointedList a -> Bool
$c== :: forall a. Eq a => PointedList a -> PointedList a -> Bool
Eq)

instance Binary a => Binary (PointedList a) where
  put :: PointedList a -> Put
put (PointedList x1 :: [a]
x1 x2 :: a
x2 x3 :: [a]
x3) = do [a] -> Put
forall t. Binary t => t -> Put
put [a]
x1; a -> Put
forall t. Binary t => t -> Put
put a
x2; [a] -> Put
forall t. Binary t => t -> Put
put [a]
x3
  get :: Get (PointedList a)
get = do ([a] -> a -> [a] -> PointedList a)
-> Get [a] -> Get a -> Get [a] -> Get (PointedList a)
forall (m :: * -> *) a1 a2 a3 r.
Monad m =>
(a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
liftM3 [a] -> a -> [a] -> PointedList a
forall a. [a] -> a -> [a] -> PointedList a
PointedList Get [a]
forall t. Binary t => Get t
get Get a
forall t. Binary t => Get t
get Get [a]
forall t. Binary t => Get t
get

-- | Lens compatible with Control.Lens.
reversedPrefix :: Functor f => ([a] -> f [a]) -> PointedList a -> f (PointedList a)
reversedPrefix :: ([a] -> f [a]) -> PointedList a -> f (PointedList a)
reversedPrefix f :: [a] -> f [a]
f (PointedList ls :: [a]
ls x :: a
x rs :: [a]
rs) = (\ls' :: [a]
ls' -> [a] -> a -> [a] -> PointedList a
forall a. [a] -> a -> [a] -> PointedList a
PointedList [a]
ls' a
x [a]
rs) ([a] -> PointedList a) -> f [a] -> f (PointedList a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> f [a]
f [a]
ls

-- | Lens compatible with Control.Lens.
focus :: Functor f => (a -> f a) -> PointedList a -> f (PointedList a)
focus :: (a -> f a) -> PointedList a -> f (PointedList a)
focus f :: a -> f a
f (PointedList ls :: [a]
ls x :: a
x rs :: [a]
rs) = (\x' :: a
x' -> [a] -> a -> [a] -> PointedList a
forall a. [a] -> a -> [a] -> PointedList a
PointedList [a]
ls a
x' [a]
rs) (a -> PointedList a) -> f a -> f (PointedList a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f a
f a
x

-- | Lens compatible with Control.Lens.
suffix :: Functor f => ([a] -> f [a]) -> PointedList a -> f (PointedList a)
suffix :: ([a] -> f [a]) -> PointedList a -> f (PointedList a)
suffix f :: [a] -> f [a]
f (PointedList ls :: [a]
ls x :: a
x rs :: [a]
rs) = (\rs' :: [a]
rs' -> [a] -> a -> [a] -> PointedList a
forall a. [a] -> a -> [a] -> PointedList a
PointedList [a]
ls a
x [a]
rs') ([a] -> PointedList a) -> f [a] -> f (PointedList a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> f [a]
f [a]
rs

-- | Lens compatible with Control.Lens.
-- Internally reversing the prefix list.
prefix :: Functor f => ([a] -> f [a]) -> PointedList a -> f (PointedList a)
prefix :: ([a] -> f [a]) -> PointedList a -> f (PointedList a)
prefix f :: [a] -> f [a]
f (PointedList ls :: [a]
ls x :: a
x rs :: [a]
rs) = (\ls' :: [a]
ls' -> [a] -> a -> [a] -> PointedList a
forall a. [a] -> a -> [a] -> PointedList a
PointedList ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
ls') a
x [a]
rs) ([a] -> PointedList a) -> f [a] -> f (PointedList a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> f [a]
f ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
ls)

instance (Show a) => Show (PointedList a) where
 show :: PointedList a -> String
show (PointedList ls :: [a]
ls x :: a
x rs :: [a]
rs) = [a] -> String
forall a. Show a => a -> String
show ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
ls) String -> ShowS
forall a. [a] -> [a] -> [a]
++ " " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ " " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [a] -> String
forall a. Show a => a -> String
show [a]
rs

instance Functor PointedList where
 fmap :: (a -> b) -> PointedList a -> PointedList b
fmap f :: a -> b
f (PointedList ls :: [a]
ls x :: a
x rs :: [a]
rs) = [b] -> b -> [b] -> PointedList b
forall a. [a] -> a -> [a] -> PointedList a
PointedList ((a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
f [a]
ls) (a -> b
f a
x) ((a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
f [a]
rs)

instance Foldable PointedList where
 foldr :: (a -> b -> b) -> b -> PointedList a -> b
foldr f :: a -> b -> b
f z :: b
z (PointedList ls :: [a]
ls x :: a
x rs :: [a]
rs) = (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ((a -> b -> b) -> b -> a -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> b -> b
f) ((a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
f b
z (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
rs)) [a]
ls

instance Traversable PointedList where
 traverse :: (a -> f b) -> PointedList a -> f (PointedList b)
traverse f :: a -> f b
f (PointedList ls :: [a]
ls x :: a
x rs :: [a]
rs) = [b] -> b -> [b] -> PointedList b
forall a. [a] -> a -> [a] -> PointedList a
PointedList ([b] -> b -> [b] -> PointedList b)
-> f [b] -> f (b -> [b] -> PointedList b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    ([b] -> [b]
forall a. [a] -> [a]
reverse ([b] -> [b]) -> f [b] -> f [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> [a] -> f [b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
ls)) f (b -> [b] -> PointedList b) -> f b -> f ([b] -> PointedList b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
f a
x f ([b] -> PointedList b) -> f [b] -> f (PointedList b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> f b) -> [a] -> f [b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f [a]
rs

-- | Create a 'PointedList' with a single element.
singleton :: a -> PointedList a
singleton :: a -> PointedList a
singleton x :: a
x = [a] -> a -> [a] -> PointedList a
forall a. [a] -> a -> [a] -> PointedList a
PointedList [] a
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 :: [a] -> Maybe (PointedList a)
fromList []     = Maybe (PointedList a)
forall a. Maybe a
Nothing
fromList (x :: a
x:xs :: [a]
xs) = PointedList a -> Maybe (PointedList a)
forall a. a -> Maybe a
Just (PointedList a -> Maybe (PointedList a))
-> PointedList a -> Maybe (PointedList a)
forall a b. (a -> b) -> a -> b
$ [a] -> a -> [a] -> PointedList a
forall a. [a] -> a -> [a] -> PointedList a
PointedList [] a
x [a]
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 :: [a] -> Maybe (PointedList a)
fromListEnd [] = Maybe (PointedList a)
forall a. Maybe a
Nothing
fromListEnd xs :: [a]
xs = PointedList a -> Maybe (PointedList a)
forall a. a -> Maybe a
Just (PointedList a -> Maybe (PointedList a))
-> PointedList a -> Maybe (PointedList a)
forall a b. (a -> b) -> a -> b
$ [a] -> a -> [a] -> PointedList a
forall a. [a] -> a -> [a] -> PointedList a
PointedList [a]
xs' a
x []
 where (x :: a
x:xs' :: [a]
xs') = [a] -> [a]
forall a. [a] -> [a]
reverse [a]
xs

-- | Replace the focus of the list, retaining the prefix and suffix.
replace :: a -> PointedList a -> PointedList a
replace :: a -> PointedList a -> PointedList a
replace x :: a
x (PointedList ls :: [a]
ls _ rs :: [a]
rs) = [a] -> a -> [a] -> PointedList a
forall a. [a] -> a -> [a] -> PointedList a
PointedList [a]
ls a
x [a]
rs
-- replace = set focus

-- | Possibly move the focus to the next element in the list.
next :: PointedList a -> Maybe (PointedList a)
next :: PointedList a -> Maybe (PointedList a)
next (PointedList _  _ []) = Maybe (PointedList a)
forall a. Maybe a
Nothing
next p :: PointedList a
p = (PointedList a -> Maybe (PointedList a)
forall a. a -> Maybe a
Just (PointedList a -> Maybe (PointedList a))
-> (PointedList a -> PointedList a)
-> PointedList a
-> Maybe (PointedList a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PointedList a -> PointedList a
forall a. PointedList a -> PointedList a
tryNext) PointedList a
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 :: PointedList a -> PointedList a
tryNext p :: PointedList a
p@(PointedList _  _ []    ) = String -> PointedList a
forall a. HasCallStack => String -> a
error "cannot move to next element"
tryNext   (PointedList ls :: [a]
ls x :: a
x (r :: a
r:rs :: [a]
rs)) = [a] -> a -> [a] -> PointedList a
forall a. [a] -> a -> [a] -> PointedList a
PointedList (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ls) a
r [a]
rs

-- | Possibly move the focus to the previous element in the list.
previous :: PointedList a -> Maybe (PointedList a)
previous :: PointedList a -> Maybe (PointedList a)
previous (PointedList [] _ _ ) = Maybe (PointedList a)
forall a. Maybe a
Nothing
previous p :: PointedList a
p = (PointedList a -> Maybe (PointedList a)
forall a. a -> Maybe a
Just (PointedList a -> Maybe (PointedList a))
-> (PointedList a -> PointedList a)
-> PointedList a
-> Maybe (PointedList a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PointedList a -> PointedList a
forall a. PointedList a -> PointedList a
tryPrevious) PointedList a
p

-- | Attempt to move the focus to the previous element, or 'error' if there are
--   no more elements.
tryPrevious :: PointedList a -> PointedList a
tryPrevious :: PointedList a -> PointedList a
tryPrevious p :: PointedList a
p@(PointedList []     _ _ ) =
  String -> PointedList a
forall a. HasCallStack => String -> a
error "cannot move to previous element" 
tryPrevious   (PointedList (l :: a
l:ls :: [a]
ls) x :: a
x rs :: [a]
rs) = [a] -> a -> [a] -> PointedList a
forall a. [a] -> a -> [a] -> PointedList a
PointedList [a]
ls a
l (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
rs)

-- | An alias for 'insertRight'.
insert :: a -> PointedList a -> PointedList a
insert :: a -> PointedList a -> PointedList a
insert = a -> PointedList a -> PointedList a
forall a. a -> PointedList a -> PointedList a
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 :: a -> PointedList a -> PointedList a
insertLeft y :: a
y (PointedList ls :: [a]
ls x :: a
x rs :: [a]
rs) = [a] -> a -> [a] -> PointedList a
forall a. [a] -> a -> [a] -> PointedList a
PointedList [a]
ls a
y (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
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 :: a -> PointedList a -> PointedList a
insertRight y :: a
y (PointedList ls :: [a]
ls x :: a
x rs :: [a]
rs) = [a] -> a -> [a] -> PointedList a
forall a. [a] -> a -> [a] -> PointedList a
PointedList (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ls) a
y [a]
rs

-- | An alias of 'deleteRight'.
delete :: PointedList a -> Maybe (PointedList a)
delete :: PointedList a -> Maybe (PointedList a)
delete = PointedList a -> Maybe (PointedList a)
forall a. PointedList a -> Maybe (PointedList a)
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 a -> Maybe (PointedList a)
deleteLeft (PointedList [] _ []    ) = Maybe (PointedList a)
forall a. Maybe a
Nothing
deleteLeft (PointedList (l :: a
l:ls :: [a]
ls) _ rs :: [a]
rs) = PointedList a -> Maybe (PointedList a)
forall a. a -> Maybe a
Just (PointedList a -> Maybe (PointedList a))
-> PointedList a -> Maybe (PointedList a)
forall a b. (a -> b) -> a -> b
$ [a] -> a -> [a] -> PointedList a
forall a. [a] -> a -> [a] -> PointedList a
PointedList [a]
ls a
l [a]
rs
deleteLeft (PointedList [] _ (r :: a
r:rs :: [a]
rs)) = PointedList a -> Maybe (PointedList a)
forall a. a -> Maybe a
Just (PointedList a -> Maybe (PointedList a))
-> PointedList a -> Maybe (PointedList a)
forall a b. (a -> b) -> a -> b
$ [a] -> a -> [a] -> PointedList a
forall a. [a] -> a -> [a] -> PointedList a
PointedList [] a
r [a]
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 a -> Maybe (PointedList a)
deleteRight (PointedList [] _ []    ) = Maybe (PointedList a)
forall a. Maybe a
Nothing
deleteRight (PointedList ls :: [a]
ls _ (r :: a
r:rs :: [a]
rs)) = PointedList a -> Maybe (PointedList a)
forall a. a -> Maybe a
Just (PointedList a -> Maybe (PointedList a))
-> PointedList a -> Maybe (PointedList a)
forall a b. (a -> b) -> a -> b
$ [a] -> a -> [a] -> PointedList a
forall a. [a] -> a -> [a] -> PointedList a
PointedList [a]
ls a
r [a]
rs
deleteRight (PointedList (l :: a
l:ls :: [a]
ls) _ []) = PointedList a -> Maybe (PointedList a)
forall a. a -> Maybe a
Just (PointedList a -> Maybe (PointedList a))
-> PointedList a -> Maybe (PointedList a)
forall a b. (a -> b) -> a -> b
$ [a] -> a -> [a] -> PointedList a
forall a. [a] -> a -> [a] -> PointedList a
PointedList [a]
ls a
l []

-- | Delete all elements in the list except the focus.
deleteOthers :: PointedList a -> PointedList a
deleteOthers :: PointedList a -> PointedList a
deleteOthers (PointedList _ b :: a
b _) = [a] -> a -> [a] -> PointedList a
forall a. [a] -> a -> [a] -> PointedList a
PointedList [] a
b []

-- | The length of the list.
length :: PointedList a -> Int
length :: PointedList a -> Int
length = (a -> Int -> Int) -> Int -> PointedList a -> Int
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((Int -> Int) -> a -> Int -> Int
forall a b. a -> b -> a
const (Int -> Int -> Int
forall a. Num a => a -> a -> a
+1)) 0

-- | Whether the focus is the first element.
atStart :: PointedList a -> Bool
atStart :: PointedList a -> Bool
atStart (PointedList [] _ _) = Bool
True
atStart _ = Bool
False

-- | Whether the focus is the last element.
atEnd :: PointedList a -> Bool
atEnd :: PointedList a -> Bool
atEnd (PointedList _ _ []) = Bool
True
atEnd _ = Bool
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 :: PointedList a -> PointedList (PointedList a)
positions p :: PointedList a
p@(PointedList ls :: [a]
ls x :: a
x rs :: [a]
rs) = [PointedList a]
-> PointedList a -> [PointedList a] -> PointedList (PointedList a)
forall a. [a] -> a -> [a] -> PointedList a
PointedList [PointedList a]
left PointedList a
p [PointedList a]
right
  where left :: [PointedList a]
left  = (PointedList a -> Maybe (PointedList a, PointedList a))
-> PointedList a -> [PointedList a]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr (\p :: PointedList a
p -> (PointedList a -> (PointedList a, PointedList a))
-> Maybe (PointedList a) -> Maybe (PointedList a, PointedList a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((PointedList a -> PointedList a -> (PointedList a, PointedList a))
-> PointedList a -> (PointedList a, PointedList a)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (,)) (Maybe (PointedList a) -> Maybe (PointedList a, PointedList a))
-> Maybe (PointedList a) -> Maybe (PointedList a, PointedList a)
forall a b. (a -> b) -> a -> b
$ PointedList a -> Maybe (PointedList a)
forall a. PointedList a -> Maybe (PointedList a)
previous PointedList a
p) PointedList a
p
        right :: [PointedList a]
right = (PointedList a -> Maybe (PointedList a, PointedList a))
-> PointedList a -> [PointedList a]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr (\p :: PointedList a
p -> (PointedList a -> (PointedList a, PointedList a))
-> Maybe (PointedList a) -> Maybe (PointedList a, PointedList a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((PointedList a -> PointedList a -> (PointedList a, PointedList a))
-> PointedList a -> (PointedList a, PointedList a)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (,)) (Maybe (PointedList a) -> Maybe (PointedList a, PointedList a))
-> Maybe (PointedList a) -> Maybe (PointedList a, PointedList a)
forall a b. (a -> b) -> a -> b
$ PointedList a -> Maybe (PointedList a)
forall a. PointedList a -> Maybe (PointedList a)
next PointedList a
p) PointedList a
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 :: (PointedList a -> b) -> PointedList a -> PointedList b
contextMap f :: PointedList a -> b
f z :: PointedList a
z = (PointedList a -> b)
-> PointedList (PointedList a) -> PointedList b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PointedList a -> b
f (PointedList (PointedList a) -> PointedList b)
-> PointedList (PointedList a) -> PointedList b
forall a b. (a -> b) -> a -> b
$ PointedList a -> PointedList (PointedList a)
forall a. PointedList a -> PointedList (PointedList a)
positions PointedList a
z

-- | Create a @'PointedList' a@ of @(a, 'Bool')@, in which the boolean values
--   specify whether the current element has the focus. That is, all of the
--   booleans will be 'False', except the focused element.
withFocus :: PointedList a -> PointedList (a, Bool)
withFocus :: PointedList a -> PointedList (a, Bool)
withFocus (PointedList a :: [a]
a b :: a
b c :: [a]
c) =
    [(a, Bool)] -> (a, Bool) -> [(a, Bool)] -> PointedList (a, Bool)
forall a. [a] -> a -> [a] -> PointedList a
PointedList ([a] -> [Bool] -> [(a, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
a (Bool -> [Bool]
forall a. a -> [a]
repeat Bool
False)) (a
b, Bool
True) ([a] -> [Bool] -> [(a, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
c (Bool -> [Bool]
forall a. a -> [a]
repeat Bool
False))

-- | Move the focus to the specified index. The first element is at index 0.
moveTo :: Int -> PointedList a -> Maybe (PointedList a)
moveTo :: Int -> PointedList a -> Maybe (PointedList a)
moveTo n :: Int
n pl :: PointedList a
pl = Int -> PointedList a -> Maybe (PointedList a)
forall a. Int -> PointedList a -> Maybe (PointedList a)
moveN (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- (PointedList a -> Int
forall a. PointedList a -> Int
index PointedList a
pl)) PointedList a
pl 

-- | Move the focus by @n@, relative to the current index. Negative values move
--   the focus backwards, positive values more forwards through the list.
moveN :: Int -> PointedList a -> Maybe (PointedList a)
moveN :: Int -> PointedList a -> Maybe (PointedList a)
moveN n :: Int
n pl :: PointedList a
pl@(PointedList left :: [a]
left x :: a
x right :: [a]
right) = Int -> [a] -> a -> [a] -> Maybe (PointedList a)
forall a a.
(Ord a, Num a) =>
a -> [a] -> a -> [a] -> Maybe (PointedList a)
go Int
n [a]
left a
x [a]
right 
  where
  go :: a -> [a] -> a -> [a] -> Maybe (PointedList a)
go n :: a
n left :: [a]
left x :: a
x right :: [a]
right = case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
n 0 of
   GT -> case [a]
right of
     [] -> Maybe (PointedList a)
forall a. Maybe a
Nothing
     (r :: a
r:rs :: [a]
rs) -> a -> [a] -> a -> [a] -> Maybe (PointedList a)
go (a
na -> a -> a
forall a. Num a => a -> a -> a
-1) (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
left) a
r [a]
rs
   LT -> case [a]
left of
     [] -> Maybe (PointedList a)
forall a. Maybe a
Nothing
     (l :: a
l:ls :: [a]
ls) -> a -> [a] -> a -> [a] -> Maybe (PointedList a)
go (a
na -> a -> a
forall a. Num a => a -> a -> a
+1) [a]
ls a
l (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
right)
   EQ -> PointedList a -> Maybe (PointedList a)
forall a. a -> Maybe a
Just (PointedList a -> Maybe (PointedList a))
-> PointedList a -> Maybe (PointedList a)
forall a b. (a -> b) -> a -> b
$ [a] -> a -> [a] -> PointedList a
forall a. [a] -> a -> [a] -> PointedList a
PointedList [a]
left a
x [a]
right

-- | Move the focus to the specified element, if it is present.
--
--   Patch with much faster algorithm provided by Runar Bjarnason for version
--   0.3.2. Improved again by Runar Bjarnason for version 0.3.3 to support
--   infinite lists on both sides of the focus.
find :: Eq a => a -> PointedList a -> Maybe (PointedList a)
find :: a -> PointedList a -> Maybe (PointedList a)
find x :: a
x pl :: PointedList a
pl = (PointedList a -> Bool)
-> PointedList (PointedList a) -> Maybe (PointedList a)
forall a. (a -> Bool) -> PointedList a -> Maybe a
find' ((a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
==) (a -> Bool) -> (PointedList a -> a) -> PointedList a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PointedList a -> a
forall a. PointedList a -> a
_focus) (PointedList (PointedList a) -> Maybe (PointedList a))
-> PointedList (PointedList a) -> Maybe (PointedList a)
forall a b. (a -> b) -> a -> b
$ PointedList a -> PointedList (PointedList a)
forall a. PointedList a -> PointedList (PointedList a)
positions PointedList a
pl
  where find' :: (a -> Bool) -> PointedList a -> Maybe a
find' pred :: a -> Bool
pred (PointedList a :: [a]
a b :: a
b c :: [a]
c) =
          if a -> Bool
pred a
b then a -> Maybe a
forall a. a -> Maybe a
Just a
b
                    else (a -> Bool) -> [a] -> Maybe a
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find a -> Bool
pred ([a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
merge [a]
a [a]
c)
        merge :: [a] -> [a] -> [a]
merge []     ys :: [a]
ys = [a]
ys
        merge (x :: a
x:xs :: [a]
xs) ys :: [a]
ys = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
merge [a]
ys [a]
xs

-- | The index of the focus, leftmost is 0.
index :: PointedList a -> Int
index :: PointedList a -> Int
index (PointedList a :: [a]
a _ _) = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length [a]
a