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

-- |
-- SPDX-License-Identifier: BSD-3-Clause
module Swarm.TUI.Model.Repl (
  -- ** REPL
  REPLHistItem (..),
  replItemText,
  isREPLEntry,
  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.Types
import Swarm.TUI.Model.Name
import Swarm.Util.Lens (makeLensesNoSigs)
import Prelude hiding (Applicative (..))

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

-- | An item in the REPL history.
data REPLHistItem
  = -- | Something entered by the user.
    REPLEntry Text
  | -- | A response printed by the system.
    REPLOutput Text
  | -- | An error printed by the system.
    REPLError Text
  deriving (REPLHistItem -> REPLHistItem -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: REPLHistItem -> REPLHistItem -> Bool
$c/= :: REPLHistItem -> REPLHistItem -> Bool
== :: REPLHistItem -> REPLHistItem -> Bool
$c== :: REPLHistItem -> REPLHistItem -> Bool
Eq, Eq 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
min :: REPLHistItem -> REPLHistItem -> REPLHistItem
$cmin :: REPLHistItem -> REPLHistItem -> REPLHistItem
max :: REPLHistItem -> REPLHistItem -> REPLHistItem
$cmax :: REPLHistItem -> REPLHistItem -> REPLHistItem
>= :: REPLHistItem -> REPLHistItem -> Bool
$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
compare :: REPLHistItem -> REPLHistItem -> Ordering
$ccompare :: REPLHistItem -> REPLHistItem -> Ordering
Ord, Int -> REPLHistItem -> ShowS
[REPLHistItem] -> ShowS
REPLHistItem -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [REPLHistItem] -> ShowS
$cshowList :: [REPLHistItem] -> ShowS
show :: REPLHistItem -> String
$cshow :: REPLHistItem -> String
showsPrec :: Int -> REPLHistItem -> ShowS
$cshowsPrec :: Int -> REPLHistItem -> ShowS
Show, ReadPrec [REPLHistItem]
ReadPrec REPLHistItem
Int -> ReadS REPLHistItem
ReadS [REPLHistItem]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [REPLHistItem]
$creadListPrec :: ReadPrec [REPLHistItem]
readPrec :: ReadPrec REPLHistItem
$creadPrec :: ReadPrec REPLHistItem
readList :: ReadS [REPLHistItem]
$creadList :: ReadS [REPLHistItem]
readsPrec :: Int -> ReadS REPLHistItem
$creadsPrec :: Int -> ReadS REPLHistItem
Read)

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

instance ToJSON REPLHistItem where
  toJSON :: REPLHistItem -> Value
toJSON REPLHistItem
e = case REPLHistItem
e of
    REPLEntry Text
x -> [Pair] -> Value
object [Key
"in" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
x]
    REPLOutput Text
x -> [Pair] -> Value
object [Key
"out" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
x]
    REPLError Text
x -> [Pair] -> Value
object [Key
"err" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
x]

-- | Useful helper function to only get user input text.
getREPLEntry :: REPLHistItem -> Maybe Text
getREPLEntry :: REPLHistItem -> Maybe Text
getREPLEntry = \case
  REPLEntry Text
t -> forall a. a -> Maybe a
Just Text
t
  REPLHistItem
_ -> forall a. Maybe a
Nothing

-- | Useful helper function to filter out REPL output.
isREPLEntry :: REPLHistItem -> Bool
isREPLEntry :: REPLHistItem -> Bool
isREPLEntry = forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. REPLHistItem -> Maybe Text
getREPLEntry

-- | Get the text of REPL input/output.
replItemText :: REPLHistItem -> Text
replItemText :: REPLHistItem -> Text
replItemText = \case
  REPLEntry Text
t -> Text
t
  REPLOutput Text
t -> Text
t
  REPLError Text
t -> Text
t

-- | 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [REPLHistory] -> ShowS
$cshowList :: [REPLHistory] -> ShowS
show :: REPLHistory -> String
$cshow :: REPLHistory -> String
showsPrec :: Int -> REPLHistory -> ShowS
$cshowsPrec :: Int -> 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 = forall a. [a] -> Seq a
Seq.fromList [REPLHistItem]
xs
   in REPLHistory
        { _replSeq :: Seq REPLHistItem
_replSeq = Seq REPLHistItem
s
        , _replStart :: Int
_replStart = forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq REPLHistItem
s
        , _replIndex :: Int
_replIndex = 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 forall a b. a -> (a -> b) -> b
& Lens' REPLHistory Int
replStart 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 = forall (t :: * -> *) a. Foldable t => t a -> Int
length 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
    forall a b. a -> (a -> b) -> b
& Lens' REPLHistory (Seq REPLHistItem)
replSeq forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall s a. Snoc s s a a => s -> a -> s
|> REPLHistItem
t)
    forall a b. a -> (a -> b) -> b
& Lens' REPLHistory Int
replIndex forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int
1 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 = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq REPLHistItem
latestN
 where
  latestN :: Seq REPLHistItem
latestN = forall a. Int -> Seq a -> Seq a
Seq.drop Int
oldestIndex forall a b. (a -> b) -> a -> b
$ REPLHistory
h forall s a. s -> Getting a s a -> a
^. Lens' REPLHistory (Seq REPLHistItem)
replSeq
  oldestIndex :: Int
oldestIndex = forall a. Ord a => a -> a -> a
max (REPLHistory
h forall s a. s -> Getting a s a -> a
^. Lens' REPLHistory Int
replStart) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length (REPLHistory
h forall s a. s -> Getting a s a -> a
^. Lens' REPLHistory (Seq REPLHistItem)
replSeq) 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 = forall a. Int -> Seq a -> Seq a
Seq.drop (REPLHistory
h forall s a. s -> Getting a s a -> a
^. Lens' REPLHistory Int
replStart) (REPLHistory
h forall s a. s -> Getting a s a -> a
^. Lens' REPLHistory (Seq REPLHistItem)
replSeq)

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

moveReplHistIndex :: TimeDir -> Text -> REPLHistory -> REPLHistory
moveReplHistIndex :: TimeDir -> Text -> REPLHistory -> REPLHistory
moveReplHistIndex TimeDir
d Text
lastEntered REPLHistory
history = REPLHistory
history forall a b. a -> (a -> b) -> b
& Lens' REPLHistory Int
replIndex 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 = forall a. a -> Maybe a -> a
fromMaybe Text
lastEntered forall a b. (a -> b) -> a -> b
$ REPLHistory -> Maybe Text
getCurrentItemText REPLHistory
history
  curIndex :: Int
curIndex = REPLHistory
history forall s a. s -> Getting a s a -> a
^. Lens' REPLHistory Int
replIndex
  entries :: Seq REPLHistItem
entries = REPLHistory
history forall s a. s -> Getting a s a -> a
^. Lens' REPLHistory (Seq REPLHistItem)
replSeq
  -- split repl at index
  (Seq REPLHistItem
olderP, Seq REPLHistItem
newer) = 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
    REPLEntry Text
t -> Text
t forall a. Eq a => a -> a -> Bool
/= Text
curText
    REPLHistItem
_ -> Bool
False
  newIndex :: Int
newIndex = case TimeDir
d of
    TimeDir
Newer -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
historyLen (Int
curIndex forall a. Num a => a -> a -> a
+) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> Seq a -> Maybe Int
Seq.findIndexL REPLHistItem -> Bool
notSameEntry Seq REPLHistItem
newer
    TimeDir
Older -> forall a. a -> Maybe a -> a
fromMaybe Int
curIndex forall a b. (a -> b) -> a -> b
$ 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Int -> Seq a -> Maybe a
Seq.lookup (REPLHistory
history forall s a. s -> Getting a s a -> a
^. Lens' REPLHistory Int
replIndex) (REPLHistory
history forall s a. s -> Getting a s a -> a
^. Lens' REPLHistory (Seq REPLHistItem)
replSeq)

replIndexIsAtInput :: REPLHistory -> Bool
replIndexIsAtInput :: REPLHistory -> Bool
replIndexIsAtInput REPLHistory
repl = REPLHistory
repl forall s a. s -> Getting a s a -> a
^. Lens' REPLHistory Int
replIndex 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 in search mode and want 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 forall a b. a -> (a -> b) -> b
& Lens' REPLHistory (Seq REPLHistItem)
replSeq forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter (forall a. Eq a => a -> a -> Bool
/= Text -> REPLHistItem
REPLEntry Text
foundtext)

-- | 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 forall a. Seq a -> ViewR a
Seq.viewr forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter REPLHistItem -> Bool
matchEntry forall a b. (a -> b) -> a -> b
$ REPLHistory
h forall s a. s -> Getting a s a -> a
^. Lens' REPLHistory (Seq REPLHistItem)
replSeq of
    ViewR REPLHistItem
Seq.EmptyR -> forall a. Maybe a
Nothing
    Seq REPLHistItem
_ Seq.:> REPLHistItem
a -> 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 = 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReplControlMode -> ReplControlMode -> Bool
$c/= :: ReplControlMode -> ReplControlMode -> Bool
== :: ReplControlMode -> ReplControlMode -> Bool
$c== :: ReplControlMode -> ReplControlMode -> Bool
Eq, ReplControlMode
forall a. a -> a -> Bounded a
maxBound :: ReplControlMode
$cmaxBound :: ReplControlMode
minBound :: ReplControlMode
$cminBound :: ReplControlMode
Bounded, Int -> ReplControlMode
ReplControlMode -> Int
ReplControlMode -> [ReplControlMode]
ReplControlMode -> ReplControlMode
ReplControlMode -> ReplControlMode -> [ReplControlMode]
ReplControlMode
-> ReplControlMode -> ReplControlMode -> [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
enumFromThenTo :: ReplControlMode
-> ReplControlMode -> ReplControlMode -> [ReplControlMode]
$cenumFromThenTo :: ReplControlMode
-> ReplControlMode -> ReplControlMode -> [ReplControlMode]
enumFromTo :: ReplControlMode -> ReplControlMode -> [ReplControlMode]
$cenumFromTo :: ReplControlMode -> ReplControlMode -> [ReplControlMode]
enumFromThen :: ReplControlMode -> ReplControlMode -> [ReplControlMode]
$cenumFromThen :: ReplControlMode -> ReplControlMode -> [ReplControlMode]
enumFrom :: ReplControlMode -> [ReplControlMode]
$cenumFrom :: ReplControlMode -> [ReplControlMode]
fromEnum :: ReplControlMode -> Int
$cfromEnum :: ReplControlMode -> Int
toEnum :: Int -> ReplControlMode
$ctoEnum :: Int -> ReplControlMode
pred :: ReplControlMode -> ReplControlMode
$cpred :: ReplControlMode -> ReplControlMode
succ :: ReplControlMode -> ReplControlMode
$csucc :: ReplControlMode -> ReplControlMode
Enum)

data REPLState = REPLState
  { REPLState -> REPLPrompt
_replPromptType :: REPLPrompt
  , REPLState -> Editor Text Name
_replPromptEditor :: Editor Text Name
  , REPLState -> Bool
_replValid :: Bool
  , 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 = forall t n.
(TextZipper t -> TextZipper t) -> Editor t n -> Editor t n
applyEdit TextZipper Text -> TextZipper Text
gotoEnd forall a b. (a -> b) -> a -> b
$ forall n. n -> Maybe Int -> Text -> Editor Text n
editorText Name
REPLInput (forall a. a -> Maybe a
Just Int
1) Text
t
 where
  ls :: [Text]
ls = Text -> [Text]
T.lines Text
t
  pos :: (Int, Int)
pos = (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
ls forall a. Num a => a -> a -> a
- Int
1, Text -> Int
T.length (forall a. [a] -> a
last [Text]
ls))
  gotoEnd :: TextZipper Text -> TextZipper Text
gotoEnd = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
ls then forall a. a -> a
id else 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 :: Bool
_replValid = Bool
True
    , _replLast :: Text
_replLast = Text
""
    , _replType :: Maybe Polytype
_replType = 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 = 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 forall s a. s -> Getting a s a -> a
^. Lens' REPLState (Editor Text Name)
replPromptEditor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to forall t n. Monoid t => Editor t n -> [t]
getEditContents forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a b. a -> (a -> b) -> b
& Lens' REPLState (Editor Text Name)
replPromptEditor 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'.
replValid :: Lens' REPLState Bool

-- | 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