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

module Cursor.TextField
  ( TextFieldCursor(..)
  , makeTextFieldCursor
  , makeTextFieldCursorWithSelection
  , rebuildTextFieldCursorLines
  , rebuildTextFieldCursor
  , emptyTextFieldCursor
  , nullTextFieldCursor
  , textFieldCursorSelection
  , textFieldCursorNonEmptyCursorL
  , textFieldCursorSelectedL
  , textFieldCursorSelectPrevLine
  , textFieldCursorSelectNextLine
  , textFieldCursorSelectFirstLine
  , textFieldCursorSelectLastLine
  , textFieldCursorSelectPrevChar
  , textFieldCursorSelectNextChar
  , textFieldCursorIndexOnLine
  , textFieldCursorSelectIndexOnLine
  , textFieldCursorInsertChar
  , textFieldCursorAppendChar
  , textFieldCursorInsertNewline
  , textFieldCursorAppendNewline
  , textFieldCursorRemove
  , textFieldCursorDelete
  , textFieldCursorSelectStartOfLine
  , textFieldCursorSelectEndOfLine
  ) where

import GHC.Generics (Generic)

import Data.Validity
import Data.Validity.Text ()

import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NE
import Data.Maybe
import qualified Data.Text as T
import Data.Text (Text)

import Control.DeepSeq
import Control.Monad

import Lens.Micro

import Cursor.List.NonEmpty
import Cursor.Text
import Cursor.Types

newtype TextFieldCursor =
  TextFieldCursor
    { textFieldCursorNonEmpty :: NonEmptyCursor TextCursor Text
    }
  deriving (Show, Eq, Generic)

instance Validity TextFieldCursor where
  validate tfc@TextFieldCursor {..} =
    mconcat
      [ genericValidate tfc
      , decorate "None of the texts contain newlines" $
        decorateList (NE.toList $ rebuildNonEmptyCursor rebuildTextCursor textFieldCursorNonEmpty) $ \tc ->
          declare "The text of this line does not contain any newlines" $ T.all (/= '\n') tc
      ]

instance NFData TextFieldCursor

makeTextFieldCursor :: Text -> TextFieldCursor
makeTextFieldCursor = fromJust . makeTextFieldCursorWithSelection 0 0

makeTextFieldCursorWithSelection :: Int -> Int -> Text -> Maybe TextFieldCursor
makeTextFieldCursorWithSelection x y t = do
  ls <- NE.nonEmpty $ T.split (== '\n') t
  guard (x >= 0)
  guard (x < NE.length ls)
  nec <- makeNonEmptyCursorWithSelection (makeTextCursorWithSelection y) x ls
  void $ nonEmptyCursorCurrent nec
  -- This is safe because we already checked that it would work above
  pure $ TextFieldCursor (nec & nonEmptyCursorElemL %~ fromJust)

rebuildTextFieldCursorLines :: TextFieldCursor -> NonEmpty Text
rebuildTextFieldCursorLines = rebuildNonEmptyCursor rebuildTextCursor . textFieldCursorNonEmpty

rebuildTextFieldCursor :: TextFieldCursor -> Text
rebuildTextFieldCursor = T.intercalate "\n" . NE.toList . rebuildTextFieldCursorLines

emptyTextFieldCursor :: TextFieldCursor
emptyTextFieldCursor =
  TextFieldCursor {textFieldCursorNonEmpty = singletonNonEmptyCursor emptyTextCursor}

nullTextFieldCursor :: TextFieldCursor -> Bool
nullTextFieldCursor = (== emptyTextFieldCursor)

textFieldCursorSelection :: TextFieldCursor -> (Int, Int)
textFieldCursorSelection tfc =
  ( nonEmptyCursorSelection $ textFieldCursorNonEmpty tfc
  , textCursorIndex $ textFieldCursorNonEmpty tfc ^. nonEmptyCursorElemL)

textFieldCursorNonEmptyCursorL :: Lens' TextFieldCursor (NonEmptyCursor TextCursor Text)
textFieldCursorNonEmptyCursorL =
  lens textFieldCursorNonEmpty $ \tfc lec -> tfc {textFieldCursorNonEmpty = lec}

textFieldCursorSelectedL :: Lens' TextFieldCursor TextCursor
textFieldCursorSelectedL = textFieldCursorNonEmptyCursorL . nonEmptyCursorElemL

textFieldCursorSelectPrevLine :: TextFieldCursor -> Maybe TextFieldCursor
textFieldCursorSelectPrevLine =
  moveMWhileKeepingSelection $ nonEmptyCursorSelectPrev rebuildTextCursor unsafeMakeTextCursor

textFieldCursorSelectNextLine :: TextFieldCursor -> Maybe TextFieldCursor
textFieldCursorSelectNextLine =
  moveMWhileKeepingSelection $ nonEmptyCursorSelectNext rebuildTextCursor unsafeMakeTextCursor

moveMWhileKeepingSelection ::
     (NonEmptyCursor TextCursor Text -> Maybe (NonEmptyCursor TextCursor Text))
  -> TextFieldCursor
  -> Maybe TextFieldCursor
moveMWhileKeepingSelection movement tfc = do
  let i = textFieldCursorIndexOnLine tfc
  let tfc' = textFieldCursorSelectIndexOnLine 0 tfc
  tfc'' <- textFieldCursorNonEmptyCursorL movement tfc'
  pure $ textFieldCursorSelectIndexOnLine i tfc''

textFieldCursorSelectFirstLine :: TextFieldCursor -> TextFieldCursor
textFieldCursorSelectFirstLine =
  moveWhileKeepingSelection $ nonEmptyCursorSelectFirst rebuildTextCursor unsafeMakeTextCursor

textFieldCursorSelectLastLine :: TextFieldCursor -> TextFieldCursor
textFieldCursorSelectLastLine =
  moveWhileKeepingSelection $ nonEmptyCursorSelectLast rebuildTextCursor unsafeMakeTextCursor

moveWhileKeepingSelection ::
     (NonEmptyCursor TextCursor Text -> NonEmptyCursor TextCursor Text)
  -> TextFieldCursor
  -> TextFieldCursor
moveWhileKeepingSelection movement tfc =
  let i = textFieldCursorIndexOnLine tfc
      tfc' = textFieldCursorSelectIndexOnLine 0 tfc
      tfc'' = tfc' & textFieldCursorNonEmptyCursorL %~ movement
   in textFieldCursorSelectIndexOnLine i tfc''

textFieldCursorSelectPrevChar :: TextFieldCursor -> Maybe TextFieldCursor
textFieldCursorSelectPrevChar = textFieldCursorSelectedL textCursorSelectPrev

textFieldCursorSelectNextChar :: TextFieldCursor -> Maybe TextFieldCursor
textFieldCursorSelectNextChar = textFieldCursorSelectedL textCursorSelectNext

textFieldCursorIndexOnLine :: TextFieldCursor -> Int
textFieldCursorIndexOnLine tfc = textCursorIndex $ tfc ^. textFieldCursorSelectedL

textFieldCursorSelectIndexOnLine :: Int -> TextFieldCursor -> TextFieldCursor
textFieldCursorSelectIndexOnLine ix_ = textFieldCursorSelectedL %~ textCursorSelectIndex ix_

-- |
--
-- returns 'Nothing' when given unsafe characters.
textFieldCursorInsertChar :: Char -> Maybe TextFieldCursor -> Maybe TextFieldCursor
textFieldCursorInsertChar c mtfc =
  case c of
    '\n' -> Just $ textFieldCursorInsertNewline mtfc
    _
      | isSafeChar c ->
        Just $
        fromMaybe emptyTextFieldCursor mtfc &
        textFieldCursorSelectedL %~ (fromJust . textCursorInsert c)
      | otherwise -> Nothing

-- |
--
-- returns 'Nothing' when given unsafe characters.
textFieldCursorAppendChar :: Char -> Maybe TextFieldCursor -> Maybe TextFieldCursor
textFieldCursorAppendChar c mtfc =
  case c of
    '\n' -> Just $ textFieldCursorAppendNewline mtfc
    _
      | isSafeChar c ->
        Just $
        fromMaybe emptyTextFieldCursor mtfc &
        textFieldCursorSelectedL %~ (fromJust . textCursorAppend c)
      | otherwise -> Nothing

textFieldCursorInsertNewline :: Maybe TextFieldCursor -> TextFieldCursor
textFieldCursorInsertNewline mtfc =
  let tfc = fromMaybe emptyTextFieldCursor mtfc
   in tfc &
      textFieldCursorNonEmptyCursorL %~
      (\lec@NonEmptyCursor {..} ->
         let (tc1, tc2) = textCursorSplit nonEmptyCursorCurrent
          in lec
               { nonEmptyCursorPrev = rebuildTextCursor tc1 : nonEmptyCursorPrev
               , nonEmptyCursorCurrent = tc2
               })

textFieldCursorAppendNewline :: Maybe TextFieldCursor -> TextFieldCursor
textFieldCursorAppendNewline mtfc =
  let tfc = fromMaybe emptyTextFieldCursor mtfc
   in tfc &
      textFieldCursorNonEmptyCursorL %~
      (\lec@NonEmptyCursor {..} ->
         let (tc1, tc2) = textCursorSplit nonEmptyCursorCurrent
          in lec
               { nonEmptyCursorCurrent = tc1
               , nonEmptyCursorNext = rebuildTextCursor tc2 : nonEmptyCursorNext
               })

textFieldCursorRemove :: TextFieldCursor -> Maybe (DeleteOrUpdate TextFieldCursor)
textFieldCursorRemove tfc =
  if nullTextFieldCursor tfc
    then Just Deleted
    else focusPossibleDeleteOrUpdate
           textFieldCursorNonEmptyCursorL
           (\lec@NonEmptyCursor {..} ->
              case textCursorRemove nonEmptyCursorCurrent of
                Just (Updated ctc) -> Just $ Updated $ lec & nonEmptyCursorElemL .~ ctc
                _ ->
                  case nonEmptyCursorPrev of
                    [] -> Nothing
                    (pl:pls) ->
                      Just $
                      Updated $
                      lec
                        { nonEmptyCursorPrev = pls
                        , nonEmptyCursorCurrent =
                            textCursorCombine (unsafeMakeTextCursor pl) nonEmptyCursorCurrent
                        })
           tfc

textFieldCursorDelete :: TextFieldCursor -> Maybe (DeleteOrUpdate TextFieldCursor)
textFieldCursorDelete tfc =
  if nullTextFieldCursor tfc
    then Just Deleted
    else focusPossibleDeleteOrUpdate
           textFieldCursorNonEmptyCursorL
           (\lec@NonEmptyCursor {..} ->
              case textCursorDelete nonEmptyCursorCurrent of
                Just (Updated ctc) -> Just $ Updated $ lec & nonEmptyCursorElemL .~ ctc
                _ ->
                  case nonEmptyCursorNext of
                    [] -> Nothing
                    (pl:pls) ->
                      Just $
                      Updated $
                      lec
                        { nonEmptyCursorCurrent =
                            textCursorCombine nonEmptyCursorCurrent (unsafeMakeTextCursor pl)
                        , nonEmptyCursorNext = pls
                        })
           tfc

textFieldCursorSelectStartOfLine :: TextFieldCursor -> TextFieldCursor
textFieldCursorSelectStartOfLine = textFieldCursorSelectedL %~ textCursorSelectStart

textFieldCursorSelectEndOfLine :: TextFieldCursor -> TextFieldCursor
textFieldCursorSelectEndOfLine = textFieldCursorSelectedL %~ textCursorSelectEnd

-- Unsafe: only use for movements.
unsafeMakeTextCursor :: Text -> TextCursor
unsafeMakeTextCursor = fromJust . makeTextCursor