Repl.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ViewPatterns #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
module Swarm.TUI.Model.Repl (
  -- ** REPL
  REPLEntryType (..),
  REPLHistItemType (..),
  REPLHistItem (..),
  isREPLEntry,
  getREPLSubmitted,
  isREPLSaved,
  getREPLEntry,
  REPLHistory,
  replIndex,
  replLength,
  replHasExecutedManualInput,
  replSeq,
  newREPLHistory,
  addREPLItem,
  restartREPLHistory,
  getLatestREPLHistoryItems,
  getSessionREPLHistoryItems,
  moveReplHistIndex,
  getCurrentItemText,
  replIndexIsAtInput,
  TimeDir (..),

  -- ** Prompt utils
  REPLPrompt (..),
  removeEntry,

  -- *** REPL Panel Model
  REPLState,
  ReplControlMode (..),
  replPromptType,
  replPromptEditor,
  replPromptText,
  replValid,
  replLast,
  replType,
  replControlMode,
  replHistory,
  newREPLEditor,

  -- ** Initialization
  initREPLState,
  defaultPrompt,
  lastEntry,
) where

import Brick.Widgets.Edit (Editor, applyEdit, editorText, getEditContents)
import Control.Lens hiding (from, (.=), (<.>))
import Data.Aeson (ToJSON, object, toJSON, (.=))
import Data.Foldable (toList)
import Data.Maybe (fromMaybe, isJust)
import Data.Sequence (Seq)
import Data.Sequence qualified as Seq
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.Zipper qualified as TZ
import Servant.Docs (ToSample)
import Servant.Docs qualified as SD
import Swarm.Game.Tick (TickNumber (..))
import Swarm.Language.Syntax (SrcLoc (..))
import Swarm.Language.Types
import Swarm.TUI.Model.Name
import Swarm.Util (applyWhen)
import Swarm.Util.Lens (makeLensesNoSigs)

------------------------------------------------------------
-- REPL History
------------------------------------------------------------

-- | Whether a user REPL entry was submitted or merely saved.
data REPLEntryType
  = -- | The entry was submitted (with Enter) and should thus be shown
    --   in the REPL scrollback.
    Submitted
  | -- | The entry was merely saved (e.g. by hitting down
    --   arrow) and should thus be available in the history but not
    --   shown in the scrollback.
    Stashed
  deriving (Eq, Ord, Show, Read)

-- | Various types of REPL history items (user input, output, error).
data REPLHistItemType
  = -- | Something entered by the user.
    REPLEntry REPLEntryType
  | -- | A response printed by the system.
    REPLOutput
  | -- | An error printed by the system.
    REPLError
  deriving (Eq, Ord, Show, Read)

-- | An item in the REPL history.
data REPLHistItem = REPLHistItem
  { replItemType :: REPLHistItemType
  , replItemTick :: TickNumber
  , replItemText :: Text
  }
  deriving (Eq, Ord, Show, Read)

instance ToSample REPLHistItem where
  toSamples _ =
    SD.samples
      [ REPLHistItem
          (REPLEntry Submitted)
          (TickNumber 0)
          "grab"
      , REPLHistItem
          REPLOutput
          (TickNumber 0)
          "it0 : text = \"tree\""
      , REPLHistItem
          (REPLEntry Stashed)
          (TickNumber 1)
          "place"
      , REPLHistItem
          (REPLEntry Submitted)
          (TickNumber 2)
          "place tree"
      , REPLHistItem
          REPLError
          (TickNumber 2)
          "1:7: Unbound variable tree"
      ]

instance ToJSON REPLHistItem where
  toJSON (REPLHistItem itemType tick x) = object ["tick" .= tick, label .= x]
   where
    label = case itemType of
      REPLEntry Submitted -> "in"
      REPLEntry Stashed -> "save"
      REPLOutput -> "out"
      REPLError -> "err"

-- | Useful helper function to only get user input text.  Gets all
--   user input, including both submitted and saved history items.
getREPLEntry :: REPLHistItem -> Maybe Text
getREPLEntry = \case
  REPLHistItem (REPLEntry {}) _ t -> Just t
  _ -> Nothing

-- | Useful helper function to filter out REPL output.  Returns True
--   for all user input, including both submitted and saved history
--   items.
isREPLEntry :: REPLHistItem -> Bool
isREPLEntry = isJust . getREPLEntry

-- | Helper function to get only submitted user input text.
getREPLSubmitted :: REPLHistItem -> Maybe Text
getREPLSubmitted = \case
  REPLHistItem (REPLEntry Submitted) _ t -> Just t
  _ -> Nothing

-- | Useful helper function to filter out saved REPL entries (which
--   should not be shown in the scrollback).
isREPLSaved :: REPLHistItem -> Bool
isREPLSaved (REPLHistItem (REPLEntry Stashed) _ _) = True
isREPLSaved _ = False

-- | History of the REPL with indices (0 is first entry) to the current
--   line and to the first entry since loading saved history.
--   We also (ab)use the length of the REPL as the index of current
--   input line, since that number is one past the index of last entry.
data REPLHistory = REPLHistory
  { _replSeq :: Seq REPLHistItem
  , _replIndex :: Int
  , _replStart :: Int
  , _replHasExecutedManualInput :: Bool
  }
  deriving (Show)

makeLensesNoSigs ''REPLHistory

-- | Sequence of REPL inputs and outputs, oldest entry is leftmost.
replSeq :: Lens' REPLHistory (Seq REPLHistItem)

-- | The current index in the REPL history (if the user is going back
--   through the history using up/down keys).
replIndex :: Lens' REPLHistory Int

-- | The index of the first entry since loading saved history.
--
-- It will be set on load and reset on save (happens during exit).
replStart :: Lens' REPLHistory Int

-- | Keep track of whether the user has explicitly executed commands
--   at the REPL prompt, thus making them ineligible for code size scoring.
--
--   Note: Instead of adding a dedicated field to the 'REPLHistory' record,
--   an early attempt entailed checking for:
--
--     @_replIndex > _replStart@
--
--   However, executing an initial script causes a "REPLOutput" to be
--   appended to the REPL history, which increments the replIndex, and
--   thus makes the Index greater than the Start even though the
--   player has not input commands directly into the REPL.
--
--   Therefore, a dedicated boolean is introduced into 'REPLHistory'
--   which simply latches True when the user has input a command.
--
--   An alternative is described in
--   <https://github.com/swarm-game/swarm/pull/974#discussion_r1112380380 issue #974>.
replHasExecutedManualInput :: Lens' REPLHistory Bool

-- | Create new REPL history (i.e. from loaded history file lines).
newREPLHistory :: [REPLHistItem] -> REPLHistory
newREPLHistory xs =
  let s = Seq.fromList xs
   in REPLHistory
        { _replSeq = s
        , _replStart = length s
        , _replIndex = length s
        , _replHasExecutedManualInput = False
        }

-- | Point the start of REPL history after current last line. See 'replStart'.
restartREPLHistory :: REPLHistory -> REPLHistory
restartREPLHistory h = h & replStart .~ replLength h

-- | Current number lines of the REPL history - (ab)used as index of input buffer.
replLength :: REPLHistory -> Int
replLength = length . _replSeq

-- | Add new REPL input - the index must have been pointing one past
--   the last element already, so we increment it to keep it that way.
addREPLItem :: REPLHistItem -> REPLHistory -> REPLHistory
addREPLItem t h =
  h
    & replSeq %~ (|> t)
    & replIndex .~ 1 + replLength h

-- | Get the latest N items in history, starting with the oldest one.
--
-- This is used to show previous REPL lines in UI, so we need the items
-- sorted in the order they were entered and will be drawn top to bottom.
getLatestREPLHistoryItems :: Int -> REPLHistory -> [REPLHistItem]
getLatestREPLHistoryItems n h = toList latestN
 where
  latestN = Seq.drop oldestIndex $ h ^. replSeq
  oldestIndex = max (h ^. replStart) $ length (h ^. replSeq) - n

-- | Get only the items from the REPL history that were entered during
--   the current session.
getSessionREPLHistoryItems :: REPLHistory -> Seq REPLHistItem
getSessionREPLHistoryItems h = Seq.drop (h ^. replStart) (h ^. replSeq)

data TimeDir = Newer | Older deriving (Eq, Ord, Show)

moveReplHistIndex :: TimeDir -> Text -> REPLHistory -> REPLHistory
moveReplHistIndex d lastEntered history = history & replIndex .~ newIndex
 where
  historyLen = replLength history
  curText = fromMaybe lastEntered $ getCurrentItemText history
  curIndex = history ^. replIndex
  entries = history ^. replSeq
  -- split repl at index
  (olderP, newer) = Seq.splitAt curIndex entries
  -- find first different entry in direction
  notSameEntry = \case
    REPLHistItem (REPLEntry {}) _tick t -> t /= curText
    _ -> False
  newIndex = case d of
    Newer -> maybe historyLen (curIndex +) $ Seq.findIndexL notSameEntry newer
    Older -> fromMaybe curIndex $ Seq.findIndexR notSameEntry olderP

getCurrentItemText :: REPLHistory -> Maybe Text
getCurrentItemText history = replItemText <$> Seq.lookup (history ^. replIndex) (history ^. replSeq)

replIndexIsAtInput :: REPLHistory -> Bool
replIndexIsAtInput repl = repl ^. replIndex == replLength repl

-- | Given some text,  removes the 'REPLEntry' within 'REPLHistory' which is equal to that.
--   This is used when the user enters search mode and wants to traverse the history.
--   If a command has been used many times, the history will be populated with it causing
--   the effect that search command always finds the same command.
removeEntry :: Text -> REPLHistory -> REPLHistory
removeEntry foundtext hist = hist & replSeq %~ Seq.filter ((/= Just foundtext) . getREPLEntry)

-- | Get the last 'REPLEntry' in 'REPLHistory' matching the given text
lastEntry :: Text -> REPLHistory -> Maybe Text
lastEntry t h =
  case Seq.viewr $ Seq.filter matchEntry $ h ^. replSeq of
    Seq.EmptyR -> Nothing
    _ Seq.:> a -> Just (replItemText a)
 where
  matchesText histItem = t `T.isInfixOf` replItemText histItem
  matchEntry = liftA2 (&&) matchesText isREPLEntry

------------------------------------------------------------
-- REPL
------------------------------------------------------------

-- | This data type tells us how to interpret the text typed
--   by the player at the prompt (which is stored in Editor).
data REPLPrompt
  = -- | Interpret the prompt text as a regular command.
    --   The list is for potential completions, which we can
    --   cycle through by hitting Tab repeatedly
    CmdPrompt [Text]
  | -- | Interpret the prompt text as "search this text in history"
    SearchPrompt REPLHistory

defaultPrompt :: REPLPrompt
defaultPrompt = CmdPrompt []

-- | What is being done with user input to the REPL panel?
data ReplControlMode
  = -- | The user is typing at the REPL.
    Typing
  | -- | The user is driving the base using piloting mode.
    Piloting
  | -- | A custom user key handler is processing user input.
    Handling
  deriving (Eq, Bounded, Enum)

data REPLState = REPLState
  { _replPromptType :: REPLPrompt
  , _replPromptEditor :: Editor Text Name
  , _replValid :: Either SrcLoc ()
  , _replLast :: Text
  , _replType :: Maybe Polytype
  , _replControlMode :: ReplControlMode
  , _replHistory :: REPLHistory
  }

newREPLEditor :: Text -> Editor Text Name
newREPLEditor t = applyEdit gotoEnd $ editorText REPLInput (Just 1) t
 where
  ls = T.lines t
  pos = (length ls - 1, T.length (last ls))
  gotoEnd = applyWhen (not $ null ls) $ TZ.moveCursor pos

initREPLState :: REPLHistory -> REPLState
initREPLState hist =
  REPLState
    { _replPromptType = defaultPrompt
    , _replPromptEditor = newREPLEditor ""
    , _replValid = Right ()
    , _replLast = ""
    , _replType = Nothing
    , _replControlMode = Typing
    , _replHistory = hist
    }

makeLensesNoSigs ''REPLState

-- | The way we interpret text typed by the player in the REPL prompt.
replPromptType :: Lens' REPLState REPLPrompt

-- | The prompt where the user can type input at the REPL.
replPromptEditor :: Lens' REPLState (Editor Text Name)

-- | Convenience lens to get text from editor and replace it with new
--   one that has the provided text.
replPromptText :: Lens' REPLState Text
replPromptText = lens g s
 where
  g r = r ^. replPromptEditor . to getEditContents . to T.concat
  s r t = r & replPromptEditor .~ newREPLEditor t

-- | Whether the prompt text is a valid 'Swarm.Language.Syntax.Term'.
--   If it is invalid, the location of error. ('NoLoc' means the whole
--   text causes the error.)
replValid :: Lens' REPLState (Either SrcLoc ())

-- | The type of the current REPL input which should be displayed to
--   the user (if any).
replType :: Lens' REPLState (Maybe Polytype)

-- | The last thing the user has typed which isn't part of the history.
--   This is used to restore the repl form after the user visited the history.
replLast :: Lens' REPLState Text

-- | The current REPL control mode, i.e. how user input to the REPL
--   panel is being handled.
replControlMode :: Lens' REPLState ReplControlMode

-- | History of things the user has typed at the REPL, interleaved
--   with outputs the system has generated.
replHistory :: Lens' REPLState REPLHistory