content: {-# LANGUAGE TemplateHaskell #-}
  
  {-|
  Module      : Client.State.EditBox
  Description : Console-mode text box
  Copyright   : (c) Eric Mertens, 2016
  License     : ISC
  Maintainer  : emertens@gmail.com
  
  This module provides support for the text operations important for
  providing a text input in the IRC client. It tracks user input
  history, tab completion history, and provides many update operations
  which are mapped to the keyboard in "Client.EventLoop".
  
  -}
  
  module Client.State.EditBox
    ( -- * Edit box type
      EditBox
    , defaultEditBox
    , content
    , lastOperation
  
      -- * Line type
    , Line(Line)
    , singleLine
    , endLine
    , HasLine(..)
  
    -- * Content type
    , Content
    , shift
    , above
    , below
  
    -- * Operations
    , delete
    , backspace
    , home
    , end
    , killHome
    , killEnd
    , killWordBackward
    , killWordForward
    , yank
    , toggle
    , left
    , right
    , leftWord
    , rightWord
    , insert
    , insertPaste
    , insertString
    , earlier
    , later
    , success
    , insertDigraph
  
    -- * Last operation
    , LastOperation(..)
  
    ) where
  
  import Client.State.EditBox.Content
  import Control.Lens hiding (below)
  import Data.List.NonEmpty (NonEmpty)
  import Data.Map (Map)
  import Data.Text (Text)
  import Digraphs (Digraph)
  
  
  data EditBox = EditBox
    { _content       :: !Content
    , _history       :: ![NonEmpty String]
    , _historyPos    :: !Int
    , _yankBuffer    :: String
    , _lastOperation :: !LastOperation
    }
    deriving (Read, Show)
  
  data LastOperation
    = TabOperation String
    | KillOperation
    | OtherOperation
    deriving (Read, Show)
  
  makeLenses ''EditBox
  
  -- | Default 'EditBox' value
  defaultEditBox :: EditBox
  defaultEditBox = EditBox
    { _content       = noContent
    , _history       = []
    , _historyPos    = -1
    , _yankBuffer    = ""
    , _lastOperation = OtherOperation
    }
  
  instance HasLine EditBox where
    line = content . line
  
  data KillDirection = KillForward | KillBackward
  
  -- | Sets the given string to the yank buffer unless the string is empty.
  updateYankBuffer :: KillDirection -> String -> EditBox -> EditBox
  updateYankBuffer dir str e =
    case view lastOperation e of
      _ | null str  -> set lastOperation OtherOperation e -- failed kill interrupts kill sequence
      KillOperation ->
        case dir of
          KillForward  -> over yankBuffer (++ str) e
          KillBackward -> over yankBuffer (str ++) e
      _ -> set yankBuffer str
         $ set lastOperation KillOperation e
  
  -- | Indicate that the contents of the text box were successfully used
  -- by the program. This clears the first line of the contents and updates
  -- the history.
  success :: EditBox -> EditBox
  success e
    = over history (cons (pure sent))
    $ set  content c
    $ set  lastOperation OtherOperation
    $ set  historyPos (-1)
    $ e
   where
   (sent, c) = shift $ view content e
  
  replaceList :: Int -> [a] -> [a] -> [a]
  replaceList i rpl xs =
    case splitAt i xs of
      (a, b) -> a ++ rpl ++ drop 1 b
  
  -- | Update the editbox to reflect the earlier element in the history.
  earlier :: EditBox -> Maybe EditBox
  earlier e =
    do x <- preview (history . ix (i+1)) e
       return $ set content (fromStrings x)
              $ set lastOperation OtherOperation
              $ set historyPos i'
              $ over history updateHistory e
    where
      i = view historyPos e
  
      i' | i < 0     = length txt
         | otherwise = length txt + i
  
      txt = filter (/= pure "") [toStrings (view content e)]
  
      updateHistory h
        | i < 0     = txt ++ h
        | otherwise = replaceList i txt h
  
  -- | Update the editbox to reflect the later element in the history.
  later :: EditBox -> Maybe EditBox
  later e
    | i < 0 && null txt = Nothing
    | otherwise = Just $!
                    set content newContent
                  $ set lastOperation OtherOperation
                  $ set historyPos i'
                  $ over history updateHistory e
    where
      txt = filter (/= pure "") [toStrings (view content e)]
  
      i = view historyPos e
  
      i' | i < 0 = -1
         | otherwise = i - 1
  
      newContent = maybe noContent fromStrings
                 $ preview (history . ix (i-1)) e
  
      updateHistory h
        | i < 0     = txt ++ h
        | otherwise = replaceList i txt h
  
  -- | Jump the cursor to the beginning of the input.
  home :: EditBox -> EditBox
  home
    = set lastOperation OtherOperation
    . over content jumpLeft
  
  -- | Jump the cursor to the end of the input.
  end :: EditBox -> EditBox
  end
    = set lastOperation OtherOperation
    . over content jumpRight
  
  -- | Delete all text from the cursor to the end and store it in
  -- the yank buffer.
  killEnd :: EditBox -> EditBox
  killEnd e
    | null kill
    = case view (content . below) e of
        []   -> e
        b:bs -> set (content . below) bs
              $ updateYankBuffer KillForward ('\n':b) e
    | otherwise
    = set line (endLine keep)
    $ updateYankBuffer KillForward kill e
    where
    Line n txt = view line e
    (keep,kill) = splitAt n txt
  
  -- | Delete all text from the cursor to the beginning and store it in
  -- the yank buffer.
  killHome :: EditBox -> EditBox
  killHome e
    | null kill
    = case view (content . above) e of
        []   -> e
        a:as -> set (content . above) as
              $ updateYankBuffer KillBackward (a++"\n") e
  
    | otherwise
    = set line (Line 0 keep)
    $ updateYankBuffer KillBackward kill e
    where
    Line n txt = view line e
    (kill,keep) = splitAt n txt
  
  -- | Insert the yank buffer at the cursor.
  yank :: EditBox -> EditBox
  yank e
    = over content (insertString (view yankBuffer e))
    $ set lastOperation OtherOperation e
  
  -- | Kill the content from the cursor back to the previous word boundary.
  -- When @yank@ is set the yank buffer will be updated.
  killWordBackward :: (Char -> Bool) -> Bool {- ^ yank -} -> EditBox -> EditBox
  killWordBackward p saveKill e
    = sometimesUpdateYank
    $ set line (Line (length l') (l'++r))
    $ e
    where
    Line n txt = view line e
    (l,r) = splitAt n txt
    (sp,l1) = span  p (reverse l)
    (wd,l2) = break p l1
    l' = reverse l2
    yanked = reverse (sp++wd)
  
    sometimesUpdateYank
      | saveKill  = updateYankBuffer KillBackward yanked
      | otherwise = id -- don't update operation
  
  -- | Kill the content from the curser forward to the next word boundary.
  -- When @yank@ is set the yank buffer will be updated
  killWordForward :: (Char -> Bool) -> Bool {- ^ yank -} -> EditBox -> EditBox
  killWordForward p saveKill e
    = sometimesUpdateYank
    $ set line (Line (length l) (l++r2))
    $ e
    where
    Line n txt = view line e
    (l,r) = splitAt n txt
    (sp,r1) = span  p r
    (wd,r2) = break p r1
    yanked = sp++wd
  
    sometimesUpdateYank
      | saveKill  = updateYankBuffer KillForward yanked
      | otherwise = id -- don't update operation
  
  -- | Insert a character at the cursor and advance the cursor.
  insert :: Char -> EditBox -> EditBox
  insert c
    = set lastOperation OtherOperation
    . over content (insertChar c)
  
  
  insertPaste :: String -> EditBox -> EditBox
  insertPaste paste
    = over content (insertPastedString paste)
    . set lastOperation OtherOperation
  
  
  insertDigraph :: Map Digraph Text -> EditBox -> Maybe EditBox
  insertDigraph extras
    = content (digraph extras)
    . set lastOperation OtherOperation
  