Store history in XDG data directory (#253)

- fixes #136 
- changes the history file format to simple text line per `REPLEntry`
- refactors out a `REPLHistory` type and its pure functions
  - adds tests for REPL logic (move to different previous entry,...)

Author: xsebek

src/Swarm/TUI/Controller.hs

@@ -31,6 +31,7 @@ module Swarm.TUI.Controller (
   handleREPLEvent,
   validateREPLForm,
   adjReplHistIndex,
+  TimeDir (..),
 
   -- ** World panel
   handleWorldEvent,
@@ -49,9 +50,10 @@ import Control.Monad.State
 import Data.Bits
 import Data.Either (isRight)
 import Data.Int (Int64)
-import Data.Maybe (fromMaybe, isJust)
+import Data.Maybe (fromMaybe, isJust, mapMaybe)
 import qualified Data.Set as S
 import qualified Data.Text as T
+import qualified Data.Text.IO as T
 import Linear
 import System.Clock
 import Witch (into)
@@ -150,16 +152,12 @@ toggleModal s modal = do
 --   the updated REPL history to a @.swarm_history@ file.
 shutdown :: AppState -> EventM Name (Next AppState)
 shutdown s = do
-  let s' = s & uiState . uiReplHistory . traverse %~ markOld
-      hist = filter isEntry (s' ^. uiState . uiReplHistory)
-  liftIO $ writeFile ".swarm_history" (show hist)
+  let hist = mapMaybe getREPLEntry $ getLatestREPLHistoryItems maxBound history
+  liftIO $ (`T.appendFile` T.unlines hist) =<< getSwarmHistoryPath True
+  let s' = s & uiState . uiReplHistory %~ restartREPLHistory
   halt s'
  where
-  markOld (REPLEntry _ d e) = REPLEntry False d e
-  markOld r = r
-
-  isEntry REPLEntry {} = True
-  isEntry _ = False
+  history = s ^. uiState . uiReplHistory
 
 ------------------------------------------------------------
 -- Handling Frame events
@@ -320,7 +318,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 %= addREPLItem (REPLOutput out)
       gameState . replStatus .= REPLDone
       pure True
 
@@ -403,8 +401,7 @@ handleREPLEvent s (VtyEvent (V.EvKey V.KEnter [])) =
           s
             & uiState . uiReplForm %~ updateFormState ""
             & uiState . uiReplType .~ Nothing
-            & uiState . uiReplHistory %~ prependReplEntry
-            & uiState . uiReplHistIdx .~ (-1)
+            & uiState . uiReplHistory %~ addREPLItem (REPLEntry entry)
             & uiState . uiError .~ Nothing
             & gameState . replStatus .~ REPLWorking ty Nothing
             & gameState . robotMap . ix "base" . machine .~ initMachine t topValCtx topStore
@@ -422,13 +419,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')
@@ -450,21 +444,26 @@ validateREPLForm s =
   validate = setFieldValid (isRight result) REPLInput
 
 -- | 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)
-    & (if newIndex /= curIndex then uiState . uiReplForm %~ updateFormState newEntry else id)
+adjReplHistIndex :: TimeDir -> AppState -> AppState
+adjReplHistIndex d s =
+  ns
+    & (if replIndexIsAtInput (s ^. repl) then saveLastEntry else id)
+    & (if oldEntry /= newEntry then showNewEntry else id)
     & validateREPLForm
  where
+  -- new AppState after moving the repl index
+  ns = s & repl %~ moveReplHistIndex d oldEntry
+
+  repl :: Lens' AppState REPLHistory
+  repl = uiState . uiReplHistory
+
+  replLast = s ^. uiState . uiReplLast
   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))
-  newEntry
-    | newIndex == -1 = s ^. uiState . uiReplLast
-    | otherwise = entries !! newIndex
+  showNewEntry = uiState . uiReplForm %~ updateFormState newEntry
+  -- get REPL data
+  getCurrEntry = fromMaybe replLast . getCurrentItemText . view repl
+  oldEntry = getCurrEntry s
+  newEntry = getCurrEntry ns
 
 ------------------------------------------------------------
 -- World events

src/Swarm/TUI/Model.hs

@@ -20,20 +20,36 @@ module Swarm.TUI.Model (
   Modal (..),
 
   -- * UI state
+
+  -- ** REPL
   REPLHistItem (..),
-  firstReplEntry,
+  replItemText,
+  isREPLEntry,
+  getREPLEntry,
+  REPLHistory,
+  replIndex,
+  replLength,
+  newREPLHistory,
+  addREPLItem,
+  restartREPLHistory,
+  getLatestREPLHistoryItems,
+  moveReplHistIndex,
+  getCurrentItemText,
+  replIndexIsAtInput,
+  TimeDir (..),
+
+  -- ** Inventory
   InventoryListEntry (..),
   _Separator,
   _InventoryEntry,
   _InstalledEntry,
-  UIState,
 
-  -- ** Fields
+  -- ** UI Model
+  UIState,
   uiFocusRing,
   uiReplForm,
   uiReplType,
   uiReplHistory,
-  uiReplHistIdx,
   uiReplLast,
   uiInventory,
   uiMoreInfoTop,
@@ -78,19 +94,22 @@ module Swarm.TUI.Model (
 import Control.Lens
 import Control.Monad.Except
 import Control.Monad.State
+import Data.Bits (FiniteBits (finiteBitSize))
+import Data.Foldable (toList)
 import Data.List (findIndex, sortOn)
-import Data.Maybe (fromMaybe)
+import Data.Maybe (fromMaybe, isJust)
+import Data.Sequence (Seq)
+import qualified Data.Sequence as Seq
 import Data.Text (Text)
+import qualified Data.Text as T
 import qualified Data.Vector as V
 import System.Clock
-import Text.Read (readMaybe)
 
 import Brick
 import Brick.Focus
 import Brick.Forms
 import qualified Brick.Widgets.List as BL
 
-import Data.Bits (FiniteBits (finiteBitSize))
 import Swarm.Game.Entity as E
 import Swarm.Game.Robot
 import Swarm.Game.State
@@ -138,39 +157,126 @@ data Name
 infoScroll :: ViewportScroll Name
 infoScroll = viewportScroll InfoViewport
 
-data Modal
-  = HelpModal
-  deriving (Eq, Show)
-
 ------------------------------------------------------------
--- UI state
+-- REPL History
 ------------------------------------------------------------
 
 -- | 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)
 
--- | 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
+-- | Useful helper function to only get user input text.
+getREPLEntry :: REPLHistItem -> Maybe Text
+getREPLEntry = \case
+  REPLEntry t -> Just t
+  _ -> Nothing
+
+-- | Useful helper function to filter out REPL output.
+isREPLEntry :: REPLHistItem -> Bool
+isREPLEntry = isJust . getREPLEntry
+
+-- | Get the text of REPL input/output.
+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.
+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
+
+-- | Create new REPL history (i.e. from loaded history file lines).
+newREPLHistory :: [REPLHistItem] -> REPLHistory
+newREPLHistory xs =
+  let s = Seq.fromList xs
+   in REPLHistory
+        { _replSeq = s
+        , _replStart = length s
+        , _replIndex = length s
+        }
+
+-- | Point the start of REPL history after current last line. See 'replStart'.
+restartREPLHistory :: REPLHistory -> REPLHistory
+restartREPLHistory h = h & replStart .~ replLength h
+
+-- | Current number lines of the REPL history - (ab)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 :: REPLHistItem -> REPLHistory -> REPLHistory
+addREPLItem t h =
+  h
+    & replSeq %~ (|> t)
+    & replIndex .~ 1 + replLength 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 n h = toList latestN
+ where
+  latestN = Seq.drop oldestIndex $ h ^. replSeq
+  oldestIndex = max (h ^. replStart) $ length (h ^. replSeq) - n
+
+data TimeDir = Newer | Older deriving (Eq, Ord, Show)
+
+moveReplHistIndex :: TimeDir -> Text -> REPLHistory -> REPLHistory
+moveReplHistIndex d lastEntered history = history & replIndex .~ newIndex
+ where
+  historyLen = replLength history
+  curText = fromMaybe lastEntered $ getCurrentItemText history
+  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
+
+getCurrentItemText :: REPLHistory -> Maybe Text
+getCurrentItemText history = replItemText <$> Seq.lookup (history ^. replIndex) (history ^. replSeq)
+
+replIndexIsAtInput :: REPLHistory -> Bool
+replIndexIsAtInput repl = repl ^. replIndex == replLength repl
+
+------------------------------------------------------------
+-- UI state
+------------------------------------------------------------
+
+data Modal
+  = HelpModal
+  deriving (Eq, Show)
 
 -- | 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 +298,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 +343,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
@@ -340,15 +441,15 @@ initLgTicksPerSecond = 3 -- 2^3 = 8 ticks / second
 --   time.
 initUIState :: ExceptT Text IO UIState
 initUIState = liftIO $ do
-  mhist <- (>>= readMaybe @[REPLHistItem]) <$> readFileMay ".swarm_history"
+  historyT <- readFileMayT =<< getSwarmHistoryPath False
+  let history = maybe [] (map REPLEntry . T.lines) historyT
   startTime <- getTime Monotonic
   return $
     UIState
       { _uiFocusRing = initFocusRing
       , _uiReplForm = initReplForm
       , _uiReplType = Nothing
-      , _uiReplHistory = mhist ? []
-      , _uiReplHistIdx = -1
+      , _uiReplHistory = newREPLHistory history
       , _uiReplLast = ""
       , _uiInventory = Nothing
       , _uiMoreInfoTop = False