content: {-# LANGUAGE DeriveFunctor #-}
  {-# LANGUAGE DeriveGeneric #-}
  {-# LANGUAGE RecordWildCards #-}
  {-# LANGUAGE TypeFamilies #-}
  {- Authored by Tom Sydney Kerckhove, copied from cursor package #-}
  
  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 GHC.Generics (Generic)
  
  data ListCursor a = ListCursor
    { -- | In reverse order
      listCursorPrev :: [a],
      listCursorNext :: [a]
    }
    deriving (Show, Eq, Generic, Functor)
  
  instance NFData a => NFData (ListCursor a)
  
  emptyListCursor :: ListCursor a
  emptyListCursor = ListCursor {listCursorPrev = [], listCursorNext = []}
  
  makeListCursor :: [a] -> ListCursor a
  makeListCursor as = ListCursor {listCursorPrev = [], listCursorNext = as}
  
  makeListCursorWithSelection :: Int -> [a] -> Maybe (ListCursor a)
  makeListCursorWithSelection i as
    | i < 0 = Nothing
    | i > length as = Nothing
    | otherwise = Just ListCursor {listCursorPrev = reverse $ take i as, listCursorNext = drop i as}
  
  rebuildListCursor :: ListCursor a -> [a]
  rebuildListCursor ListCursor {..} = reverse listCursorPrev ++ listCursorNext
  
  listCursorNull :: ListCursor a -> Bool
  listCursorNull ListCursor {..} = null listCursorPrev && null listCursorNext
  
  listCursorLength :: ListCursor a -> Int
  listCursorLength = length . rebuildListCursor
  
  listCursorIndex :: ListCursor a -> Int
  listCursorIndex = length . listCursorPrev
  
  listCursorSelectPrev :: ListCursor a -> Maybe (ListCursor a)
  listCursorSelectPrev tc =
    case listCursorPrev tc of
      [] -> Nothing
      (c : cs) -> Just ListCursor {listCursorPrev = cs, listCursorNext = c : listCursorNext tc}
  
  listCursorSelectNext :: ListCursor a -> Maybe (ListCursor a)
  listCursorSelectNext tc =
    case listCursorNext tc of
      [] -> Nothing
      (c : cs) -> Just ListCursor {listCursorPrev = c : listCursorPrev tc, listCursorNext = cs}
  
  listCursorSelectIndex :: Int -> ListCursor a -> ListCursor a
  listCursorSelectIndex ix_ lc =
    let ls = rebuildListCursor lc
     in case splitAt ix_ ls of
          (l, r) -> ListCursor {listCursorPrev = reverse l, listCursorNext = r}
  
  listCursorSelectStart :: ListCursor a -> ListCursor a
  listCursorSelectStart tc =
    case listCursorSelectPrev tc of
      Nothing -> tc
      Just tc' -> listCursorSelectStart tc'
  
  listCursorSelectEnd :: ListCursor a -> ListCursor a
  listCursorSelectEnd tc =
    case listCursorSelectNext tc of
      Nothing -> tc
      Just tc' -> listCursorSelectEnd tc'
  
  listCursorPrevItem :: ListCursor a -> Maybe a
  listCursorPrevItem lc =
    case listCursorPrev lc of
      [] -> Nothing
      (c : _) -> Just c
  
  listCursorNextItem :: ListCursor a -> Maybe a
  listCursorNextItem lc =
    case listCursorNext lc of
      [] -> Nothing
      (c : _) -> Just c
  
  listCursorPrevUntil :: (a -> Bool) -> ListCursor a -> ListCursor a
  listCursorPrevUntil p = go
    where
      go lc =
        case listCursorPrev lc of
          [] -> lc
          (c : _)
            | p c -> lc
          _ -> maybe lc go (listCursorSelectPrev lc)
  
  listCursorNextUntil :: (a -> Bool) -> ListCursor a -> ListCursor a
  listCursorNextUntil p = go
    where
      go lc =
        case listCursorNext lc of
          [] -> lc
          (c : _)
            | p c -> lc
          _ -> maybe lc go (listCursorSelectNext lc)
  
  listCursorInsert :: a -> ListCursor a -> ListCursor a
  listCursorInsert c lc = lc {listCursorPrev = c : listCursorPrev lc}
  
  listCursorAppend :: a -> ListCursor a -> ListCursor a
  listCursorAppend c lc = lc {listCursorNext = c : listCursorNext lc}
  
  listCursorInsertList :: [a] -> ListCursor a -> ListCursor a
  listCursorInsertList l lc = lc {listCursorPrev = reverse l ++ listCursorPrev lc}
  
  listCursorAppendList :: [a] -> ListCursor a -> ListCursor a
  listCursorAppendList l lc = lc {listCursorNext = l ++ listCursorNext lc}
  
  listCursorRemove :: ListCursor a -> Maybe (DeleteOrUpdate (ListCursor a))
  listCursorRemove tc =
    case listCursorPrev tc of
      [] ->
        case listCursorNext tc of
          [] -> Just Deleted
          _ -> Nothing
      (_ : prev) -> Just $ Updated $ tc {listCursorPrev = prev}
  
  listCursorDelete :: ListCursor a -> Maybe (DeleteOrUpdate (ListCursor a))
  listCursorDelete tc =
    case listCursorNext tc of
      [] ->
        case listCursorPrev tc of
          [] -> Just Deleted
          _ -> Nothing
      (_ : next) -> Just $ Updated $ tc {listCursorNext = next}
  
  listCursorSplit :: ListCursor a -> (ListCursor a, ListCursor a)
  listCursorSplit ListCursor {..} =
    ( ListCursor {listCursorPrev = listCursorPrev, listCursorNext = []},
      ListCursor {listCursorPrev = [], listCursorNext = listCursorNext}
    )
  
  listCursorCombine :: ListCursor a -> ListCursor a -> ListCursor a
  listCursorCombine lc1 lc2 =
    ListCursor
      { listCursorPrev = reverse $ rebuildListCursor lc1,
        listCursorNext = rebuildListCursor lc2
      }
  
  traverseListCursor :: ([a] -> [a] -> f b) -> ListCursor a -> f b
  traverseListCursor = foldListCursor
  
  foldListCursor :: ([a] -> [a] -> b) -> ListCursor a -> b
  foldListCursor func ListCursor {..} = func (reverse listCursorPrev) listCursorNext
  
  