{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ViewPatterns #-}
module Swarm.TUI.Model.Repl (
REPLEntryType (..),
REPLHistItemType (..),
REPLHistItem (..),
isREPLEntry,
getREPLSubmitted,
isREPLSaved,
getREPLEntry,
REPLHistory,
replIndex,
replLength,
replHasExecutedManualInput,
replSeq,
newREPLHistory,
addREPLItem,
restartREPLHistory,
getLatestREPLHistoryItems,
getSessionREPLHistoryItems,
moveReplHistIndex,
getCurrentItemText,
replIndexIsAtInput,
TimeDir (..),
REPLPrompt (..),
removeEntry,
REPLState,
ReplControlMode (..),
replPromptType,
replPromptEditor,
replPromptText,
replValid,
replLast,
replType,
replControlMode,
replHistory,
newREPLEditor,
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)
data REPLEntryType
=
Submitted
|
Stashed
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)
data REPLHistItemType
=
REPLEntry REPLEntryType
|
REPLOutput
|
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)
data REPLHistItem = REPLHistItem
{ REPLHistItem -> REPLHistItemType
replItemType :: REPLHistItemType
, REPLHistItem -> TickNumber
replItemTick :: TickNumber
, 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)
instance ToSample REPLHistItem where
toSamples :: Proxy REPLHistItem -> [(Text, REPLHistItem)]
toSamples Proxy REPLHistItem
_ =
[REPLHistItem] -> [(Text, REPLHistItem)]
forall a. [a] -> [(Text, a)]
SD.samples
[ REPLHistItemType -> TickNumber -> Text -> REPLHistItem
REPLHistItem
(REPLEntryType -> REPLHistItemType
REPLEntry REPLEntryType
Submitted)
(Int64 -> TickNumber
TickNumber Int64
0)
Text
"grab"
, REPLHistItemType -> TickNumber -> Text -> REPLHistItem
REPLHistItem
REPLHistItemType
REPLOutput
(Int64 -> TickNumber
TickNumber Int64
0)
Text
"it0 : text = \"tree\""
, REPLHistItemType -> TickNumber -> Text -> REPLHistItem
REPLHistItem
(REPLEntryType -> REPLHistItemType
REPLEntry REPLEntryType
Stashed)
(Int64 -> TickNumber
TickNumber Int64
1)
Text
"place"
, REPLHistItemType -> TickNumber -> Text -> REPLHistItem
REPLHistItem
(REPLEntryType -> REPLHistItemType
REPLEntry REPLEntryType
Submitted)
(Int64 -> TickNumber
TickNumber Int64
2)
Text
"place tree"
, REPLHistItemType -> TickNumber -> Text -> REPLHistItem
REPLHistItem
REPLHistItemType
REPLError
(Int64 -> TickNumber
TickNumber Int64
2)
Text
"1:7: Unbound variable tree"
]
instance ToJSON REPLHistItem where
toJSON :: REPLHistItem -> Value
toJSON (REPLHistItem REPLHistItemType
itemType TickNumber
tick Text
x) = [Pair] -> Value
object [Key
"tick" Key -> TickNumber -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= TickNumber
tick, 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
Submitted -> Key
"in"
REPLEntry REPLEntryType
Stashed -> Key
"save"
REPLHistItemType
REPLOutput -> Key
"out"
REPLHistItemType
REPLError -> Key
"err"
getREPLEntry :: REPLHistItem -> Maybe Text
getREPLEntry :: REPLHistItem -> Maybe Text
getREPLEntry = \case
REPLHistItem (REPLEntry {}) TickNumber
_ Text
t -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t
REPLHistItem
_ -> Maybe Text
forall a. Maybe a
Nothing
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
getREPLSubmitted :: REPLHistItem -> Maybe Text
getREPLSubmitted :: REPLHistItem -> Maybe Text
getREPLSubmitted = \case
REPLHistItem (REPLEntry REPLEntryType
Submitted) TickNumber
_ Text
t -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t
REPLHistItem
_ -> Maybe Text
forall a. Maybe a
Nothing
isREPLSaved :: REPLHistItem -> Bool
isREPLSaved :: REPLHistItem -> Bool
isREPLSaved (REPLHistItem (REPLEntry REPLEntryType
Stashed) TickNumber
_ Text
_) = Bool
True
isREPLSaved REPLHistItem
_ = Bool
False
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
replSeq :: Lens' REPLHistory (Seq REPLHistItem)
replIndex :: Lens' REPLHistory Int
replStart :: Lens' REPLHistory Int
replHasExecutedManualInput :: Lens' REPLHistory Bool
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
}
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
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
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
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
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
(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
notSameEntry :: REPLHistItem -> Bool
notSameEntry = \case
REPLHistItem (REPLEntry {}) TickNumber
_tick 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
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)
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
data REPLPrompt
=
CmdPrompt [Text]
|
SearchPrompt REPLHistory
defaultPrompt :: REPLPrompt
defaultPrompt :: REPLPrompt
defaultPrompt = [Text] -> REPLPrompt
CmdPrompt []
data ReplControlMode
=
Typing
|
Piloting
|
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 = Bool
-> (TextZipper Text -> TextZipper Text)
-> TextZipper Text
-> TextZipper Text
forall a. Bool -> (a -> a) -> a -> a
applyWhen (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
ls) ((TextZipper Text -> TextZipper Text)
-> TextZipper Text -> TextZipper Text)
-> (TextZipper Text -> TextZipper Text)
-> TextZipper Text
-> TextZipper Text
forall a b. (a -> b) -> a -> b
$ (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
replPromptType :: Lens' REPLState REPLPrompt
replPromptEditor :: Lens' REPLState (Editor Text Name)
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
replValid :: Lens' REPLState (Either SrcLoc ())
replType :: Lens' REPLState (Maybe Polytype)
replLast :: Lens' REPLState Text
replControlMode :: Lens' REPLState ReplControlMode
replHistory :: Lens' REPLState REPLHistory