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

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 GHC.Generics (Generic)

import Data.Maybe
import Data.Validity

import Control.DeepSeq
import Control.Monad

import Lens.Micro

import Data.List.NonEmpty (NonEmpty(..), (<|))
import qualified Data.List.NonEmpty as NE

import Cursor.Types

-- | A 'nonempty list' cursor
data NonEmptyCursor a b =
  NonEmptyCursor
    { nonEmptyCursorPrev :: [b] -- In reverse order
    , nonEmptyCursorCurrent :: a
    , nonEmptyCursorNext :: [b]
    }
  deriving (Show, Eq, Generic, 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 g = fromJust . makeNonEmptyCursorWithSelection g 0

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

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

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

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

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

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

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

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

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

nonEmptyCursorSelection :: NonEmptyCursor a b -> Int
nonEmptyCursorSelection = length . nonEmptyCursorPrev

nonEmptyCursorSelectIndex ::
     (a -> b) -> (b -> a) -> Int -> NonEmptyCursor a b -> Maybe (NonEmptyCursor a b)
nonEmptyCursorSelectIndex f g i nec
  | i < nonEmptyCursorSelection nec =
    nonEmptyCursorSelectPrev f g nec >>= nonEmptyCursorSelectIndex f g i
  | i > nonEmptyCursorSelection nec =
    nonEmptyCursorSelectNext f g nec >>= nonEmptyCursorSelectIndex f g i
  | otherwise = Just nec

nonEmptyCursorInsert :: b -> NonEmptyCursor a b -> NonEmptyCursor a b
nonEmptyCursorInsert c lec = lec {nonEmptyCursorPrev = c : nonEmptyCursorPrev lec}

nonEmptyCursorAppend :: b -> NonEmptyCursor a b -> NonEmptyCursor a b
nonEmptyCursorAppend c lec = lec {nonEmptyCursorNext = c : nonEmptyCursorNext lec}

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

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

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

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

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

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

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

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

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

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

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

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

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

nonemptyPrepend :: [a] -> NonEmpty a -> NonEmpty a
nonemptyPrepend ls ne = foldr (<|) ne ls

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

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

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