{-# 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 (..),
  mkREPLSubmission,
  mkREPLSaved,
  mkREPLOutput,
  mkREPLError,
  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.Applicative (Applicative (liftA2))
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.Language.Syntax (SrcLoc (..))
import Swarm.Language.Types
import Swarm.TUI.Model.Name
import Swarm.Util.Lens (makeLensesNoSigs)
import Prelude hiding (Applicative (..))

------------------------------------------------------------
-- 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.
    REPLEntrySubmitted
  | -- | 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.
    REPLEntrySaved
  deriving (REPLEntryType -> REPLEntryType -> Bool
(REPLEntryType -> REPLEntryType -> Bool)
-> (REPLEntryType -> REPLEntryType -> Bool) -> Eq REPLEntryType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: REPLEntryType -> REPLEntryType -> Bool
== :: REPLEntryType -> REPLEntryType -> Bool
$c/= :: REPLEntryType -> REPLEntryType -> Bool
/= :: REPLEntryType -> REPLEntryType -> Bool
Eq, Eq REPLEntryType
Eq REPLEntryType =>
(REPLEntryType -> REPLEntryType -> Ordering)
-> (REPLEntryType -> REPLEntryType -> Bool)
-> (REPLEntryType -> REPLEntryType -> Bool)
-> (REPLEntryType -> REPLEntryType -> Bool)
-> (REPLEntryType -> REPLEntryType -> Bool)
-> (REPLEntryType -> REPLEntryType -> REPLEntryType)
-> (REPLEntryType -> REPLEntryType -> REPLEntryType)
-> Ord REPLEntryType
REPLEntryType -> REPLEntryType -> Bool
REPLEntryType -> REPLEntryType -> Ordering
REPLEntryType -> REPLEntryType -> REPLEntryType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: REPLEntryType -> REPLEntryType -> Ordering
compare :: REPLEntryType -> REPLEntryType -> Ordering
$c< :: REPLEntryType -> REPLEntryType -> Bool
< :: REPLEntryType -> REPLEntryType -> Bool
$c<= :: REPLEntryType -> REPLEntryType -> Bool
<= :: REPLEntryType -> REPLEntryType -> Bool
$c> :: REPLEntryType -> REPLEntryType -> Bool
> :: REPLEntryType -> REPLEntryType -> Bool
$c>= :: REPLEntryType -> REPLEntryType -> Bool
>= :: REPLEntryType -> REPLEntryType -> Bool
$cmax :: REPLEntryType -> REPLEntryType -> REPLEntryType
max :: REPLEntryType -> REPLEntryType -> REPLEntryType
$cmin :: REPLEntryType -> REPLEntryType -> REPLEntryType
min :: REPLEntryType -> REPLEntryType -> REPLEntryType
Ord, Int -> REPLEntryType -> ShowS
[REPLEntryType] -> ShowS
REPLEntryType -> String
(Int -> REPLEntryType -> ShowS)
-> (REPLEntryType -> String)
-> ([REPLEntryType] -> ShowS)
-> Show REPLEntryType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> REPLEntryType -> ShowS
showsPrec :: Int -> REPLEntryType -> ShowS
$cshow :: REPLEntryType -> String
show :: REPLEntryType -> String
$cshowList :: [REPLEntryType] -> ShowS
showList :: [REPLEntryType] -> ShowS
Show, ReadPrec [REPLEntryType]
ReadPrec REPLEntryType
Int -> ReadS REPLEntryType
ReadS [REPLEntryType]
(Int -> ReadS REPLEntryType)
-> ReadS [REPLEntryType]
-> ReadPrec REPLEntryType
-> ReadPrec [REPLEntryType]
-> Read REPLEntryType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS REPLEntryType
readsPrec :: Int -> ReadS REPLEntryType
$creadList :: ReadS [REPLEntryType]
readList :: ReadS [REPLEntryType]
$creadPrec :: ReadPrec REPLEntryType
readPrec :: ReadPrec REPLEntryType
$creadListPrec :: ReadPrec [REPLEntryType]
readListPrec :: ReadPrec [REPLEntryType]
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 (REPLHistItemType -> REPLHistItemType -> Bool
(REPLHistItemType -> REPLHistItemType -> Bool)
-> (REPLHistItemType -> REPLHistItemType -> Bool)
-> Eq REPLHistItemType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: REPLHistItemType -> REPLHistItemType -> Bool
== :: REPLHistItemType -> REPLHistItemType -> Bool
$c/= :: REPLHistItemType -> REPLHistItemType -> Bool
/= :: REPLHistItemType -> REPLHistItemType -> Bool
Eq, Eq REPLHistItemType
Eq REPLHistItemType =>
(REPLHistItemType -> REPLHistItemType -> Ordering)
-> (REPLHistItemType -> REPLHistItemType -> Bool)
-> (REPLHistItemType -> REPLHistItemType -> Bool)
-> (REPLHistItemType -> REPLHistItemType -> Bool)
-> (REPLHistItemType -> REPLHistItemType -> Bool)
-> (REPLHistItemType -> REPLHistItemType -> REPLHistItemType)
-> (REPLHistItemType -> REPLHistItemType -> REPLHistItemType)
-> Ord REPLHistItemType
REPLHistItemType -> REPLHistItemType -> Bool
REPLHistItemType -> REPLHistItemType -> Ordering
REPLHistItemType -> REPLHistItemType -> REPLHistItemType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: REPLHistItemType -> REPLHistItemType -> Ordering
compare :: REPLHistItemType -> REPLHistItemType -> Ordering
$c< :: REPLHistItemType -> REPLHistItemType -> Bool
< :: REPLHistItemType -> REPLHistItemType -> Bool
$c<= :: REPLHistItemType -> REPLHistItemType -> Bool
<= :: REPLHistItemType -> REPLHistItemType -> Bool
$c> :: REPLHistItemType -> REPLHistItemType -> Bool
> :: REPLHistItemType -> REPLHistItemType -> Bool
$c>= :: REPLHistItemType -> REPLHistItemType -> Bool
>= :: REPLHistItemType -> REPLHistItemType -> Bool
$cmax :: REPLHistItemType -> REPLHistItemType -> REPLHistItemType
max :: REPLHistItemType -> REPLHistItemType -> REPLHistItemType
$cmin :: REPLHistItemType -> REPLHistItemType -> REPLHistItemType
min :: REPLHistItemType -> REPLHistItemType -> REPLHistItemType
Ord, Int -> REPLHistItemType -> ShowS
[REPLHistItemType] -> ShowS
REPLHistItemType -> String
(Int -> REPLHistItemType -> ShowS)
-> (REPLHistItemType -> String)
-> ([REPLHistItemType] -> ShowS)
-> Show REPLHistItemType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> REPLHistItemType -> ShowS
showsPrec :: Int -> REPLHistItemType -> ShowS
$cshow :: REPLHistItemType -> String
show :: REPLHistItemType -> String
$cshowList :: [REPLHistItemType] -> ShowS
showList :: [REPLHistItemType] -> ShowS
Show, ReadPrec [REPLHistItemType]
ReadPrec REPLHistItemType
Int -> ReadS REPLHistItemType
ReadS [REPLHistItemType]
(Int -> ReadS REPLHistItemType)
-> ReadS [REPLHistItemType]
-> ReadPrec REPLHistItemType
-> ReadPrec [REPLHistItemType]
-> Read REPLHistItemType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS REPLHistItemType
readsPrec :: Int -> ReadS REPLHistItemType
$creadList :: ReadS [REPLHistItemType]
readList :: ReadS [REPLHistItemType]
$creadPrec :: ReadPrec REPLHistItemType
readPrec :: ReadPrec REPLHistItemType
$creadListPrec :: ReadPrec [REPLHistItemType]
readListPrec :: ReadPrec [REPLHistItemType]
Read)

-- | An item in the REPL history.
data REPLHistItem = REPLHistItem {REPLHistItem -> REPLHistItemType
replItemType :: REPLHistItemType, REPLHistItem -> Text
replItemText :: Text}
  deriving (REPLHistItem -> REPLHistItem -> Bool
(REPLHistItem -> REPLHistItem -> Bool)
-> (REPLHistItem -> REPLHistItem -> Bool) -> Eq REPLHistItem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: REPLHistItem -> REPLHistItem -> Bool
== :: REPLHistItem -> REPLHistItem -> Bool
$c/= :: REPLHistItem -> REPLHistItem -> Bool
/= :: REPLHistItem -> REPLHistItem -> Bool
Eq, Eq REPLHistItem
Eq REPLHistItem =>
(REPLHistItem -> REPLHistItem -> Ordering)
-> (REPLHistItem -> REPLHistItem -> Bool)
-> (REPLHistItem -> REPLHistItem -> Bool)
-> (REPLHistItem -> REPLHistItem -> Bool)
-> (REPLHistItem -> REPLHistItem -> Bool)
-> (REPLHistItem -> REPLHistItem -> REPLHistItem)
-> (REPLHistItem -> REPLHistItem -> REPLHistItem)
-> Ord REPLHistItem
REPLHistItem -> REPLHistItem -> Bool
REPLHistItem -> REPLHistItem -> Ordering
REPLHistItem -> REPLHistItem -> REPLHistItem
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: REPLHistItem -> REPLHistItem -> Ordering
compare :: REPLHistItem -> REPLHistItem -> Ordering
$c< :: REPLHistItem -> REPLHistItem -> Bool
< :: REPLHistItem -> REPLHistItem -> Bool
$c<= :: REPLHistItem -> REPLHistItem -> Bool
<= :: REPLHistItem -> REPLHistItem -> Bool
$c> :: REPLHistItem -> REPLHistItem -> Bool
> :: REPLHistItem -> REPLHistItem -> Bool
$c>= :: REPLHistItem -> REPLHistItem -> Bool
>= :: REPLHistItem -> REPLHistItem -> Bool
$cmax :: REPLHistItem -> REPLHistItem -> REPLHistItem
max :: REPLHistItem -> REPLHistItem -> REPLHistItem
$cmin :: REPLHistItem -> REPLHistItem -> REPLHistItem
min :: REPLHistItem -> REPLHistItem -> REPLHistItem
Ord, Int -> REPLHistItem -> ShowS
[REPLHistItem] -> ShowS
REPLHistItem -> String
(Int -> REPLHistItem -> ShowS)
-> (REPLHistItem -> String)
-> ([REPLHistItem] -> ShowS)
-> Show REPLHistItem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> REPLHistItem -> ShowS
showsPrec :: Int -> REPLHistItem -> ShowS
$cshow :: REPLHistItem -> String
show :: REPLHistItem -> String
$cshowList :: [REPLHistItem] -> ShowS
showList :: [REPLHistItem] -> ShowS
Show, ReadPrec [REPLHistItem]
ReadPrec REPLHistItem
Int -> ReadS REPLHistItem
ReadS [REPLHistItem]
(Int -> ReadS REPLHistItem)
-> ReadS [REPLHistItem]
-> ReadPrec REPLHistItem
-> ReadPrec [REPLHistItem]
-> Read REPLHistItem
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS REPLHistItem
readsPrec :: Int -> ReadS REPLHistItem
$creadList :: ReadS [REPLHistItem]
readList :: ReadS [REPLHistItem]
$creadPrec :: ReadPrec REPLHistItem
readPrec :: ReadPrec REPLHistItem
$creadListPrec :: ReadPrec [REPLHistItem]
readListPrec :: ReadPrec [REPLHistItem]
Read)

mkREPLSubmission :: Text -> REPLHistItem
mkREPLSubmission :: Text -> REPLHistItem
mkREPLSubmission = REPLHistItemType -> Text -> REPLHistItem
REPLHistItem (REPLEntryType -> REPLHistItemType
REPLEntry REPLEntryType
REPLEntrySubmitted)

mkREPLSaved :: Text -> REPLHistItem
mkREPLSaved :: Text -> REPLHistItem
mkREPLSaved = REPLHistItemType -> Text -> REPLHistItem
REPLHistItem (REPLEntryType -> REPLHistItemType
REPLEntry REPLEntryType
REPLEntrySaved)

mkREPLOutput :: Text -> REPLHistItem
mkREPLOutput :: Text -> REPLHistItem
mkREPLOutput = REPLHistItemType -> Text -> REPLHistItem
REPLHistItem REPLHistItemType
REPLOutput

mkREPLError :: Text -> REPLHistItem
mkREPLError :: Text -> REPLHistItem
mkREPLError = REPLHistItemType -> Text -> REPLHistItem
REPLHistItem REPLHistItemType
REPLError

instance ToSample REPLHistItem where
  toSamples :: Proxy REPLHistItem -> [(Text, REPLHistItem)]
toSamples Proxy REPLHistItem
_ =
    [REPLHistItem] -> [(Text, REPLHistItem)]
forall a. [a] -> [(Text, a)]
SD.samples
      [ REPLHistItemType -> Text -> REPLHistItem
REPLHistItem (REPLEntryType -> REPLHistItemType
REPLEntry REPLEntryType
REPLEntrySubmitted) Text
"grab"
      , REPLHistItemType -> Text -> REPLHistItem
REPLHistItem REPLHistItemType
REPLOutput Text
"it0 : text = \"tree\""
      , REPLHistItemType -> Text -> REPLHistItem
REPLHistItem (REPLEntryType -> REPLHistItemType
REPLEntry REPLEntryType
REPLEntrySaved) Text
"place"
      , REPLHistItemType -> Text -> REPLHistItem
REPLHistItem (REPLEntryType -> REPLHistItemType
REPLEntry REPLEntryType
REPLEntrySubmitted) Text
"place tree"
      , REPLHistItemType -> Text -> REPLHistItem
REPLHistItem REPLHistItemType
REPLError Text
"1:7: Unbound variable tree"
      ]

instance ToJSON REPLHistItem where
  toJSON :: REPLHistItem -> Value
toJSON (REPLHistItem REPLHistItemType
itemType Text
x) = [Pair] -> Value
object [Key
label Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
x]
   where
    label :: Key
label = case REPLHistItemType
itemType of
      REPLEntry REPLEntryType
REPLEntrySubmitted -> Key
"in"
      REPLEntry REPLEntryType
REPLEntrySaved -> Key
"save"
      REPLHistItemType
REPLOutput -> Key
"out"
      REPLHistItemType
REPLError -> Key
"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 :: REPLHistItem -> Maybe Text
getREPLEntry = \case
  REPLHistItem (REPLEntry {}) Text
t -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t
  REPLHistItem
_ -> Maybe Text
forall a. Maybe a
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 :: REPLHistItem -> Bool
isREPLEntry = Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Text -> Bool)
-> (REPLHistItem -> Maybe Text) -> REPLHistItem -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. REPLHistItem -> Maybe Text
getREPLEntry

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

-- | Useful helper function to filter out saved REPL entries (which
--   should not be shown in the scrollback).
isREPLSaved :: REPLHistItem -> Bool
isREPLSaved :: REPLHistItem -> Bool
isREPLSaved (REPLHistItem (REPLEntry REPLEntryType
REPLEntrySaved) Text
_) = Bool
True
isREPLSaved REPLHistItem
_ = Bool
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
  { REPLHistory -> Seq REPLHistItem
_replSeq :: Seq REPLHistItem
  , REPLHistory -> Int
_replIndex :: Int
  , REPLHistory -> Int
_replStart :: Int
  , REPLHistory -> Bool
_replHasExecutedManualInput :: Bool
  }
  deriving (Int -> REPLHistory -> ShowS
[REPLHistory] -> ShowS
REPLHistory -> String
(Int -> REPLHistory -> ShowS)
-> (REPLHistory -> String)
-> ([REPLHistory] -> ShowS)
-> Show REPLHistory
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> REPLHistory -> ShowS
showsPrec :: Int -> REPLHistory -> ShowS
$cshow :: REPLHistory -> String
show :: REPLHistory -> String
$cshowList :: [REPLHistory] -> ShowS
showList :: [REPLHistory] -> ShowS
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 :: [REPLHistItem] -> REPLHistory
newREPLHistory [REPLHistItem]
xs =
  let s :: Seq REPLHistItem
s = [REPLHistItem] -> Seq REPLHistItem
forall a. [a] -> Seq a
Seq.fromList [REPLHistItem]
xs
   in REPLHistory
        { _replSeq :: Seq REPLHistItem
_replSeq = Seq REPLHistItem
s
        , _replStart :: Int
_replStart = Seq REPLHistItem -> Int
forall a. Seq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq REPLHistItem
s
        , _replIndex :: Int
_replIndex = Seq REPLHistItem -> Int
forall a. Seq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq REPLHistItem
s
        , _replHasExecutedManualInput :: Bool
_replHasExecutedManualInput = Bool
False
        }

-- | Point the start of REPL history after current last line. See 'replStart'.
restartREPLHistory :: REPLHistory -> REPLHistory
restartREPLHistory :: REPLHistory -> REPLHistory
restartREPLHistory REPLHistory
h = REPLHistory
h REPLHistory -> (REPLHistory -> REPLHistory) -> REPLHistory
forall a b. a -> (a -> b) -> b
& (Int -> Identity Int) -> REPLHistory -> Identity REPLHistory
Lens' REPLHistory Int
replStart ((Int -> Identity Int) -> REPLHistory -> Identity REPLHistory)
-> Int -> REPLHistory -> REPLHistory
forall s t a b. ASetter s t a b -> b -> s -> t
.~ REPLHistory -> Int
replLength REPLHistory
h

-- | Current number lines of the REPL history - (ab)used as index of input buffer.
replLength :: REPLHistory -> Int
replLength :: REPLHistory -> Int
replLength = Seq REPLHistItem -> Int
forall a. Seq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Seq REPLHistItem -> Int)
-> (REPLHistory -> Seq REPLHistItem) -> REPLHistory -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. REPLHistory -> Seq REPLHistItem
_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 :: REPLHistItem -> REPLHistory -> REPLHistory
addREPLItem REPLHistItem
t REPLHistory
h =
  REPLHistory
h
    REPLHistory -> (REPLHistory -> REPLHistory) -> REPLHistory
forall a b. a -> (a -> b) -> b
& (Seq REPLHistItem -> Identity (Seq REPLHistItem))
-> REPLHistory -> Identity REPLHistory
Lens' REPLHistory (Seq REPLHistItem)
replSeq ((Seq REPLHistItem -> Identity (Seq REPLHistItem))
 -> REPLHistory -> Identity REPLHistory)
-> (Seq REPLHistItem -> Seq REPLHistItem)
-> REPLHistory
-> REPLHistory
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Seq REPLHistItem -> REPLHistItem -> Seq REPLHistItem
forall s a. Snoc s s a a => s -> a -> s
|> REPLHistItem
t)
    REPLHistory -> (REPLHistory -> REPLHistory) -> REPLHistory
forall a b. a -> (a -> b) -> b
& (Int -> Identity Int) -> REPLHistory -> Identity REPLHistory
Lens' REPLHistory Int
replIndex ((Int -> Identity Int) -> REPLHistory -> Identity REPLHistory)
-> Int -> REPLHistory -> REPLHistory
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ REPLHistory -> Int
replLength REPLHistory
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 :: Int -> REPLHistory -> [REPLHistItem]
getLatestREPLHistoryItems Int
n REPLHistory
h = Seq REPLHistItem -> [REPLHistItem]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq REPLHistItem
latestN
 where
  latestN :: Seq REPLHistItem
latestN = Int -> Seq REPLHistItem -> Seq REPLHistItem
forall a. Int -> Seq a -> Seq a
Seq.drop Int
oldestIndex (Seq REPLHistItem -> Seq REPLHistItem)
-> Seq REPLHistItem -> Seq REPLHistItem
forall a b. (a -> b) -> a -> b
$ REPLHistory
h REPLHistory
-> Getting (Seq REPLHistItem) REPLHistory (Seq REPLHistItem)
-> Seq REPLHistItem
forall s a. s -> Getting a s a -> a
^. Getting (Seq REPLHistItem) REPLHistory (Seq REPLHistItem)
Lens' REPLHistory (Seq REPLHistItem)
replSeq
  oldestIndex :: Int
oldestIndex = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (REPLHistory
h REPLHistory -> Getting Int REPLHistory Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int REPLHistory Int
Lens' REPLHistory Int
replStart) (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Seq REPLHistItem -> Int
forall a. Seq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (REPLHistory
h REPLHistory
-> Getting (Seq REPLHistItem) REPLHistory (Seq REPLHistItem)
-> Seq REPLHistItem
forall s a. s -> Getting a s a -> a
^. Getting (Seq REPLHistItem) REPLHistory (Seq REPLHistItem)
Lens' REPLHistory (Seq REPLHistItem)
replSeq) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n

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

data TimeDir = Newer | Older deriving (TimeDir -> TimeDir -> Bool
(TimeDir -> TimeDir -> Bool)
-> (TimeDir -> TimeDir -> Bool) -> Eq TimeDir
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TimeDir -> TimeDir -> Bool
== :: TimeDir -> TimeDir -> Bool
$c/= :: TimeDir -> TimeDir -> Bool
/= :: TimeDir -> TimeDir -> Bool
Eq, Eq TimeDir
Eq TimeDir =>
(TimeDir -> TimeDir -> Ordering)
-> (TimeDir -> TimeDir -> Bool)
-> (TimeDir -> TimeDir -> Bool)
-> (TimeDir -> TimeDir -> Bool)
-> (TimeDir -> TimeDir -> Bool)
-> (TimeDir -> TimeDir -> TimeDir)
-> (TimeDir -> TimeDir -> TimeDir)
-> Ord TimeDir
TimeDir -> TimeDir -> Bool
TimeDir -> TimeDir -> Ordering
TimeDir -> TimeDir -> TimeDir
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TimeDir -> TimeDir -> Ordering
compare :: TimeDir -> TimeDir -> Ordering
$c< :: TimeDir -> TimeDir -> Bool
< :: TimeDir -> TimeDir -> Bool
$c<= :: TimeDir -> TimeDir -> Bool
<= :: TimeDir -> TimeDir -> Bool
$c> :: TimeDir -> TimeDir -> Bool
> :: TimeDir -> TimeDir -> Bool
$c>= :: TimeDir -> TimeDir -> Bool
>= :: TimeDir -> TimeDir -> Bool
$cmax :: TimeDir -> TimeDir -> TimeDir
max :: TimeDir -> TimeDir -> TimeDir
$cmin :: TimeDir -> TimeDir -> TimeDir
min :: TimeDir -> TimeDir -> TimeDir
Ord, Int -> TimeDir -> ShowS
[TimeDir] -> ShowS
TimeDir -> String
(Int -> TimeDir -> ShowS)
-> (TimeDir -> String) -> ([TimeDir] -> ShowS) -> Show TimeDir
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TimeDir -> ShowS
showsPrec :: Int -> TimeDir -> ShowS
$cshow :: TimeDir -> String
show :: TimeDir -> String
$cshowList :: [TimeDir] -> ShowS
showList :: [TimeDir] -> ShowS
Show)

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

getCurrentItemText :: REPLHistory -> Maybe Text
getCurrentItemText :: REPLHistory -> Maybe Text
getCurrentItemText REPLHistory
history = REPLHistItem -> Text
replItemText (REPLHistItem -> Text) -> Maybe REPLHistItem -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Seq REPLHistItem -> Maybe REPLHistItem
forall a. Int -> Seq a -> Maybe a
Seq.lookup (REPLHistory
history REPLHistory -> Getting Int REPLHistory Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int REPLHistory Int
Lens' REPLHistory Int
replIndex) (REPLHistory
history REPLHistory
-> Getting (Seq REPLHistItem) REPLHistory (Seq REPLHistItem)
-> Seq REPLHistItem
forall s a. s -> Getting a s a -> a
^. Getting (Seq REPLHistItem) REPLHistory (Seq REPLHistItem)
Lens' REPLHistory (Seq REPLHistItem)
replSeq)

replIndexIsAtInput :: REPLHistory -> Bool
replIndexIsAtInput :: REPLHistory -> Bool
replIndexIsAtInput REPLHistory
repl = REPLHistory
repl REPLHistory -> Getting Int REPLHistory Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int REPLHistory Int
Lens' REPLHistory Int
replIndex Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== REPLHistory -> Int
replLength REPLHistory
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 :: Text -> REPLHistory -> REPLHistory
removeEntry Text
foundtext REPLHistory
hist = REPLHistory
hist REPLHistory -> (REPLHistory -> REPLHistory) -> REPLHistory
forall a b. a -> (a -> b) -> b
& (Seq REPLHistItem -> Identity (Seq REPLHistItem))
-> REPLHistory -> Identity REPLHistory
Lens' REPLHistory (Seq REPLHistItem)
replSeq ((Seq REPLHistItem -> Identity (Seq REPLHistItem))
 -> REPLHistory -> Identity REPLHistory)
-> (Seq REPLHistItem -> Seq REPLHistItem)
-> REPLHistory
-> REPLHistory
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (REPLHistItem -> Bool) -> Seq REPLHistItem -> Seq REPLHistItem
forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter ((Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text -> Maybe Text
forall a. a -> Maybe a
Just Text
foundtext) (Maybe Text -> Bool)
-> (REPLHistItem -> Maybe Text) -> REPLHistItem -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. REPLHistItem -> Maybe Text
getREPLEntry)

-- | Get the last 'REPLEntry' in 'REPLHistory' matching the given text
lastEntry :: Text -> REPLHistory -> Maybe Text
lastEntry :: Text -> REPLHistory -> Maybe Text
lastEntry Text
t REPLHistory
h =
  case Seq REPLHistItem -> ViewR REPLHistItem
forall a. Seq a -> ViewR a
Seq.viewr (Seq REPLHistItem -> ViewR REPLHistItem)
-> Seq REPLHistItem -> ViewR REPLHistItem
forall a b. (a -> b) -> a -> b
$ (REPLHistItem -> Bool) -> Seq REPLHistItem -> Seq REPLHistItem
forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter REPLHistItem -> Bool
matchEntry (Seq REPLHistItem -> Seq REPLHistItem)
-> Seq REPLHistItem -> Seq REPLHistItem
forall a b. (a -> b) -> a -> b
$ REPLHistory
h REPLHistory
-> Getting (Seq REPLHistItem) REPLHistory (Seq REPLHistItem)
-> Seq REPLHistItem
forall s a. s -> Getting a s a -> a
^. Getting (Seq REPLHistItem) REPLHistory (Seq REPLHistItem)
Lens' REPLHistory (Seq REPLHistItem)
replSeq of
    ViewR REPLHistItem
Seq.EmptyR -> Maybe Text
forall a. Maybe a
Nothing
    Seq REPLHistItem
_ Seq.:> REPLHistItem
a -> Text -> Maybe Text
forall a. a -> Maybe a
Just (REPLHistItem -> Text
replItemText REPLHistItem
a)
 where
  matchesText :: REPLHistItem -> Bool
matchesText REPLHistItem
histItem = Text
t Text -> Text -> Bool
`T.isInfixOf` REPLHistItem -> Text
replItemText REPLHistItem
histItem
  matchEntry :: REPLHistItem -> Bool
matchEntry = (Bool -> Bool -> Bool)
-> (REPLHistItem -> Bool)
-> (REPLHistItem -> Bool)
-> REPLHistItem
-> Bool
forall a b c.
(a -> b -> c)
-> (REPLHistItem -> a) -> (REPLHistItem -> b) -> REPLHistItem -> c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Bool -> Bool -> Bool
(&&) REPLHistItem -> Bool
matchesText REPLHistItem -> Bool
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 :: REPLPrompt
defaultPrompt = [Text] -> REPLPrompt
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 (ReplControlMode -> ReplControlMode -> Bool
(ReplControlMode -> ReplControlMode -> Bool)
-> (ReplControlMode -> ReplControlMode -> Bool)
-> Eq ReplControlMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ReplControlMode -> ReplControlMode -> Bool
== :: ReplControlMode -> ReplControlMode -> Bool
$c/= :: ReplControlMode -> ReplControlMode -> Bool
/= :: ReplControlMode -> ReplControlMode -> Bool
Eq, ReplControlMode
ReplControlMode -> ReplControlMode -> Bounded ReplControlMode
forall a. a -> a -> Bounded a
$cminBound :: ReplControlMode
minBound :: ReplControlMode
$cmaxBound :: ReplControlMode
maxBound :: ReplControlMode
Bounded, Int -> ReplControlMode
ReplControlMode -> Int
ReplControlMode -> [ReplControlMode]
ReplControlMode -> ReplControlMode
ReplControlMode -> ReplControlMode -> [ReplControlMode]
ReplControlMode
-> ReplControlMode -> ReplControlMode -> [ReplControlMode]
(ReplControlMode -> ReplControlMode)
-> (ReplControlMode -> ReplControlMode)
-> (Int -> ReplControlMode)
-> (ReplControlMode -> Int)
-> (ReplControlMode -> [ReplControlMode])
-> (ReplControlMode -> ReplControlMode -> [ReplControlMode])
-> (ReplControlMode -> ReplControlMode -> [ReplControlMode])
-> (ReplControlMode
    -> ReplControlMode -> ReplControlMode -> [ReplControlMode])
-> Enum ReplControlMode
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ReplControlMode -> ReplControlMode
succ :: ReplControlMode -> ReplControlMode
$cpred :: ReplControlMode -> ReplControlMode
pred :: ReplControlMode -> ReplControlMode
$ctoEnum :: Int -> ReplControlMode
toEnum :: Int -> ReplControlMode
$cfromEnum :: ReplControlMode -> Int
fromEnum :: ReplControlMode -> Int
$cenumFrom :: ReplControlMode -> [ReplControlMode]
enumFrom :: ReplControlMode -> [ReplControlMode]
$cenumFromThen :: ReplControlMode -> ReplControlMode -> [ReplControlMode]
enumFromThen :: ReplControlMode -> ReplControlMode -> [ReplControlMode]
$cenumFromTo :: ReplControlMode -> ReplControlMode -> [ReplControlMode]
enumFromTo :: ReplControlMode -> ReplControlMode -> [ReplControlMode]
$cenumFromThenTo :: ReplControlMode
-> ReplControlMode -> ReplControlMode -> [ReplControlMode]
enumFromThenTo :: ReplControlMode
-> ReplControlMode -> ReplControlMode -> [ReplControlMode]
Enum)

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

newREPLEditor :: Text -> Editor Text Name
newREPLEditor :: Text -> Editor Text Name
newREPLEditor Text
t = (TextZipper Text -> TextZipper Text)
-> Editor Text Name -> Editor Text Name
forall t n.
(TextZipper t -> TextZipper t) -> Editor t n -> Editor t n
applyEdit TextZipper Text -> TextZipper Text
gotoEnd (Editor Text Name -> Editor Text Name)
-> Editor Text Name -> Editor Text Name
forall a b. (a -> b) -> a -> b
$ Name -> Maybe Int -> Text -> Editor Text Name
forall n. n -> Maybe Int -> Text -> Editor Text n
editorText Name
REPLInput (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1) Text
t
 where
  ls :: [Text]
ls = Text -> [Text]
T.lines Text
t
  pos :: (Int, Int)
pos = ([Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
ls Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1, Text -> Int
T.length ([Text] -> Text
forall a. HasCallStack => [a] -> a
last [Text]
ls))
  gotoEnd :: TextZipper Text -> TextZipper Text
gotoEnd = if [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
ls then TextZipper Text -> TextZipper Text
forall a. a -> a
id else (Int, Int) -> TextZipper Text -> TextZipper Text
forall a. Monoid a => (Int, Int) -> TextZipper a -> TextZipper a
TZ.moveCursor (Int, Int)
pos

initREPLState :: REPLHistory -> REPLState
initREPLState :: REPLHistory -> REPLState
initREPLState REPLHistory
hist =
  REPLState
    { _replPromptType :: REPLPrompt
_replPromptType = REPLPrompt
defaultPrompt
    , _replPromptEditor :: Editor Text Name
_replPromptEditor = Text -> Editor Text Name
newREPLEditor Text
""
    , _replValid :: Either SrcLoc ()
_replValid = () -> Either SrcLoc ()
forall a b. b -> Either a b
Right ()
    , _replLast :: Text
_replLast = Text
""
    , _replType :: Maybe Polytype
_replType = Maybe Polytype
forall a. Maybe a
Nothing
    , _replControlMode :: ReplControlMode
_replControlMode = ReplControlMode
Typing
    , _replHistory :: REPLHistory
_replHistory = 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' REPLState Text
replPromptText = (REPLState -> Text)
-> (REPLState -> Text -> REPLState) -> Lens' REPLState Text
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens REPLState -> Text
g REPLState -> Text -> REPLState
s
 where
  g :: REPLState -> Text
g REPLState
r = REPLState
r REPLState -> Getting Text REPLState Text -> Text
forall s a. s -> Getting a s a -> a
^. (Editor Text Name -> Const Text (Editor Text Name))
-> REPLState -> Const Text REPLState
Lens' REPLState (Editor Text Name)
replPromptEditor ((Editor Text Name -> Const Text (Editor Text Name))
 -> REPLState -> Const Text REPLState)
-> ((Text -> Const Text Text)
    -> Editor Text Name -> Const Text (Editor Text Name))
-> Getting Text REPLState Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Editor Text Name -> [Text])
-> ([Text] -> Const Text [Text])
-> Editor Text Name
-> Const Text (Editor Text Name)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Editor Text Name -> [Text]
forall t n. Monoid t => Editor t n -> [t]
getEditContents (([Text] -> Const Text [Text])
 -> Editor Text Name -> Const Text (Editor Text Name))
-> ((Text -> Const Text Text) -> [Text] -> Const Text [Text])
-> (Text -> Const Text Text)
-> Editor Text Name
-> Const Text (Editor Text Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Text] -> Text)
-> (Text -> Const Text Text) -> [Text] -> Const Text [Text]
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to [Text] -> Text
T.concat
  s :: REPLState -> Text -> REPLState
s REPLState
r Text
t = REPLState
r REPLState -> (REPLState -> REPLState) -> REPLState
forall a b. a -> (a -> b) -> b
& (Editor Text Name -> Identity (Editor Text Name))
-> REPLState -> Identity REPLState
Lens' REPLState (Editor Text Name)
replPromptEditor ((Editor Text Name -> Identity (Editor Text Name))
 -> REPLState -> Identity REPLState)
-> Editor Text Name -> REPLState -> REPLState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text -> Editor Text Name
newREPLEditor Text
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