{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ViewPatterns #-}
module Swarm.TUI.Model.Repl (
REPLHistItem (..),
replItemText,
isREPLEntry,
getREPLEntry,
REPLHistory,
replIndex,
replLength,
replSeq,
newREPLHistory,
addREPLItem,
restartREPLHistory,
getLatestREPLHistoryItems,
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.Applicative (Applicative (liftA2))
import Control.Lens hiding (from, (<.>))
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 Swarm.Language.Types
import Swarm.TUI.Model.Name
data REPLHistItem
=
REPLEntry Text
|
REPLOutput 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)
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
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
replItemText :: REPLHistItem -> Text
replItemText :: REPLHistItem -> Text
replItemText = \case
REPLEntry Text
t -> Text
t
REPLOutput Text
t -> Text
t
data REPLHistory = REPLHistory
{ REPLHistory -> Seq REPLHistItem
_replSeq :: Seq REPLHistItem
, REPLHistory -> Int
_replIndex :: Int
, REPLHistory -> Int
_replStart :: Int
}
makeLensesWith (lensRules & generateSignatures .~ False) ''REPLHistory
replSeq :: Lens' REPLHistory (Seq REPLHistItem)
replIndex :: Lens' REPLHistory Int
replStart :: Lens' REPLHistory Int
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
}
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
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
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
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
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
(Seq REPLHistItem
olderP, Seq REPLHistItem
newer) = forall a. Int -> Seq a -> (Seq a, Seq a)
Seq.splitAt Int
curIndex Seq REPLHistItem
entries
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
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)
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
data REPLPrompt
=
CmdPrompt [Text]
|
SearchPrompt REPLHistory
defaultPrompt :: REPLPrompt
defaultPrompt :: REPLPrompt
defaultPrompt = [Text] -> REPLPrompt
CmdPrompt []
data ReplControlMode
= Piloting
| Typing
deriving (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, ReplControlMode
forall a. a -> a -> Bounded a
maxBound :: ReplControlMode
$cmaxBound :: ReplControlMode
minBound :: ReplControlMode
$cminBound :: ReplControlMode
Bounded, 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)
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 = REPLPrompt
-> Editor Text Name
-> Bool
-> Text
-> Maybe Polytype
-> ReplControlMode
-> REPLHistory
-> REPLState
REPLState REPLPrompt
defaultPrompt (Text -> Editor Text Name
newREPLEditor Text
"") Bool
True Text
"" forall a. Maybe a
Nothing ReplControlMode
Typing
makeLensesWith (lensRules & generateSignatures .~ False) ''REPLState
replPromptType :: Lens' REPLState REPLPrompt
replPromptEditor :: Lens' REPLState (Editor Text Name)
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
replValid :: Lens' REPLState Bool
replType :: Lens' REPLState (Maybe Polytype)
replLast :: Lens' REPLState Text
replControlMode :: Lens' REPLState ReplControlMode
replHistory :: Lens' REPLState REPLHistory