{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}

module Cursor.List.NonEmpty
  ( NonEmptyCursor (..),
    makeNonEmptyCursor,
    makeNonEmptyCursorWithSelection,
    singletonNonEmptyCursor,
    rebuildNonEmptyCursor,
    nonEmptyCursorElemL,
    mapNonEmptyCursor,
    nonEmptyCursorSelectPrev,
    nonEmptyCursorSelectNext,
    nonEmptyCursorSelectFirst,
    nonEmptyCursorSelectLast,
    nonEmptyCursorSelection,
    nonEmptyCursorSelectIndex,
    nonEmptyCursorInsert,
    nonEmptyCursorAppend,
    nonEmptyCursorInsertAndSelect,
    nonEmptyCursorAppendAndSelect,
    nonEmptyCursorInsertAtStart,
    nonEmptyCursorAppendAtEnd,
    nonEmptyCursorInsertAtStartAndSelect,
    nonEmptyCursorAppendAtEndAndSelect,
    nonEmptyCursorRemoveElemAndSelectPrev,
    nonEmptyCursorDeleteElemAndSelectNext,
    nonEmptyCursorRemoveElem,
    nonEmptyCursorDeleteElem,
    nonEmptyCursorSearch,
    nonEmptyCursorSelectOrAdd,
    renderNonEmptyCursor,
    nonemptyPrepend,
    nonemptyAppend,
    traverseNonEmptyCursor,
    foldNonEmptyCursor,
  )
where

import Control.DeepSeq
import Control.Monad
import Cursor.Types
import Data.List.NonEmpty (NonEmpty (..), (<|))
import qualified Data.List.NonEmpty as NE
import Data.Maybe
import Data.Validity
import GHC.Generics (Generic)
import Lens.Micro

-- | A 'nonempty list' cursor
data NonEmptyCursor a b = NonEmptyCursor
  { NonEmptyCursor a b -> [b]
nonEmptyCursorPrev :: [b], -- In reverse order
    NonEmptyCursor a b -> a
nonEmptyCursorCurrent :: a,
    NonEmptyCursor a b -> [b]
nonEmptyCursorNext :: [b]
  }
  deriving (Int -> NonEmptyCursor a b -> ShowS
[NonEmptyCursor a b] -> ShowS
NonEmptyCursor a b -> String
(Int -> NonEmptyCursor a b -> ShowS)
-> (NonEmptyCursor a b -> String)
-> ([NonEmptyCursor a b] -> ShowS)
-> Show (NonEmptyCursor a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. (Show b, Show a) => Int -> NonEmptyCursor a b -> ShowS
forall a b. (Show b, Show a) => [NonEmptyCursor a b] -> ShowS
forall a b. (Show b, Show a) => NonEmptyCursor a b -> String
showList :: [NonEmptyCursor a b] -> ShowS
$cshowList :: forall a b. (Show b, Show a) => [NonEmptyCursor a b] -> ShowS
show :: NonEmptyCursor a b -> String
$cshow :: forall a b. (Show b, Show a) => NonEmptyCursor a b -> String
showsPrec :: Int -> NonEmptyCursor a b -> ShowS
$cshowsPrec :: forall a b. (Show b, Show a) => Int -> NonEmptyCursor a b -> ShowS
Show, NonEmptyCursor a b -> NonEmptyCursor a b -> Bool
(NonEmptyCursor a b -> NonEmptyCursor a b -> Bool)
-> (NonEmptyCursor a b -> NonEmptyCursor a b -> Bool)
-> Eq (NonEmptyCursor a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b.
(Eq b, Eq a) =>
NonEmptyCursor a b -> NonEmptyCursor a b -> Bool
/= :: NonEmptyCursor a b -> NonEmptyCursor a b -> Bool
$c/= :: forall a b.
(Eq b, Eq a) =>
NonEmptyCursor a b -> NonEmptyCursor a b -> Bool
== :: NonEmptyCursor a b -> NonEmptyCursor a b -> Bool
$c== :: forall a b.
(Eq b, Eq a) =>
NonEmptyCursor a b -> NonEmptyCursor a b -> Bool
Eq, (forall x. NonEmptyCursor a b -> Rep (NonEmptyCursor a b) x)
-> (forall x. Rep (NonEmptyCursor a b) x -> NonEmptyCursor a b)
-> Generic (NonEmptyCursor a b)
forall x. Rep (NonEmptyCursor a b) x -> NonEmptyCursor a b
forall x. NonEmptyCursor a b -> Rep (NonEmptyCursor a b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a b x. Rep (NonEmptyCursor a b) x -> NonEmptyCursor a b
forall a b x. NonEmptyCursor a b -> Rep (NonEmptyCursor a b) x
$cto :: forall a b x. Rep (NonEmptyCursor a b) x -> NonEmptyCursor a b
$cfrom :: forall a b x. NonEmptyCursor a b -> Rep (NonEmptyCursor a b) x
Generic, a -> NonEmptyCursor a b -> NonEmptyCursor a a
(a -> b) -> NonEmptyCursor a a -> NonEmptyCursor a b
(forall a b. (a -> b) -> NonEmptyCursor a a -> NonEmptyCursor a b)
-> (forall a b. a -> NonEmptyCursor a b -> NonEmptyCursor a a)
-> Functor (NonEmptyCursor a)
forall a b. a -> NonEmptyCursor a b -> NonEmptyCursor a a
forall a b. (a -> b) -> NonEmptyCursor a a -> NonEmptyCursor a b
forall a a b. a -> NonEmptyCursor a b -> NonEmptyCursor a a
forall a a b. (a -> b) -> NonEmptyCursor a a -> NonEmptyCursor a b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> NonEmptyCursor a b -> NonEmptyCursor a a
$c<$ :: forall a a b. a -> NonEmptyCursor a b -> NonEmptyCursor a a
fmap :: (a -> b) -> NonEmptyCursor a a -> NonEmptyCursor a b
$cfmap :: forall a a b. (a -> b) -> NonEmptyCursor a a -> NonEmptyCursor a b
Functor)

instance (Validity a, Validity b) => Validity (NonEmptyCursor a b)

instance (NFData a, NFData b) => NFData (NonEmptyCursor a b)

makeNonEmptyCursor :: (b -> a) -> NonEmpty b -> NonEmptyCursor a b
makeNonEmptyCursor :: (b -> a) -> NonEmpty b -> NonEmptyCursor a b
makeNonEmptyCursor b -> a
g = Maybe (NonEmptyCursor a b) -> NonEmptyCursor a b
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (NonEmptyCursor a b) -> NonEmptyCursor a b)
-> (NonEmpty b -> Maybe (NonEmptyCursor a b))
-> NonEmpty b
-> NonEmptyCursor a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> a) -> Int -> NonEmpty b -> Maybe (NonEmptyCursor a b)
forall b a.
(b -> a) -> Int -> NonEmpty b -> Maybe (NonEmptyCursor a b)
makeNonEmptyCursorWithSelection b -> a
g Int
0

makeNonEmptyCursorWithSelection :: (b -> a) -> Int -> NonEmpty b -> Maybe (NonEmptyCursor a b)
makeNonEmptyCursorWithSelection :: (b -> a) -> Int -> NonEmpty b -> Maybe (NonEmptyCursor a b)
makeNonEmptyCursorWithSelection b -> a
g Int
i NonEmpty b
ne = do
  ([b]
l, b
m, [b]
r) <- NonEmpty b -> Int -> Maybe ([b], b, [b])
forall a. NonEmpty a -> Int -> Maybe ([a], a, [a])
applyNonEmptySelection NonEmpty b
ne Int
i
  NonEmptyCursor a b -> Maybe (NonEmptyCursor a b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    NonEmptyCursor :: forall a b. [b] -> a -> [b] -> NonEmptyCursor a b
NonEmptyCursor
      { nonEmptyCursorPrev :: [b]
nonEmptyCursorPrev = [b] -> [b]
forall a. [a] -> [a]
reverse [b]
l,
        nonEmptyCursorCurrent :: a
nonEmptyCursorCurrent = b -> a
g b
m,
        nonEmptyCursorNext :: [b]
nonEmptyCursorNext = [b]
r
      }
  where
    applyNonEmptySelection :: NonEmpty a -> Int -> Maybe ([a], a, [a])
    applyNonEmptySelection :: NonEmpty a -> Int -> Maybe ([a], a, [a])
applyNonEmptySelection (a
c :| [a]
rest) Int
i_
      | Int
i_ Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Maybe ([a], a, [a])
forall a. Maybe a
Nothing
      | Int
i_ Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = ([a], a, [a]) -> Maybe ([a], a, [a])
forall a. a -> Maybe a
Just ([], a
c, [a]
rest)
      | Bool
otherwise = do
        NonEmpty a
ne_ <- [a] -> Maybe (NonEmpty a)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [a]
rest
        ([a]
l, a
m, [a]
r) <- NonEmpty a -> Int -> Maybe ([a], a, [a])
forall a. NonEmpty a -> Int -> Maybe ([a], a, [a])
applyNonEmptySelection NonEmpty a
ne_ (Int
i_ Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
        ([a], a, [a]) -> Maybe ([a], a, [a])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
c a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
l, a
m, [a]
r)

singletonNonEmptyCursor :: a -> NonEmptyCursor a b
singletonNonEmptyCursor :: a -> NonEmptyCursor a b
singletonNonEmptyCursor a
a =
  NonEmptyCursor :: forall a b. [b] -> a -> [b] -> NonEmptyCursor a b
NonEmptyCursor {nonEmptyCursorPrev :: [b]
nonEmptyCursorPrev = [], nonEmptyCursorCurrent :: a
nonEmptyCursorCurrent = a
a, nonEmptyCursorNext :: [b]
nonEmptyCursorNext = []}

rebuildNonEmptyCursor :: (a -> b) -> NonEmptyCursor a b -> NonEmpty b
rebuildNonEmptyCursor :: (a -> b) -> NonEmptyCursor a b -> NonEmpty b
rebuildNonEmptyCursor a -> b
f NonEmptyCursor {a
[b]
nonEmptyCursorNext :: [b]
nonEmptyCursorCurrent :: a
nonEmptyCursorPrev :: [b]
nonEmptyCursorNext :: forall a b. NonEmptyCursor a b -> [b]
nonEmptyCursorCurrent :: forall a b. NonEmptyCursor a b -> a
nonEmptyCursorPrev :: forall a b. NonEmptyCursor a b -> [b]
..} =
  [b] -> NonEmpty b -> NonEmpty b
forall a. [a] -> NonEmpty a -> NonEmpty a
nonemptyPrepend ([b] -> [b]
forall a. [a] -> [a]
reverse [b]
nonEmptyCursorPrev) (NonEmpty b -> NonEmpty b) -> NonEmpty b -> NonEmpty b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
nonEmptyCursorCurrent b -> [b] -> NonEmpty b
forall a. a -> [a] -> NonEmpty a
:| [b]
nonEmptyCursorNext

mapNonEmptyCursor :: (a -> c) -> (b -> d) -> NonEmptyCursor a b -> NonEmptyCursor c d
mapNonEmptyCursor :: (a -> c) -> (b -> d) -> NonEmptyCursor a b -> NonEmptyCursor c d
mapNonEmptyCursor a -> c
f b -> d
g NonEmptyCursor {a
[b]
nonEmptyCursorNext :: [b]
nonEmptyCursorCurrent :: a
nonEmptyCursorPrev :: [b]
nonEmptyCursorNext :: forall a b. NonEmptyCursor a b -> [b]
nonEmptyCursorCurrent :: forall a b. NonEmptyCursor a b -> a
nonEmptyCursorPrev :: forall a b. NonEmptyCursor a b -> [b]
..} =
  NonEmptyCursor :: forall a b. [b] -> a -> [b] -> NonEmptyCursor a b
NonEmptyCursor
    { nonEmptyCursorPrev :: [d]
nonEmptyCursorPrev = (b -> d) -> [b] -> [d]
forall a b. (a -> b) -> [a] -> [b]
map b -> d
g [b]
nonEmptyCursorPrev,
      nonEmptyCursorCurrent :: c
nonEmptyCursorCurrent = a -> c
f a
nonEmptyCursorCurrent,
      nonEmptyCursorNext :: [d]
nonEmptyCursorNext = (b -> d) -> [b] -> [d]
forall a b. (a -> b) -> [a] -> [b]
map b -> d
g [b]
nonEmptyCursorNext
    }

nonEmptyCursorElemL :: Lens (NonEmptyCursor a c) (NonEmptyCursor b c) a b
nonEmptyCursorElemL :: (a -> f b) -> NonEmptyCursor a c -> f (NonEmptyCursor b c)
nonEmptyCursorElemL = (NonEmptyCursor a c -> a)
-> (NonEmptyCursor a c -> b -> NonEmptyCursor b c)
-> Lens (NonEmptyCursor a c) (NonEmptyCursor b c) a b
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens NonEmptyCursor a c -> a
forall a b. NonEmptyCursor a b -> a
nonEmptyCursorCurrent ((NonEmptyCursor a c -> b -> NonEmptyCursor b c)
 -> Lens (NonEmptyCursor a c) (NonEmptyCursor b c) a b)
-> (NonEmptyCursor a c -> b -> NonEmptyCursor b c)
-> Lens (NonEmptyCursor a c) (NonEmptyCursor b c) a b
forall a b. (a -> b) -> a -> b
$ \NonEmptyCursor a c
lec b
le -> NonEmptyCursor a c
lec {nonEmptyCursorCurrent :: b
nonEmptyCursorCurrent = b
le}

nonEmptyCursorSelectPrev :: (a -> b) -> (b -> a) -> NonEmptyCursor a b -> Maybe (NonEmptyCursor a b)
nonEmptyCursorSelectPrev :: (a -> b)
-> (b -> a) -> NonEmptyCursor a b -> Maybe (NonEmptyCursor a b)
nonEmptyCursorSelectPrev a -> b
f b -> a
g NonEmptyCursor a b
lec =
  case NonEmptyCursor a b -> [b]
forall a b. NonEmptyCursor a b -> [b]
nonEmptyCursorPrev NonEmptyCursor a b
lec of
    [] -> Maybe (NonEmptyCursor a b)
forall a. Maybe a
Nothing
    (b
e : [b]
rest) ->
      NonEmptyCursor a b -> Maybe (NonEmptyCursor a b)
forall a. a -> Maybe a
Just (NonEmptyCursor a b -> Maybe (NonEmptyCursor a b))
-> NonEmptyCursor a b -> Maybe (NonEmptyCursor a b)
forall a b. (a -> b) -> a -> b
$
        NonEmptyCursor a b
lec
          { nonEmptyCursorPrev :: [b]
nonEmptyCursorPrev = [b]
rest,
            nonEmptyCursorCurrent :: a
nonEmptyCursorCurrent = b -> a
g b
e,
            nonEmptyCursorNext :: [b]
nonEmptyCursorNext = a -> b
f (NonEmptyCursor a b -> a
forall a b. NonEmptyCursor a b -> a
nonEmptyCursorCurrent NonEmptyCursor a b
lec) b -> [b] -> [b]
forall a. a -> [a] -> [a]
: NonEmptyCursor a b -> [b]
forall a b. NonEmptyCursor a b -> [b]
nonEmptyCursorNext NonEmptyCursor a b
lec
          }

nonEmptyCursorSelectNext :: (a -> b) -> (b -> a) -> NonEmptyCursor a b -> Maybe (NonEmptyCursor a b)
nonEmptyCursorSelectNext :: (a -> b)
-> (b -> a) -> NonEmptyCursor a b -> Maybe (NonEmptyCursor a b)
nonEmptyCursorSelectNext a -> b
f b -> a
g NonEmptyCursor a b
lec =
  case NonEmptyCursor a b -> [b]
forall a b. NonEmptyCursor a b -> [b]
nonEmptyCursorNext NonEmptyCursor a b
lec of
    [] -> Maybe (NonEmptyCursor a b)
forall a. Maybe a
Nothing
    (b
e : [b]
rest) ->
      NonEmptyCursor a b -> Maybe (NonEmptyCursor a b)
forall a. a -> Maybe a
Just (NonEmptyCursor a b -> Maybe (NonEmptyCursor a b))
-> NonEmptyCursor a b -> Maybe (NonEmptyCursor a b)
forall a b. (a -> b) -> a -> b
$
        NonEmptyCursor a b
lec
          { nonEmptyCursorPrev :: [b]
nonEmptyCursorPrev = a -> b
f (NonEmptyCursor a b -> a
forall a b. NonEmptyCursor a b -> a
nonEmptyCursorCurrent NonEmptyCursor a b
lec) b -> [b] -> [b]
forall a. a -> [a] -> [a]
: NonEmptyCursor a b -> [b]
forall a b. NonEmptyCursor a b -> [b]
nonEmptyCursorPrev NonEmptyCursor a b
lec,
            nonEmptyCursorCurrent :: a
nonEmptyCursorCurrent = b -> a
g b
e,
            nonEmptyCursorNext :: [b]
nonEmptyCursorNext = [b]
rest
          }

nonEmptyCursorSelectFirst :: (a -> b) -> (b -> a) -> NonEmptyCursor a b -> NonEmptyCursor a b
nonEmptyCursorSelectFirst :: (a -> b) -> (b -> a) -> NonEmptyCursor a b -> NonEmptyCursor a b
nonEmptyCursorSelectFirst a -> b
f b -> a
g NonEmptyCursor a b
lec =
  case (a -> b)
-> (b -> a) -> NonEmptyCursor a b -> Maybe (NonEmptyCursor a b)
forall a b.
(a -> b)
-> (b -> a) -> NonEmptyCursor a b -> Maybe (NonEmptyCursor a b)
nonEmptyCursorSelectPrev a -> b
f b -> a
g NonEmptyCursor a b
lec of
    Maybe (NonEmptyCursor a b)
Nothing -> NonEmptyCursor a b
lec
    Just NonEmptyCursor a b
lec' -> (a -> b) -> (b -> a) -> NonEmptyCursor a b -> NonEmptyCursor a b
forall a b.
(a -> b) -> (b -> a) -> NonEmptyCursor a b -> NonEmptyCursor a b
nonEmptyCursorSelectFirst a -> b
f b -> a
g NonEmptyCursor a b
lec'

nonEmptyCursorSelectLast :: (a -> b) -> (b -> a) -> NonEmptyCursor a b -> NonEmptyCursor a b
nonEmptyCursorSelectLast :: (a -> b) -> (b -> a) -> NonEmptyCursor a b -> NonEmptyCursor a b
nonEmptyCursorSelectLast a -> b
f b -> a
g NonEmptyCursor a b
lec =
  case (a -> b)
-> (b -> a) -> NonEmptyCursor a b -> Maybe (NonEmptyCursor a b)
forall a b.
(a -> b)
-> (b -> a) -> NonEmptyCursor a b -> Maybe (NonEmptyCursor a b)
nonEmptyCursorSelectNext a -> b
f b -> a
g NonEmptyCursor a b
lec of
    Maybe (NonEmptyCursor a b)
Nothing -> NonEmptyCursor a b
lec
    Just NonEmptyCursor a b
lec' -> (a -> b) -> (b -> a) -> NonEmptyCursor a b -> NonEmptyCursor a b
forall a b.
(a -> b) -> (b -> a) -> NonEmptyCursor a b -> NonEmptyCursor a b
nonEmptyCursorSelectLast a -> b
f b -> a
g NonEmptyCursor a b
lec'

nonEmptyCursorSelection :: NonEmptyCursor a b -> Int
nonEmptyCursorSelection :: NonEmptyCursor a b -> Int
nonEmptyCursorSelection = [b] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([b] -> Int)
-> (NonEmptyCursor a b -> [b]) -> NonEmptyCursor a b -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyCursor a b -> [b]
forall a b. NonEmptyCursor a b -> [b]
nonEmptyCursorPrev

nonEmptyCursorSelectIndex ::
  (a -> b) -> (b -> a) -> Int -> NonEmptyCursor a b -> Maybe (NonEmptyCursor a b)
nonEmptyCursorSelectIndex :: (a -> b)
-> (b -> a)
-> Int
-> NonEmptyCursor a b
-> Maybe (NonEmptyCursor a b)
nonEmptyCursorSelectIndex a -> b
f b -> a
g Int
i NonEmptyCursor a b
nec
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< NonEmptyCursor a b -> Int
forall a b. NonEmptyCursor a b -> Int
nonEmptyCursorSelection NonEmptyCursor a b
nec =
    (a -> b)
-> (b -> a) -> NonEmptyCursor a b -> Maybe (NonEmptyCursor a b)
forall a b.
(a -> b)
-> (b -> a) -> NonEmptyCursor a b -> Maybe (NonEmptyCursor a b)
nonEmptyCursorSelectPrev a -> b
f b -> a
g NonEmptyCursor a b
nec Maybe (NonEmptyCursor a b)
-> (NonEmptyCursor a b -> Maybe (NonEmptyCursor a b))
-> Maybe (NonEmptyCursor a b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (a -> b)
-> (b -> a)
-> Int
-> NonEmptyCursor a b
-> Maybe (NonEmptyCursor a b)
forall a b.
(a -> b)
-> (b -> a)
-> Int
-> NonEmptyCursor a b
-> Maybe (NonEmptyCursor a b)
nonEmptyCursorSelectIndex a -> b
f b -> a
g Int
i
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> NonEmptyCursor a b -> Int
forall a b. NonEmptyCursor a b -> Int
nonEmptyCursorSelection NonEmptyCursor a b
nec =
    (a -> b)
-> (b -> a) -> NonEmptyCursor a b -> Maybe (NonEmptyCursor a b)
forall a b.
(a -> b)
-> (b -> a) -> NonEmptyCursor a b -> Maybe (NonEmptyCursor a b)
nonEmptyCursorSelectNext a -> b
f b -> a
g NonEmptyCursor a b
nec Maybe (NonEmptyCursor a b)
-> (NonEmptyCursor a b -> Maybe (NonEmptyCursor a b))
-> Maybe (NonEmptyCursor a b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (a -> b)
-> (b -> a)
-> Int
-> NonEmptyCursor a b
-> Maybe (NonEmptyCursor a b)
forall a b.
(a -> b)
-> (b -> a)
-> Int
-> NonEmptyCursor a b
-> Maybe (NonEmptyCursor a b)
nonEmptyCursorSelectIndex a -> b
f b -> a
g Int
i
  | Bool
otherwise = NonEmptyCursor a b -> Maybe (NonEmptyCursor a b)
forall a. a -> Maybe a
Just NonEmptyCursor a b
nec

nonEmptyCursorInsert :: b -> NonEmptyCursor a b -> NonEmptyCursor a b
nonEmptyCursorInsert :: b -> NonEmptyCursor a b -> NonEmptyCursor a b
nonEmptyCursorInsert b
c NonEmptyCursor a b
lec = NonEmptyCursor a b
lec {nonEmptyCursorPrev :: [b]
nonEmptyCursorPrev = b
c b -> [b] -> [b]
forall a. a -> [a] -> [a]
: NonEmptyCursor a b -> [b]
forall a b. NonEmptyCursor a b -> [b]
nonEmptyCursorPrev NonEmptyCursor a b
lec}

nonEmptyCursorAppend :: b -> NonEmptyCursor a b -> NonEmptyCursor a b
nonEmptyCursorAppend :: b -> NonEmptyCursor a b -> NonEmptyCursor a b
nonEmptyCursorAppend b
c NonEmptyCursor a b
lec = NonEmptyCursor a b
lec {nonEmptyCursorNext :: [b]
nonEmptyCursorNext = b
c b -> [b] -> [b]
forall a. a -> [a] -> [a]
: NonEmptyCursor a b -> [b]
forall a b. NonEmptyCursor a b -> [b]
nonEmptyCursorNext NonEmptyCursor a b
lec}

nonEmptyCursorInsertAndSelect :: (a -> b) -> a -> NonEmptyCursor a b -> NonEmptyCursor a b
nonEmptyCursorInsertAndSelect :: (a -> b) -> a -> NonEmptyCursor a b -> NonEmptyCursor a b
nonEmptyCursorInsertAndSelect a -> b
f a
c NonEmptyCursor a b
lec =
  NonEmptyCursor a b
lec
    { nonEmptyCursorCurrent :: a
nonEmptyCursorCurrent = a
c,
      nonEmptyCursorNext :: [b]
nonEmptyCursorNext = a -> b
f (NonEmptyCursor a b -> a
forall a b. NonEmptyCursor a b -> a
nonEmptyCursorCurrent NonEmptyCursor a b
lec) b -> [b] -> [b]
forall a. a -> [a] -> [a]
: NonEmptyCursor a b -> [b]
forall a b. NonEmptyCursor a b -> [b]
nonEmptyCursorNext NonEmptyCursor a b
lec
    }

nonEmptyCursorAppendAndSelect :: (a -> b) -> a -> NonEmptyCursor a b -> NonEmptyCursor a b
nonEmptyCursorAppendAndSelect :: (a -> b) -> a -> NonEmptyCursor a b -> NonEmptyCursor a b
nonEmptyCursorAppendAndSelect a -> b
f a
c NonEmptyCursor a b
lec =
  NonEmptyCursor a b
lec
    { nonEmptyCursorCurrent :: a
nonEmptyCursorCurrent = a
c,
      nonEmptyCursorPrev :: [b]
nonEmptyCursorPrev = a -> b
f (NonEmptyCursor a b -> a
forall a b. NonEmptyCursor a b -> a
nonEmptyCursorCurrent NonEmptyCursor a b
lec) b -> [b] -> [b]
forall a. a -> [a] -> [a]
: NonEmptyCursor a b -> [b]
forall a b. NonEmptyCursor a b -> [b]
nonEmptyCursorPrev NonEmptyCursor a b
lec
    }

nonEmptyCursorInsertAtStart :: b -> NonEmptyCursor a b -> NonEmptyCursor a b
nonEmptyCursorInsertAtStart :: b -> NonEmptyCursor a b -> NonEmptyCursor a b
nonEmptyCursorInsertAtStart b
c NonEmptyCursor a b
lec = NonEmptyCursor a b
lec {nonEmptyCursorPrev :: [b]
nonEmptyCursorPrev = NonEmptyCursor a b -> [b]
forall a b. NonEmptyCursor a b -> [b]
nonEmptyCursorPrev NonEmptyCursor a b
lec [b] -> [b] -> [b]
forall a. [a] -> [a] -> [a]
++ [b
c]}

nonEmptyCursorAppendAtEnd :: b -> NonEmptyCursor a b -> NonEmptyCursor a b
nonEmptyCursorAppendAtEnd :: b -> NonEmptyCursor a b -> NonEmptyCursor a b
nonEmptyCursorAppendAtEnd b
c NonEmptyCursor a b
lec = NonEmptyCursor a b
lec {nonEmptyCursorNext :: [b]
nonEmptyCursorNext = NonEmptyCursor a b -> [b]
forall a b. NonEmptyCursor a b -> [b]
nonEmptyCursorNext NonEmptyCursor a b
lec [b] -> [b] -> [b]
forall a. [a] -> [a] -> [a]
++ [b
c]}

nonEmptyCursorInsertAtStartAndSelect ::
  (a -> b) -> (b -> a) -> b -> NonEmptyCursor a b -> NonEmptyCursor a b
nonEmptyCursorInsertAtStartAndSelect :: (a -> b)
-> (b -> a) -> b -> NonEmptyCursor a b -> NonEmptyCursor a b
nonEmptyCursorInsertAtStartAndSelect a -> b
f b -> a
g b
c =
  (a -> b) -> (b -> a) -> NonEmptyCursor a b -> NonEmptyCursor a b
forall a b.
(a -> b) -> (b -> a) -> NonEmptyCursor a b -> NonEmptyCursor a b
nonEmptyCursorSelectFirst a -> b
f b -> a
g (NonEmptyCursor a b -> NonEmptyCursor a b)
-> (NonEmptyCursor a b -> NonEmptyCursor a b)
-> NonEmptyCursor a b
-> NonEmptyCursor a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> NonEmptyCursor a b -> NonEmptyCursor a b
forall b a. b -> NonEmptyCursor a b -> NonEmptyCursor a b
nonEmptyCursorInsertAtStart b
c

nonEmptyCursorAppendAtEndAndSelect ::
  (a -> b) -> (b -> a) -> b -> NonEmptyCursor a b -> NonEmptyCursor a b
nonEmptyCursorAppendAtEndAndSelect :: (a -> b)
-> (b -> a) -> b -> NonEmptyCursor a b -> NonEmptyCursor a b
nonEmptyCursorAppendAtEndAndSelect a -> b
f b -> a
g b
c =
  (a -> b) -> (b -> a) -> NonEmptyCursor a b -> NonEmptyCursor a b
forall a b.
(a -> b) -> (b -> a) -> NonEmptyCursor a b -> NonEmptyCursor a b
nonEmptyCursorSelectLast a -> b
f b -> a
g (NonEmptyCursor a b -> NonEmptyCursor a b)
-> (NonEmptyCursor a b -> NonEmptyCursor a b)
-> NonEmptyCursor a b
-> NonEmptyCursor a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> NonEmptyCursor a b -> NonEmptyCursor a b
forall b a. b -> NonEmptyCursor a b -> NonEmptyCursor a b
nonEmptyCursorAppendAtEnd b
c

nonEmptyCursorRemoveElemAndSelectPrev ::
  (b -> a) -> NonEmptyCursor a b -> Maybe (DeleteOrUpdate (NonEmptyCursor a b))
nonEmptyCursorRemoveElemAndSelectPrev :: (b -> a)
-> NonEmptyCursor a b
-> Maybe (DeleteOrUpdate (NonEmptyCursor a b))
nonEmptyCursorRemoveElemAndSelectPrev b -> a
g NonEmptyCursor a b
lec =
  case NonEmptyCursor a b -> [b]
forall a b. NonEmptyCursor a b -> [b]
nonEmptyCursorPrev NonEmptyCursor a b
lec of
    [] ->
      case NonEmptyCursor a b -> [b]
forall a b. NonEmptyCursor a b -> [b]
nonEmptyCursorNext NonEmptyCursor a b
lec of
        [] -> DeleteOrUpdate (NonEmptyCursor a b)
-> Maybe (DeleteOrUpdate (NonEmptyCursor a b))
forall a. a -> Maybe a
Just DeleteOrUpdate (NonEmptyCursor a b)
forall a. DeleteOrUpdate a
Deleted
        [b]
_ -> Maybe (DeleteOrUpdate (NonEmptyCursor a b))
forall a. Maybe a
Nothing
    (b
e : [b]
rest) -> DeleteOrUpdate (NonEmptyCursor a b)
-> Maybe (DeleteOrUpdate (NonEmptyCursor a b))
forall a. a -> Maybe a
Just (DeleteOrUpdate (NonEmptyCursor a b)
 -> Maybe (DeleteOrUpdate (NonEmptyCursor a b)))
-> DeleteOrUpdate (NonEmptyCursor a b)
-> Maybe (DeleteOrUpdate (NonEmptyCursor a b))
forall a b. (a -> b) -> a -> b
$ NonEmptyCursor a b -> DeleteOrUpdate (NonEmptyCursor a b)
forall a. a -> DeleteOrUpdate a
Updated (NonEmptyCursor a b -> DeleteOrUpdate (NonEmptyCursor a b))
-> NonEmptyCursor a b -> DeleteOrUpdate (NonEmptyCursor a b)
forall a b. (a -> b) -> a -> b
$ NonEmptyCursor a b
lec {nonEmptyCursorPrev :: [b]
nonEmptyCursorPrev = [b]
rest, nonEmptyCursorCurrent :: a
nonEmptyCursorCurrent = b -> a
g b
e}

nonEmptyCursorDeleteElemAndSelectNext ::
  (b -> a) -> NonEmptyCursor a b -> Maybe (DeleteOrUpdate (NonEmptyCursor a b))
nonEmptyCursorDeleteElemAndSelectNext :: (b -> a)
-> NonEmptyCursor a b
-> Maybe (DeleteOrUpdate (NonEmptyCursor a b))
nonEmptyCursorDeleteElemAndSelectNext b -> a
g NonEmptyCursor a b
lec =
  case NonEmptyCursor a b -> [b]
forall a b. NonEmptyCursor a b -> [b]
nonEmptyCursorNext NonEmptyCursor a b
lec of
    [] ->
      case NonEmptyCursor a b -> [b]
forall a b. NonEmptyCursor a b -> [b]
nonEmptyCursorPrev NonEmptyCursor a b
lec of
        [] -> DeleteOrUpdate (NonEmptyCursor a b)
-> Maybe (DeleteOrUpdate (NonEmptyCursor a b))
forall a. a -> Maybe a
Just DeleteOrUpdate (NonEmptyCursor a b)
forall a. DeleteOrUpdate a
Deleted
        [b]
_ -> Maybe (DeleteOrUpdate (NonEmptyCursor a b))
forall a. Maybe a
Nothing
    (b
e : [b]
rest) -> DeleteOrUpdate (NonEmptyCursor a b)
-> Maybe (DeleteOrUpdate (NonEmptyCursor a b))
forall a. a -> Maybe a
Just (DeleteOrUpdate (NonEmptyCursor a b)
 -> Maybe (DeleteOrUpdate (NonEmptyCursor a b)))
-> DeleteOrUpdate (NonEmptyCursor a b)
-> Maybe (DeleteOrUpdate (NonEmptyCursor a b))
forall a b. (a -> b) -> a -> b
$ NonEmptyCursor a b -> DeleteOrUpdate (NonEmptyCursor a b)
forall a. a -> DeleteOrUpdate a
Updated (NonEmptyCursor a b -> DeleteOrUpdate (NonEmptyCursor a b))
-> NonEmptyCursor a b -> DeleteOrUpdate (NonEmptyCursor a b)
forall a b. (a -> b) -> a -> b
$ NonEmptyCursor a b
lec {nonEmptyCursorCurrent :: a
nonEmptyCursorCurrent = b -> a
g b
e, nonEmptyCursorNext :: [b]
nonEmptyCursorNext = [b]
rest}

nonEmptyCursorRemoveElem :: (b -> a) -> NonEmptyCursor a b -> DeleteOrUpdate (NonEmptyCursor a b)
nonEmptyCursorRemoveElem :: (b -> a)
-> NonEmptyCursor a b -> DeleteOrUpdate (NonEmptyCursor a b)
nonEmptyCursorRemoveElem b -> a
g NonEmptyCursor a b
lec =
  Maybe (DeleteOrUpdate (NonEmptyCursor a b))
-> Maybe (DeleteOrUpdate (NonEmptyCursor a b))
-> DeleteOrUpdate (NonEmptyCursor a b)
forall a.
Maybe (DeleteOrUpdate a)
-> Maybe (DeleteOrUpdate a) -> DeleteOrUpdate a
joinDeletes
    ((b -> a)
-> NonEmptyCursor a b
-> Maybe (DeleteOrUpdate (NonEmptyCursor a b))
forall b a.
(b -> a)
-> NonEmptyCursor a b
-> Maybe (DeleteOrUpdate (NonEmptyCursor a b))
nonEmptyCursorRemoveElemAndSelectPrev b -> a
g NonEmptyCursor a b
lec)
    ((b -> a)
-> NonEmptyCursor a b
-> Maybe (DeleteOrUpdate (NonEmptyCursor a b))
forall b a.
(b -> a)
-> NonEmptyCursor a b
-> Maybe (DeleteOrUpdate (NonEmptyCursor a b))
nonEmptyCursorDeleteElemAndSelectNext b -> a
g NonEmptyCursor a b
lec)

nonEmptyCursorDeleteElem :: (b -> a) -> NonEmptyCursor a b -> DeleteOrUpdate (NonEmptyCursor a b)
nonEmptyCursorDeleteElem :: (b -> a)
-> NonEmptyCursor a b -> DeleteOrUpdate (NonEmptyCursor a b)
nonEmptyCursorDeleteElem b -> a
g NonEmptyCursor a b
lec =
  Maybe (DeleteOrUpdate (NonEmptyCursor a b))
-> Maybe (DeleteOrUpdate (NonEmptyCursor a b))
-> DeleteOrUpdate (NonEmptyCursor a b)
forall a.
Maybe (DeleteOrUpdate a)
-> Maybe (DeleteOrUpdate a) -> DeleteOrUpdate a
joinDeletes
    ((b -> a)
-> NonEmptyCursor a b
-> Maybe (DeleteOrUpdate (NonEmptyCursor a b))
forall b a.
(b -> a)
-> NonEmptyCursor a b
-> Maybe (DeleteOrUpdate (NonEmptyCursor a b))
nonEmptyCursorDeleteElemAndSelectNext b -> a
g NonEmptyCursor a b
lec)
    ((b -> a)
-> NonEmptyCursor a b
-> Maybe (DeleteOrUpdate (NonEmptyCursor a b))
forall b a.
(b -> a)
-> NonEmptyCursor a b
-> Maybe (DeleteOrUpdate (NonEmptyCursor a b))
nonEmptyCursorRemoveElemAndSelectPrev b -> a
g NonEmptyCursor a b
lec)

nonEmptyCursorSearch ::
  (a -> b) -> (b -> a) -> (a -> Bool) -> NonEmptyCursor a b -> Maybe (NonEmptyCursor a b)
nonEmptyCursorSearch :: (a -> b)
-> (b -> a)
-> (a -> Bool)
-> NonEmptyCursor a b
-> Maybe (NonEmptyCursor a b)
nonEmptyCursorSearch a -> b
f b -> a
g a -> Bool
p NonEmptyCursor a b
nec =
  if a -> Bool
p (a -> Bool) -> a -> Bool
forall a b. (a -> b) -> a -> b
$ NonEmptyCursor a b -> a
forall a b. NonEmptyCursor a b -> a
nonEmptyCursorCurrent NonEmptyCursor a b
nec
    then NonEmptyCursor a b -> Maybe (NonEmptyCursor a b)
forall a. a -> Maybe a
Just NonEmptyCursor a b
nec
    else NonEmptyCursor a b -> Maybe (NonEmptyCursor a b)
lookPrev NonEmptyCursor a b
nec Maybe (NonEmptyCursor a b)
-> Maybe (NonEmptyCursor a b) -> Maybe (NonEmptyCursor a b)
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` NonEmptyCursor a b -> Maybe (NonEmptyCursor a b)
lookNext NonEmptyCursor a b
nec
  where
    lookPrev :: NonEmptyCursor a b -> Maybe (NonEmptyCursor a b)
lookPrev = ((a -> b)
 -> (b -> a) -> NonEmptyCursor a b -> Maybe (NonEmptyCursor a b))
-> NonEmptyCursor a b -> Maybe (NonEmptyCursor a b)
look (a -> b)
-> (b -> a) -> NonEmptyCursor a b -> Maybe (NonEmptyCursor a b)
forall a b.
(a -> b)
-> (b -> a) -> NonEmptyCursor a b -> Maybe (NonEmptyCursor a b)
nonEmptyCursorSelectPrev
    lookNext :: NonEmptyCursor a b -> Maybe (NonEmptyCursor a b)
lookNext = ((a -> b)
 -> (b -> a) -> NonEmptyCursor a b -> Maybe (NonEmptyCursor a b))
-> NonEmptyCursor a b -> Maybe (NonEmptyCursor a b)
look (a -> b)
-> (b -> a) -> NonEmptyCursor a b -> Maybe (NonEmptyCursor a b)
forall a b.
(a -> b)
-> (b -> a) -> NonEmptyCursor a b -> Maybe (NonEmptyCursor a b)
nonEmptyCursorSelectNext
    look :: ((a -> b)
 -> (b -> a) -> NonEmptyCursor a b -> Maybe (NonEmptyCursor a b))
-> NonEmptyCursor a b -> Maybe (NonEmptyCursor a b)
look (a -> b)
-> (b -> a) -> NonEmptyCursor a b -> Maybe (NonEmptyCursor a b)
func NonEmptyCursor a b
nec_ = do
      NonEmptyCursor a b
nec' <- (a -> b)
-> (b -> a) -> NonEmptyCursor a b -> Maybe (NonEmptyCursor a b)
func a -> b
f b -> a
g NonEmptyCursor a b
nec_
      if a -> Bool
p (a -> Bool) -> a -> Bool
forall a b. (a -> b) -> a -> b
$ NonEmptyCursor a b -> a
forall a b. NonEmptyCursor a b -> a
nonEmptyCursorCurrent NonEmptyCursor a b
nec'
        then NonEmptyCursor a b -> Maybe (NonEmptyCursor a b)
forall a. a -> Maybe a
Just NonEmptyCursor a b
nec'
        else ((a -> b)
 -> (b -> a) -> NonEmptyCursor a b -> Maybe (NonEmptyCursor a b))
-> NonEmptyCursor a b -> Maybe (NonEmptyCursor a b)
look (a -> b)
-> (b -> a) -> NonEmptyCursor a b -> Maybe (NonEmptyCursor a b)
func NonEmptyCursor a b
nec'

nonEmptyCursorSelectOrAdd ::
  (a -> b) -> (b -> a) -> (a -> Bool) -> a -> NonEmptyCursor a b -> NonEmptyCursor a b
nonEmptyCursorSelectOrAdd :: (a -> b)
-> (b -> a)
-> (a -> Bool)
-> a
-> NonEmptyCursor a b
-> NonEmptyCursor a b
nonEmptyCursorSelectOrAdd a -> b
f b -> a
g a -> Bool
p a
a NonEmptyCursor a b
nec =
  case (a -> b)
-> (b -> a)
-> (a -> Bool)
-> NonEmptyCursor a b
-> Maybe (NonEmptyCursor a b)
forall a b.
(a -> b)
-> (b -> a)
-> (a -> Bool)
-> NonEmptyCursor a b
-> Maybe (NonEmptyCursor a b)
nonEmptyCursorSearch a -> b
f b -> a
g a -> Bool
p NonEmptyCursor a b
nec of
    Maybe (NonEmptyCursor a b)
Nothing -> (a -> b) -> a -> NonEmptyCursor a b -> NonEmptyCursor a b
forall a b.
(a -> b) -> a -> NonEmptyCursor a b -> NonEmptyCursor a b
nonEmptyCursorAppendAndSelect a -> b
f a
a NonEmptyCursor a b
nec
    Just NonEmptyCursor a b
nec' -> NonEmptyCursor a b
nec'

renderNonEmptyCursor :: ([b] -> a -> [b] -> c) -> NonEmptyCursor a b -> c
renderNonEmptyCursor :: ([b] -> a -> [b] -> c) -> NonEmptyCursor a b -> c
renderNonEmptyCursor [b] -> a -> [b] -> c
f NonEmptyCursor {a
[b]
nonEmptyCursorNext :: [b]
nonEmptyCursorCurrent :: a
nonEmptyCursorPrev :: [b]
nonEmptyCursorNext :: forall a b. NonEmptyCursor a b -> [b]
nonEmptyCursorCurrent :: forall a b. NonEmptyCursor a b -> a
nonEmptyCursorPrev :: forall a b. NonEmptyCursor a b -> [b]
..} =
  [b] -> a -> [b] -> c
f ([b] -> [b]
forall a. [a] -> [a]
reverse [b]
nonEmptyCursorPrev) a
nonEmptyCursorCurrent [b]
nonEmptyCursorNext

nonemptyPrepend :: [a] -> NonEmpty a -> NonEmpty a
nonemptyPrepend :: [a] -> NonEmpty a -> NonEmpty a
nonemptyPrepend [a]
ls NonEmpty a
ne = (a -> NonEmpty a -> NonEmpty a) -> NonEmpty a -> [a] -> NonEmpty a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> NonEmpty a -> NonEmpty a
forall a. a -> NonEmpty a -> NonEmpty a
(<|) NonEmpty a
ne [a]
ls

nonemptyAppend :: NonEmpty a -> [a] -> NonEmpty a
nonemptyAppend :: NonEmpty a -> [a] -> NonEmpty a
nonemptyAppend (a
x :| [a]
xs) [a]
ls = a
x a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| ([a]
xs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
ls)

traverseNonEmptyCursor :: ([b] -> a -> [b] -> f c) -> NonEmptyCursor a b -> f c
traverseNonEmptyCursor :: ([b] -> a -> [b] -> f c) -> NonEmptyCursor a b -> f c
traverseNonEmptyCursor = ([b] -> a -> [b] -> f c) -> NonEmptyCursor a b -> f c
forall b a c. ([b] -> a -> [b] -> c) -> NonEmptyCursor a b -> c
foldNonEmptyCursor

foldNonEmptyCursor :: ([b] -> a -> [b] -> c) -> NonEmptyCursor a b -> c
foldNonEmptyCursor :: ([b] -> a -> [b] -> c) -> NonEmptyCursor a b -> c
foldNonEmptyCursor [b] -> a -> [b] -> c
func NonEmptyCursor {a
[b]
nonEmptyCursorNext :: [b]
nonEmptyCursorCurrent :: a
nonEmptyCursorPrev :: [b]
nonEmptyCursorNext :: forall a b. NonEmptyCursor a b -> [b]
nonEmptyCursorCurrent :: forall a b. NonEmptyCursor a b -> a
nonEmptyCursorPrev :: forall a b. NonEmptyCursor a b -> [b]
..} =
  [b] -> a -> [b] -> c
func ([b] -> [b]
forall a. [a] -> [a]
reverse [b]
nonEmptyCursorPrev) a
nonEmptyCursorCurrent [b]
nonEmptyCursorNext