Wrap REPL history

- use Seq as inner storage
- skip same entries using predicate
- store index of first input that is not saved

Author: xsebek

src/Swarm/TUI/Controller.hs

@@ -31,6 +31,7 @@ module Swarm.TUI.Controller (
   handleREPLEvent,
   validateREPLForm,
   adjReplHistIndex,
+  TimeDir(..),
 
   -- ** World panel
   handleWorldEvent,
@@ -65,6 +66,8 @@ import qualified Graphics.Vty as V
 
 import qualified Control.Carrier.Lift as Fused
 import qualified Control.Carrier.State.Lazy as Fused
+import Data.Foldable (toList)
+import qualified Data.Sequence as Seq
 import Swarm.Game.CESK (cancel, emptyStore, initMachine)
 import Swarm.Game.Entity hiding (empty)
 import Swarm.Game.Robot
@@ -151,15 +154,12 @@ toggleModal s modal = do
 --   the updated REPL history to a @.swarm_history@ file.
 shutdown :: AppState -> EventM Name (Next AppState)
 shutdown s = do
-  let hist = mapMaybe getNewEntry (s ^. uiState . uiReplHistory)
+  let hist = mapMaybe getREPLEntry . toList . snd . Seq.splitAt (history ^. replStart) $ history ^. replSeq
   liftIO $ (`T.appendFile` T.unlines hist) =<< getSwarmHistoryPath True
-  let s' = s & uiState . uiReplHistory . traverse %~ markOld
+  let s' = s & uiState . uiReplHistory . replStart .~ replLength history
   halt s'
  where
-  markOld (REPLEntry _ d e) = REPLEntry False d e
-  markOld r = r
-  getNewEntry (REPLEntry True _ t) = Just t
-  getNewEntry _ = Nothing
+  history = s ^. uiState . uiReplHistory
 
 ------------------------------------------------------------
 -- Handling Frame events
@@ -320,7 +320,7 @@ updateUI = do
     -- result as a REPL output, with its type, and reset the replStatus.
     REPLWorking pty (Just v) -> do
       let out = T.intercalate " " [into (prettyValue v), ":", prettyText (stripCmd pty)]
-      uiState . uiReplHistory %= (REPLOutput out :)
+      uiState . uiReplHistory %= addREPLOutput out
       gameState . replStatus .= REPLDone
       pure True
 
@@ -403,8 +403,7 @@ handleREPLEvent s (VtyEvent (V.EvKey V.KEnter [])) =
           s
             & uiState . uiReplForm %~ updateFormState ""
             & uiState . uiReplType .~ Nothing
-            & uiState . uiReplHistory %~ prependReplEntry
-            & uiState . uiReplHistIdx .~ (-1)
+            & uiState . uiReplHistory %~ addREPLEntry entry
             & uiState . uiError .~ Nothing
             & gameState . replStatus .~ REPLWorking ty Nothing
             & gameState . robotMap . ix "base" . machine .~ initMachine t topValCtx topStore
@@ -422,13 +421,10 @@ handleREPLEvent s (VtyEvent (V.EvKey V.KEnter [])) =
   topStore =
     fromMaybe emptyStore $
       s ^? gameState . robotMap . at "base" . _Just . robotContext . defStore
-  prependReplEntry replHistory
-    | firstReplEntry replHistory == Just entry = REPLEntry True True entry : replHistory
-    | otherwise = REPLEntry True False entry : replHistory
 handleREPLEvent s (VtyEvent (V.EvKey V.KUp [])) =
-  continue $ s & adjReplHistIndex (+)
+  continue $ s & adjReplHistIndex Older
 handleREPLEvent s (VtyEvent (V.EvKey V.KDown [])) =
-  continue $ s & adjReplHistIndex (-)
+  continue $ s & adjReplHistIndex Newer
 handleREPLEvent s ev = do
   f' <- handleFormEvent ev (s ^. uiState . uiReplForm)
   continue $ validateREPLForm (s & uiState . uiReplForm .~ f')
@@ -449,22 +445,37 @@ validateREPLForm s =
     _ -> Nothing
   validate = setFieldValid (isRight result) REPLInput
 
+data TimeDir = Newer | Older deriving (Eq, Ord, Show)
+
 -- | Update our current position in the REPL history.
-adjReplHistIndex :: (Int -> Int -> Int) -> AppState -> AppState
-adjReplHistIndex (+/-) s =
-  s & uiState . uiReplHistIdx .~ newIndex
-    & (if curIndex == -1 then saveLastEntry else id)
+adjReplHistIndex :: TimeDir -> AppState -> AppState
+adjReplHistIndex d s =
+  s & uiState . uiReplHistory . replIndex .~ newIndex
+    & (if curIndex == historyLen then saveLastEntry else id)
     & (if newIndex /= curIndex then uiState . uiReplForm %~ updateFormState newEntry else id)
     & validateREPLForm
  where
+  -- get REPL data
   saveLastEntry = uiState . uiReplLast .~ formState (s ^. uiState . uiReplForm)
-  entries = [e | REPLEntry _ False e <- s ^. uiState . uiReplHistory]
-  curIndex = s ^. uiState . uiReplHistIdx
-  histLen = length entries
-  newIndex = min (histLen - 1) (max (-1) (curIndex +/- 1))
+  replLast = s ^. uiState . uiReplLast
+  history = s ^. uiState . uiReplHistory
+  historyLen = replLength history
+  curText = maybe replLast replItemText $ Seq.lookup curIndex entries
+  curIndex = history ^. replIndex
+  entries = history ^. replSeq
+  -- split repl at index
+  (olderP, newer) = Seq.splitAt curIndex entries
+  -- find first different entry in direction
+  notSameEntry = \case
+    REPLEntry t -> t /= curText
+    _ -> False
+  newIndex = case d of
+    Newer -> maybe historyLen (curIndex+) $ Seq.findIndexL notSameEntry newer
+    Older -> fromMaybe curIndex $ Seq.findIndexR notSameEntry olderP
+  oops = "Oops, failed to index in REPL history, please report this bug."
   newEntry
-    | newIndex == -1 = s ^. uiState . uiReplLast
-    | otherwise = entries !! newIndex
+    | newIndex == historyLen = replLast
+    | otherwise = maybe oops replItemText $ entries Seq.!? newIndex
 
 ------------------------------------------------------------
 -- World events

src/Swarm/TUI/Model.hs

@@ -20,20 +20,33 @@ module Swarm.TUI.Model (
   Modal (..),
 
   -- * UI state
+
+  -- ** REPL
   REPLHistItem (..),
   firstReplEntry,
+  replItemText,
+  isREPLEntry,
+  getREPLEntry,
+  REPLHistory,
+  replSeq,
+  replStart,
+  replIndex,
+  addREPLEntry,
+  addREPLOutput,
+  replLength,
+
+  -- ** Inventory
   InventoryListEntry (..),
   _Separator,
   _InventoryEntry,
   _InstalledEntry,
-  UIState,
 
-  -- ** Fields
+  -- ** UI Model
+  UIState,
   uiFocusRing,
   uiReplForm,
   uiReplType,
   uiReplHistory,
-  uiReplHistIdx,
   uiReplLast,
   uiInventory,
   uiMoreInfoTop,
@@ -79,7 +92,7 @@ import Control.Lens
 import Control.Monad.Except
 import Control.Monad.State
 import Data.List (findIndex, sortOn)
-import Data.Maybe (fromMaybe)
+import Data.Maybe (fromMaybe, isJust)
 import Data.Text (Text)
 import qualified Data.Text as T
 import qualified Data.Vector as V
@@ -91,6 +104,8 @@ import Brick.Forms
 import qualified Brick.Widgets.List as BL
 
 import Data.Bits (FiniteBits (finiteBitSize))
+import Data.Sequence (Seq)
+import qualified Data.Sequence as Seq
 import Swarm.Game.Entity as E
 import Swarm.Game.Robot
 import Swarm.Game.State
@@ -148,29 +163,74 @@ data Modal
 
 -- | An item in the REPL history.
 data REPLHistItem
-  = -- | Something entered by the user.  The first
-    --   @Bool@ indicates whether it is
-    --   something entered this session (it
-    --   will be @False@ for entries that were
-    --   loaded from the history file). This is
-    --   so we know which ones to append to the
-    --   history file on shutdown.
-    --   The second @Bool@ indicates whether it
-    --   is a duplicate of the preceding item (it
-    --   will be @True@ for duplicate entries).
-    --   This is so we can ignore it when scrolling
-    --   through the REPL history in the REPL window.
-    REPLEntry Bool Bool Text
+  = -- | Something entered by the user.
+    REPLEntry Text
   | -- | A response printed by the system.
     REPLOutput Text
   deriving (Eq, Ord, Show, Read)
 
+getREPLEntry :: REPLHistItem -> Maybe Text
+getREPLEntry = \case
+  REPLEntry t -> Just t
+  _ -> Nothing
+
+isREPLEntry :: REPLHistItem -> Bool
+isREPLEntry = isJust . getREPLEntry
+
+replItemText :: REPLHistItem -> Text
+replItemText = \case
+  REPLEntry t -> t
+  REPLOutput t -> 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
+  { _replSeq :: Seq REPLHistItem
+  , _replIndex :: Int
+  , _replStart :: Int
+  }
+
+makeLensesWith (lensRules & generateSignatures .~ False) ''REPLHistory
+
+-- | Sequence of REPL inputs and outputs, oldest entry is leftmost.
+--
+-- TODO: The ideal would be not to expose inner storage, but currently
+-- namely the index+predicate functions on Seq are hard to resist.
+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.
+replStart :: Lens' REPLHistory Int
+
+-- | Current (vertical) length of the REPL - used as index of input buffer.
+replLength :: REPLHistory -> Int
+replLength = length . _replSeq
+
+-- | Add new REPL input - the index must have been pointing one past
+--   the last element already, so we increment it to keep it that way.
+addREPLItem :: (Text -> REPLHistItem) -> Text -> REPLHistory -> REPLHistory
+addREPLItem rc t h = h
+  & replSeq %~ (|> rc t)
+  & replIndex .~ replLength h
+
+-- | Add new REPL input and increment index to last.
+addREPLEntry :: Text -> REPLHistory -> REPLHistory
+addREPLEntry = addREPLItem REPLEntry
+
+
+-- | Add new REPL output and increment index to last.
+addREPLOutput :: Text -> REPLHistory -> REPLHistory
+addREPLOutput = addREPLItem REPLOutput
+
 -- | Given a REPL history return @Just@ the most recent @Text@
 --   entered by the user or @Nothing@ if there is none.
-firstReplEntry :: [REPLHistItem] -> Maybe Text
-firstReplEntry ((REPLEntry _ _ entry) : _) = Just entry
-firstReplEntry (_ : rest) = firstReplEntry rest
-firstReplEntry [] = Nothing
+firstReplEntry :: REPLHistory -> Maybe Text
+firstReplEntry = foldr (const . getREPLEntry) Nothing . _replSeq
 
 -- | An entry in the inventory list displayed in the info panel.  We
 --   can either have an entity with a count in the robot's inventory,
@@ -192,8 +252,7 @@ data UIState = UIState
   , _uiReplForm :: Form Text AppEvent Name
   , _uiReplType :: Maybe Polytype
   , _uiReplLast :: Text
-  , _uiReplHistory :: [REPLHistItem]
-  , _uiReplHistIdx :: Int
+  , _uiReplHistory :: REPLHistory
   , _uiInventory :: Maybe (Int, BL.List Name InventoryListEntry)
   , _uiMoreInfoTop :: Bool
   , _uiMoreInfoBot :: Bool
@@ -238,11 +297,7 @@ uiReplLast :: Lens' UIState Text
 
 -- | History of things the user has typed at the REPL, interleaved
 --   with outputs the system has generated.
-uiReplHistory :: Lens' UIState [REPLHistItem]
-
--- | The current index in the REPL history (if the user is going back
---   through the history using up/down keys).
-uiReplHistIdx :: Lens' UIState Int
+uiReplHistory :: Lens' UIState REPLHistory
 
 -- | The hash value of the focused robot entity (so we can tell if its
 --   inventory changed) along with a list of the items in the
@@ -335,27 +390,26 @@ initReplForm =
 initLgTicksPerSecond :: Int
 initLgTicksPerSecond = 3 -- 2^3 = 8 ticks / second
 
-createHistory :: [Text] -> [REPLHistItem]
-createHistory = map (uncurry $ REPLEntry False) . zipLines . reverse
- where
-  zipLines ls = zipWith samePair ls $ tail ls ++ [""]
-  samePair n o = (n == o, n)
-
 -- | Initialize the UI state.  This needs to be in the IO monad since
 --   it involves reading a REPL history file and getting the current
 --   time.
 initUIState :: ExceptT Text IO UIState
 initUIState = liftIO $ do
   historyT <- readFileMayT =<< getSwarmHistoryPath False
-  let history = maybe [] (createHistory . T.lines) historyT
+  let history = maybe Seq.empty (Seq.fromList . map REPLEntry . T.lines) historyT
+      historyLen = length history
   startTime <- getTime Monotonic
   return $
     UIState
       { _uiFocusRing = initFocusRing
       , _uiReplForm = initReplForm
       , _uiReplType = Nothing
-      , _uiReplHistory = history
-      , _uiReplHistIdx = -1
+      , _uiReplHistory =
+          REPLHistory
+            { _replSeq = history
+            , _replIndex = historyLen -- one past rightmost=newest
+            , _replStart = historyLen
+            }
       , _uiReplLast = ""
       , _uiInventory = Nothing
       , _uiMoreInfoTop = False

src/Swarm/TUI/View.hs

@@ -51,6 +51,7 @@ import Data.Text (Text)
 import qualified Data.Text as T
 import Linear
 import Text.Printf
+import qualified Data.Sequence as Seq
 import Text.Wrap
 
 import Brick hiding (Direction)
@@ -77,6 +78,7 @@ import Swarm.TUI.Border
 import Swarm.TUI.Model
 import Swarm.TUI.Panel
 import Swarm.Util
+import Data.Foldable (toList)
 
 -- | The main entry point for drawing the entire UI.  Generates a list
 --   of widgets, where each represents a layer.  Right now we just
@@ -555,13 +557,12 @@ drawRobotLog s =
 drawREPL :: AppState -> Widget Name
 drawREPL s =
   vBox $
-    map fmt (reverse (take (replHeight - 1) . filter newEntry $ (s ^. uiState . uiReplHistory)))
+    map fmt (take (replHeight - 1) . toList . ignoreLoaded $ history ^. replSeq)
       ++ case isActive <$> (s ^. gameState . robotMap . at "base") of
         Just False -> [renderForm (s ^. uiState . uiReplForm)]
         _ -> [padRight Max $ txt "..."]
  where
-  newEntry (REPLEntry False _ _) = False
-  newEntry _ = True
-
-  fmt (REPLEntry _ _ e) = txt replPrompt <+> txt e
+  history = s ^. uiState . uiReplHistory
+  ignoreLoaded = snd . Seq.splitAt (history ^. replStart)
+  fmt (REPLEntry e) = txt replPrompt <+> txt e
   fmt (REPLOutput t) = txt t