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

module Cursor.List
  ( ListCursor (..),
    emptyListCursor,
    makeListCursor,
    makeListCursorWithSelection,
    rebuildListCursor,
    listCursorNull,
    listCursorLength,
    listCursorIndex,
    listCursorSelectPrev,
    listCursorSelectNext,
    listCursorSelectIndex,
    listCursorSelectStart,
    listCursorSelectEnd,
    listCursorPrevItem,
    listCursorNextItem,
    listCursorPrevUntil,
    listCursorNextUntil,
    listCursorInsert,
    listCursorAppend,
    listCursorInsertList,
    listCursorAppendList,
    listCursorRemove,
    listCursorDelete,
    listCursorSplit,
    listCursorCombine,
    traverseListCursor,
    foldListCursor,
  )
where

import Control.DeepSeq
import Cursor.Types
import Data.Validity
import GHC.Generics (Generic)

data ListCursor a = ListCursor
  { -- | In reverse order
    ListCursor a -> [a]
listCursorPrev :: [a],
    ListCursor a -> [a]
listCursorNext :: [a]
  }
  deriving (Int -> ListCursor a -> ShowS
[ListCursor a] -> ShowS
ListCursor a -> String
(Int -> ListCursor a -> ShowS)
-> (ListCursor a -> String)
-> ([ListCursor a] -> ShowS)
-> Show (ListCursor a)
forall a. Show a => Int -> ListCursor a -> ShowS
forall a. Show a => [ListCursor a] -> ShowS
forall a. Show a => ListCursor a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListCursor a] -> ShowS
$cshowList :: forall a. Show a => [ListCursor a] -> ShowS
show :: ListCursor a -> String
$cshow :: forall a. Show a => ListCursor a -> String
showsPrec :: Int -> ListCursor a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ListCursor a -> ShowS
Show, ListCursor a -> ListCursor a -> Bool
(ListCursor a -> ListCursor a -> Bool)
-> (ListCursor a -> ListCursor a -> Bool) -> Eq (ListCursor a)
forall a. Eq a => ListCursor a -> ListCursor a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListCursor a -> ListCursor a -> Bool
$c/= :: forall a. Eq a => ListCursor a -> ListCursor a -> Bool
== :: ListCursor a -> ListCursor a -> Bool
$c== :: forall a. Eq a => ListCursor a -> ListCursor a -> Bool
Eq, (forall x. ListCursor a -> Rep (ListCursor a) x)
-> (forall x. Rep (ListCursor a) x -> ListCursor a)
-> Generic (ListCursor a)
forall x. Rep (ListCursor a) x -> ListCursor a
forall x. ListCursor a -> Rep (ListCursor a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (ListCursor a) x -> ListCursor a
forall a x. ListCursor a -> Rep (ListCursor a) x
$cto :: forall a x. Rep (ListCursor a) x -> ListCursor a
$cfrom :: forall a x. ListCursor a -> Rep (ListCursor a) x
Generic, a -> ListCursor b -> ListCursor a
(a -> b) -> ListCursor a -> ListCursor b
(forall a b. (a -> b) -> ListCursor a -> ListCursor b)
-> (forall a b. a -> ListCursor b -> ListCursor a)
-> Functor ListCursor
forall a b. a -> ListCursor b -> ListCursor a
forall a b. (a -> b) -> ListCursor a -> ListCursor b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ListCursor b -> ListCursor a
$c<$ :: forall a b. a -> ListCursor b -> ListCursor a
fmap :: (a -> b) -> ListCursor a -> ListCursor b
$cfmap :: forall a b. (a -> b) -> ListCursor a -> ListCursor b
Functor)

instance Validity a => Validity (ListCursor a)

instance NFData a => NFData (ListCursor a)

emptyListCursor :: ListCursor a
emptyListCursor :: ListCursor a
emptyListCursor = ListCursor :: forall a. [a] -> [a] -> ListCursor a
ListCursor {listCursorPrev :: [a]
listCursorPrev = [], listCursorNext :: [a]
listCursorNext = []}

makeListCursor :: [a] -> ListCursor a
makeListCursor :: [a] -> ListCursor a
makeListCursor [a]
as = ListCursor :: forall a. [a] -> [a] -> ListCursor a
ListCursor {listCursorPrev :: [a]
listCursorPrev = [], listCursorNext :: [a]
listCursorNext = [a]
as}

makeListCursorWithSelection :: Int -> [a] -> Maybe (ListCursor a)
makeListCursorWithSelection :: Int -> [a] -> Maybe (ListCursor a)
makeListCursorWithSelection Int
i [a]
as
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Maybe (ListCursor a)
forall a. Maybe a
Nothing
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
as = Maybe (ListCursor a)
forall a. Maybe a
Nothing
  | Bool
otherwise = ListCursor a -> Maybe (ListCursor a)
forall a. a -> Maybe a
Just ListCursor :: forall a. [a] -> [a] -> ListCursor a
ListCursor {listCursorPrev :: [a]
listCursorPrev = [a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
i [a]
as, listCursorNext :: [a]
listCursorNext = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
i [a]
as}

rebuildListCursor :: ListCursor a -> [a]
rebuildListCursor :: ListCursor a -> [a]
rebuildListCursor ListCursor {[a]
listCursorNext :: [a]
listCursorPrev :: [a]
listCursorNext :: forall a. ListCursor a -> [a]
listCursorPrev :: forall a. ListCursor a -> [a]
..} = [a] -> [a]
forall a. [a] -> [a]
reverse [a]
listCursorPrev [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
listCursorNext

listCursorNull :: ListCursor a -> Bool
listCursorNull :: ListCursor a -> Bool
listCursorNull ListCursor {[a]
listCursorNext :: [a]
listCursorPrev :: [a]
listCursorNext :: forall a. ListCursor a -> [a]
listCursorPrev :: forall a. ListCursor a -> [a]
..} = [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
listCursorPrev Bool -> Bool -> Bool
&& [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
listCursorNext

listCursorLength :: ListCursor a -> Int
listCursorLength :: ListCursor a -> Int
listCursorLength = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a] -> Int) -> (ListCursor a -> [a]) -> ListCursor a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListCursor a -> [a]
forall a. ListCursor a -> [a]
rebuildListCursor

listCursorIndex :: ListCursor a -> Int
listCursorIndex :: ListCursor a -> Int
listCursorIndex = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a] -> Int) -> (ListCursor a -> [a]) -> ListCursor a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListCursor a -> [a]
forall a. ListCursor a -> [a]
listCursorPrev

listCursorSelectPrev :: ListCursor a -> Maybe (ListCursor a)
listCursorSelectPrev :: ListCursor a -> Maybe (ListCursor a)
listCursorSelectPrev ListCursor a
tc =
  case ListCursor a -> [a]
forall a. ListCursor a -> [a]
listCursorPrev ListCursor a
tc of
    [] -> Maybe (ListCursor a)
forall a. Maybe a
Nothing
    (a
c : [a]
cs) -> ListCursor a -> Maybe (ListCursor a)
forall a. a -> Maybe a
Just ListCursor :: forall a. [a] -> [a] -> ListCursor a
ListCursor {listCursorPrev :: [a]
listCursorPrev = [a]
cs, listCursorNext :: [a]
listCursorNext = a
c a -> [a] -> [a]
forall a. a -> [a] -> [a]
: ListCursor a -> [a]
forall a. ListCursor a -> [a]
listCursorNext ListCursor a
tc}

listCursorSelectNext :: ListCursor a -> Maybe (ListCursor a)
listCursorSelectNext :: ListCursor a -> Maybe (ListCursor a)
listCursorSelectNext ListCursor a
tc =
  case ListCursor a -> [a]
forall a. ListCursor a -> [a]
listCursorNext ListCursor a
tc of
    [] -> Maybe (ListCursor a)
forall a. Maybe a
Nothing
    (a
c : [a]
cs) -> ListCursor a -> Maybe (ListCursor a)
forall a. a -> Maybe a
Just ListCursor :: forall a. [a] -> [a] -> ListCursor a
ListCursor {listCursorPrev :: [a]
listCursorPrev = a
c a -> [a] -> [a]
forall a. a -> [a] -> [a]
: ListCursor a -> [a]
forall a. ListCursor a -> [a]
listCursorPrev ListCursor a
tc, listCursorNext :: [a]
listCursorNext = [a]
cs}

listCursorSelectIndex :: Int -> ListCursor a -> ListCursor a
listCursorSelectIndex :: Int -> ListCursor a -> ListCursor a
listCursorSelectIndex Int
ix_ ListCursor a
lc =
  let ls :: [a]
ls = ListCursor a -> [a]
forall a. ListCursor a -> [a]
rebuildListCursor ListCursor a
lc
   in case Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
ix_ [a]
ls of
        ([a]
l, [a]
r) -> ListCursor :: forall a. [a] -> [a] -> ListCursor a
ListCursor {listCursorPrev :: [a]
listCursorPrev = [a] -> [a]
forall a. [a] -> [a]
reverse [a]
l, listCursorNext :: [a]
listCursorNext = [a]
r}

listCursorSelectStart :: ListCursor a -> ListCursor a
listCursorSelectStart :: ListCursor a -> ListCursor a
listCursorSelectStart ListCursor a
tc =
  case ListCursor a -> Maybe (ListCursor a)
forall a. ListCursor a -> Maybe (ListCursor a)
listCursorSelectPrev ListCursor a
tc of
    Maybe (ListCursor a)
Nothing -> ListCursor a
tc
    Just ListCursor a
tc' -> ListCursor a -> ListCursor a
forall a. ListCursor a -> ListCursor a
listCursorSelectStart ListCursor a
tc'

listCursorSelectEnd :: ListCursor a -> ListCursor a
listCursorSelectEnd :: ListCursor a -> ListCursor a
listCursorSelectEnd ListCursor a
tc =
  case ListCursor a -> Maybe (ListCursor a)
forall a. ListCursor a -> Maybe (ListCursor a)
listCursorSelectNext ListCursor a
tc of
    Maybe (ListCursor a)
Nothing -> ListCursor a
tc
    Just ListCursor a
tc' -> ListCursor a -> ListCursor a
forall a. ListCursor a -> ListCursor a
listCursorSelectEnd ListCursor a
tc'

listCursorPrevItem :: ListCursor a -> Maybe a
listCursorPrevItem :: ListCursor a -> Maybe a
listCursorPrevItem ListCursor a
lc =
  case ListCursor a -> [a]
forall a. ListCursor a -> [a]
listCursorPrev ListCursor a
lc of
    [] -> Maybe a
forall a. Maybe a
Nothing
    (a
c : [a]
_) -> a -> Maybe a
forall a. a -> Maybe a
Just a
c

listCursorNextItem :: ListCursor a -> Maybe a
listCursorNextItem :: ListCursor a -> Maybe a
listCursorNextItem ListCursor a
lc =
  case ListCursor a -> [a]
forall a. ListCursor a -> [a]
listCursorNext ListCursor a
lc of
    [] -> Maybe a
forall a. Maybe a
Nothing
    (a
c : [a]
_) -> a -> Maybe a
forall a. a -> Maybe a
Just a
c

listCursorPrevUntil :: (a -> Bool) -> ListCursor a -> ListCursor a
listCursorPrevUntil :: (a -> Bool) -> ListCursor a -> ListCursor a
listCursorPrevUntil a -> Bool
p = ListCursor a -> ListCursor a
go
  where
    go :: ListCursor a -> ListCursor a
go ListCursor a
lc =
      case ListCursor a -> [a]
forall a. ListCursor a -> [a]
listCursorPrev ListCursor a
lc of
        [] -> ListCursor a
lc
        (a
c : [a]
_)
          | a -> Bool
p a
c -> ListCursor a
lc
        [a]
_ -> ListCursor a
-> (ListCursor a -> ListCursor a)
-> Maybe (ListCursor a)
-> ListCursor a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ListCursor a
lc ListCursor a -> ListCursor a
go (ListCursor a -> Maybe (ListCursor a)
forall a. ListCursor a -> Maybe (ListCursor a)
listCursorSelectPrev ListCursor a
lc)

listCursorNextUntil :: (a -> Bool) -> ListCursor a -> ListCursor a
listCursorNextUntil :: (a -> Bool) -> ListCursor a -> ListCursor a
listCursorNextUntil a -> Bool
p = ListCursor a -> ListCursor a
go
  where
    go :: ListCursor a -> ListCursor a
go ListCursor a
lc =
      case ListCursor a -> [a]
forall a. ListCursor a -> [a]
listCursorNext ListCursor a
lc of
        [] -> ListCursor a
lc
        (a
c : [a]
_)
          | a -> Bool
p a
c -> ListCursor a
lc
        [a]
_ -> ListCursor a
-> (ListCursor a -> ListCursor a)
-> Maybe (ListCursor a)
-> ListCursor a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ListCursor a
lc ListCursor a -> ListCursor a
go (ListCursor a -> Maybe (ListCursor a)
forall a. ListCursor a -> Maybe (ListCursor a)
listCursorSelectNext ListCursor a
lc)

listCursorInsert :: a -> ListCursor a -> ListCursor a
listCursorInsert :: a -> ListCursor a -> ListCursor a
listCursorInsert a
c ListCursor a
lc = ListCursor a
lc {listCursorPrev :: [a]
listCursorPrev = a
c a -> [a] -> [a]
forall a. a -> [a] -> [a]
: ListCursor a -> [a]
forall a. ListCursor a -> [a]
listCursorPrev ListCursor a
lc}

listCursorAppend :: a -> ListCursor a -> ListCursor a
listCursorAppend :: a -> ListCursor a -> ListCursor a
listCursorAppend a
c ListCursor a
lc = ListCursor a
lc {listCursorNext :: [a]
listCursorNext = a
c a -> [a] -> [a]
forall a. a -> [a] -> [a]
: ListCursor a -> [a]
forall a. ListCursor a -> [a]
listCursorNext ListCursor a
lc}

listCursorInsertList :: [a] -> ListCursor a -> ListCursor a
listCursorInsertList :: [a] -> ListCursor a -> ListCursor a
listCursorInsertList [a]
l ListCursor a
lc = ListCursor a
lc {listCursorPrev :: [a]
listCursorPrev = [a] -> [a]
forall a. [a] -> [a]
reverse [a]
l [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ ListCursor a -> [a]
forall a. ListCursor a -> [a]
listCursorPrev ListCursor a
lc}

listCursorAppendList :: [a] -> ListCursor a -> ListCursor a
listCursorAppendList :: [a] -> ListCursor a -> ListCursor a
listCursorAppendList [a]
l ListCursor a
lc = ListCursor a
lc {listCursorNext :: [a]
listCursorNext = [a]
l [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ ListCursor a -> [a]
forall a. ListCursor a -> [a]
listCursorNext ListCursor a
lc}

listCursorRemove :: ListCursor a -> Maybe (DeleteOrUpdate (ListCursor a))
listCursorRemove :: ListCursor a -> Maybe (DeleteOrUpdate (ListCursor a))
listCursorRemove ListCursor a
tc =
  case ListCursor a -> [a]
forall a. ListCursor a -> [a]
listCursorPrev ListCursor a
tc of
    [] ->
      case ListCursor a -> [a]
forall a. ListCursor a -> [a]
listCursorNext ListCursor a
tc of
        [] -> DeleteOrUpdate (ListCursor a)
-> Maybe (DeleteOrUpdate (ListCursor a))
forall a. a -> Maybe a
Just DeleteOrUpdate (ListCursor a)
forall a. DeleteOrUpdate a
Deleted
        [a]
_ -> Maybe (DeleteOrUpdate (ListCursor a))
forall a. Maybe a
Nothing
    (a
_ : [a]
prev) -> DeleteOrUpdate (ListCursor a)
-> Maybe (DeleteOrUpdate (ListCursor a))
forall a. a -> Maybe a
Just (DeleteOrUpdate (ListCursor a)
 -> Maybe (DeleteOrUpdate (ListCursor a)))
-> DeleteOrUpdate (ListCursor a)
-> Maybe (DeleteOrUpdate (ListCursor a))
forall a b. (a -> b) -> a -> b
$ ListCursor a -> DeleteOrUpdate (ListCursor a)
forall a. a -> DeleteOrUpdate a
Updated (ListCursor a -> DeleteOrUpdate (ListCursor a))
-> ListCursor a -> DeleteOrUpdate (ListCursor a)
forall a b. (a -> b) -> a -> b
$ ListCursor a
tc {listCursorPrev :: [a]
listCursorPrev = [a]
prev}

listCursorDelete :: ListCursor a -> Maybe (DeleteOrUpdate (ListCursor a))
listCursorDelete :: ListCursor a -> Maybe (DeleteOrUpdate (ListCursor a))
listCursorDelete ListCursor a
tc =
  case ListCursor a -> [a]
forall a. ListCursor a -> [a]
listCursorNext ListCursor a
tc of
    [] ->
      case ListCursor a -> [a]
forall a. ListCursor a -> [a]
listCursorPrev ListCursor a
tc of
        [] -> DeleteOrUpdate (ListCursor a)
-> Maybe (DeleteOrUpdate (ListCursor a))
forall a. a -> Maybe a
Just DeleteOrUpdate (ListCursor a)
forall a. DeleteOrUpdate a
Deleted
        [a]
_ -> Maybe (DeleteOrUpdate (ListCursor a))
forall a. Maybe a
Nothing
    (a
_ : [a]
next) -> DeleteOrUpdate (ListCursor a)
-> Maybe (DeleteOrUpdate (ListCursor a))
forall a. a -> Maybe a
Just (DeleteOrUpdate (ListCursor a)
 -> Maybe (DeleteOrUpdate (ListCursor a)))
-> DeleteOrUpdate (ListCursor a)
-> Maybe (DeleteOrUpdate (ListCursor a))
forall a b. (a -> b) -> a -> b
$ ListCursor a -> DeleteOrUpdate (ListCursor a)
forall a. a -> DeleteOrUpdate a
Updated (ListCursor a -> DeleteOrUpdate (ListCursor a))
-> ListCursor a -> DeleteOrUpdate (ListCursor a)
forall a b. (a -> b) -> a -> b
$ ListCursor a
tc {listCursorNext :: [a]
listCursorNext = [a]
next}

listCursorSplit :: ListCursor a -> (ListCursor a, ListCursor a)
listCursorSplit :: ListCursor a -> (ListCursor a, ListCursor a)
listCursorSplit ListCursor {[a]
listCursorNext :: [a]
listCursorPrev :: [a]
listCursorNext :: forall a. ListCursor a -> [a]
listCursorPrev :: forall a. ListCursor a -> [a]
..} =
  ( ListCursor :: forall a. [a] -> [a] -> ListCursor a
ListCursor {listCursorPrev :: [a]
listCursorPrev = [a]
listCursorPrev, listCursorNext :: [a]
listCursorNext = []},
    ListCursor :: forall a. [a] -> [a] -> ListCursor a
ListCursor {listCursorPrev :: [a]
listCursorPrev = [], listCursorNext :: [a]
listCursorNext = [a]
listCursorNext}
  )

listCursorCombine :: ListCursor a -> ListCursor a -> ListCursor a
listCursorCombine :: ListCursor a -> ListCursor a -> ListCursor a
listCursorCombine ListCursor a
lc1 ListCursor a
lc2 =
  ListCursor :: forall a. [a] -> [a] -> ListCursor a
ListCursor
    { listCursorPrev :: [a]
listCursorPrev = [a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ ListCursor a -> [a]
forall a. ListCursor a -> [a]
rebuildListCursor ListCursor a
lc1,
      listCursorNext :: [a]
listCursorNext = ListCursor a -> [a]
forall a. ListCursor a -> [a]
rebuildListCursor ListCursor a
lc2
    }

traverseListCursor :: ([a] -> [a] -> f b) -> ListCursor a -> f b
traverseListCursor :: ([a] -> [a] -> f b) -> ListCursor a -> f b
traverseListCursor = ([a] -> [a] -> f b) -> ListCursor a -> f b
forall a b. ([a] -> [a] -> b) -> ListCursor a -> b
foldListCursor

foldListCursor :: ([a] -> [a] -> b) -> ListCursor a -> b
foldListCursor :: ([a] -> [a] -> b) -> ListCursor a -> b
foldListCursor [a] -> [a] -> b
func ListCursor {[a]
listCursorNext :: [a]
listCursorPrev :: [a]
listCursorNext :: forall a. ListCursor a -> [a]
listCursorPrev :: forall a. ListCursor a -> [a]
..} = [a] -> [a] -> b
func ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
listCursorPrev) [a]
listCursorNext