diff --git a/src/Swarm/TUI/Controller.hs b/src/Swarm/TUI/Controller.hs index 88765aa00..643eecfb3 100644 --- a/src/Swarm/TUI/Controller.hs +++ b/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 diff --git a/src/Swarm/TUI/Model.hs b/src/Swarm/TUI/Model.hs index 30ac09671..70e8c4d9c 100644 --- a/src/Swarm/TUI/Model.hs +++ b/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 diff --git a/src/Swarm/TUI/View.hs b/src/Swarm/TUI/View.hs index b9671d59f..f6d447c8a 100644 --- a/src/Swarm/TUI/View.hs +++ b/src/Swarm/TUI/View.hs @@ -47,6 +47,7 @@ import qualified Data.List as L import Data.List.Split (chunksOf) import qualified Data.Map as M import Data.Maybe (fromMaybe) +import Data.String (fromString) import Data.Text (Text) import qualified Data.Text as T import Linear @@ -556,13 +557,16 @@ drawRobotLog s = drawREPL :: AppState -> Widget Name drawREPL s = vBox $ - map fmt (reverse (take (replHeight - 1) . filter newEntry $ (s ^. uiState . uiReplHistory))) - ++ case isActive <$> (s ^. gameState . robotMap . at "base") of + map fmt (getLatestREPLHistoryItems (replHeight - inputLines) history) + ++ case isActive <$> base of Just False -> [renderForm (s ^. uiState . uiReplForm)] _ -> [padRight Max $ txt "..."] + ++ [padRight Max $ txt histIdx | debugging] where - newEntry (REPLEntry False _ _) = False - newEntry _ = True - - fmt (REPLEntry _ _ e) = txt replPrompt <+> txt e + debugging = False -- Turn ON to get extra line with history index + inputLines = 1 + fromEnum debugging + history = s ^. uiState . uiReplHistory + base = s ^. gameState . robotMap . at "base" + histIdx = fromString $ show (history ^. replIndex) + fmt (REPLEntry e) = txt replPrompt <+> txt e fmt (REPLOutput t) = txt t diff --git a/src/Swarm/Util.hs b/src/Swarm/Util.hs index 2a63beb28..11669fa8e 100644 --- a/src/Swarm/Util.hs +++ b/src/Swarm/Util.hs @@ -24,9 +24,14 @@ module Swarm.Util ( (?), maxOn, maximum0, - readFileMay, cycleEnum, + -- * Directory utilities + readFileMay, + readFileMayT, + getSwarmDataPath, + getSwarmHistoryPath, + -- * English language utilities quote, squote, @@ -57,12 +62,13 @@ import Control.Algebra (Has) import Control.Effect.State (State, modify, state) import Control.Effect.Throw (Throw, throwError) import Control.Lens (ASetter', LensLike, LensLike', Over, (<>~)) -import Control.Monad (unless) +import Control.Monad (unless, when) import Data.Either.Validation import Data.Int (Int64) import Data.Maybe (fromMaybe) import Data.Text (Text) import qualified Data.Text as T +import qualified Data.Text.IO as T import Data.Tuple (swap) import Data.Yaml import Language.Haskell.TH @@ -70,7 +76,13 @@ import Language.Haskell.TH.Syntax (lift) import Linear (V2) import qualified NLP.Minimorph.English as MM import NLP.Minimorph.Util ((<+>)) -import System.Directory (doesFileExist) +import System.Directory ( + XdgDirectory (XdgData), + createDirectoryIfMissing, + getXdgDirectory, + ) +import System.FilePath +import System.IO.Error (catchIOError) infixr 1 ? infix 4 %%=, <+=, <%=, <<.=, <>= @@ -95,19 +107,6 @@ maximum0 :: (Num a, Ord a) => [a] -> a maximum0 [] = 0 maximum0 xs = maximum xs --- | Safely attempt to read a file, returning @Nothing@ if the file --- does not exist. \"Safely\" should be read in scare quotes here, --- since /e.g./ we do nothing to guard against the possibility of a --- race condition where the file is deleted after the existence --- check but before trying to read it. But it's not like we're --- worried about security or anything here. -readFileMay :: FilePath -> IO (Maybe String) -readFileMay file = do - b <- doesFileExist file - case b of - False -> return Nothing - True -> Just <$> readFile file - -- | Take the successor of an 'Enum' type, wrapping around when it -- reaches the end. cycleEnum :: (Eq e, Enum e, Bounded e) => e -> e @@ -115,7 +114,37 @@ cycleEnum e | e == maxBound = minBound | otherwise = succ e --------------------------------------------------- +------------------------------------------------------------ +-- Directory stuff + +-- | Safely attempt to read a file. +readFileMay :: FilePath -> IO (Maybe String) +readFileMay = catchIO . readFile + +-- | Safely attempt to (efficiently) read a file. +readFileMayT :: FilePath -> IO (Maybe Text) +readFileMayT = catchIO . T.readFile + +-- | Turns any IO error into Nothing. +catchIO :: IO a -> IO (Maybe a) +catchIO act = (Just <$> act) `catchIOError` (\_ -> return Nothing) + +-- | Get path to swarm data, optionally creating necessary +-- directories. +getSwarmDataPath :: Bool -> IO FilePath +getSwarmDataPath createDirs = do + swarmData <- getXdgDirectory XdgData "swarm" + when createDirs (createDirectoryIfMissing True swarmData) + pure swarmData + +-- | Get path to swarm history, optionally creating necessary +-- directories. This could fail if user has bad permissions +-- on his own $HOME or $XDG_DATA_HOME which is unlikely. +getSwarmHistoryPath :: Bool -> IO FilePath +getSwarmHistoryPath createDirs = + ( "history") <$> getSwarmDataPath createDirs + +------------------------------------------------------------ -- Some language-y stuff -- | Prepend a noun with the proper indefinite article (\"a\" or \"an\"). diff --git a/swarm.cabal b/swarm.cabal index b73780498..80f7dafc3 100644 --- a/swarm.cabal +++ b/swarm.cabal @@ -96,6 +96,7 @@ library containers >= 0.6.2 && < 0.7, directory >= 1.3 && < 1.4, either >= 5.0 && < 5.1, + filepath >= 1.4 && < 1.5, fused-effects >= 1.1.1.1 && < 1.2, fused-effects-lens >= 1.2.0.1 && < 1.3, hashable >= 1.3.4 && < 1.4, diff --git a/test/Unit.hs b/test/Unit.hs index 88313d213..e4d912915 100644 --- a/test/Unit.hs +++ b/test/Unit.hs @@ -8,6 +8,7 @@ module Main where import Control.Lens ((&), (.~)) import Control.Monad.Except import Control.Monad.State +import Data.String (fromString) import Data.Text (Text) import qualified Data.Text as T import Linear @@ -26,6 +27,7 @@ import Swarm.Language.Context import Swarm.Language.Pipeline (ProcessedTerm (..), processTerm) import Swarm.Language.Pretty import Swarm.Language.Syntax hiding (mkOp) +import Swarm.TUI.Model main :: IO () main = do @@ -35,7 +37,7 @@ main = do Right g -> defaultMain (tests g) tests :: GameState -> TestTree -tests g = testGroup "Tests" [parser, prettyConst, eval g] +tests g = testGroup "Tests" [parser, prettyConst, eval g, testModel] parser :: TestTree parser = @@ -423,3 +425,81 @@ eval g = runCESK !steps cesk = case finalValue cesk of Just (v, _) -> return (Right (v, steps)) Nothing -> stepCESK cesk >>= runCESK (steps + 1) + +testModel :: TestTree +testModel = + testGroup + "TUI Model" + [ testCase + "latest repl lines at start" + ( assertEqual + "get 5 history [0] --> []" + [] + (getLatestREPLHistoryItems 5 history0) + ) + , testCase + "latest repl lines after one input" + ( assertEqual + "get 5 history [0|()] --> [()]" + [REPLEntry "()"] + (getLatestREPLHistoryItems 5 (addREPLItem (REPLEntry "()") history0)) + ) + , testCase + "latest repl lines after one input and output" + ( assertEqual + "get 5 history [0|1,1:int] --> [1,1:int]" + [REPLEntry "1", REPLOutput "1:int"] + (getLatestREPLHistoryItems 5 (addInOutInt 1 history0)) + ) + , testCase + "latest repl lines after nine inputs and outputs" + ( assertEqual + "get 6 history [0|1,1:int .. 9,9:int] --> [7,7:int..9,9:int]" + (concat [[REPLEntry (toT x), REPLOutput (toT x <> ":int")] | x <- [7 .. 9]]) + (getLatestREPLHistoryItems 6 (foldl (flip addInOutInt) history0 [1 .. 9])) + ) + , testCase + "latest repl after restart" + ( assertEqual + "get 5 history (restart [0|()]) --> []" + [] + (getLatestREPLHistoryItems 5 (restartREPLHistory $ addREPLItem (REPLEntry "()") history0)) + ) + , testCase + "current item at start" + (assertEqual "getText [0] --> Nothing" (getCurrentItemText history0) Nothing) + , testCase + "current item after move to older" + ( assertEqual + "getText ([0]<=='') --> Just 0" + (Just "0") + (getCurrentItemText $ moveReplHistIndex Older "" history0) + ) + , testCase + "current item after move to newer" + ( assertEqual + "getText ([0]==>'') --> Nothing" + Nothing + (getCurrentItemText $ moveReplHistIndex Newer "" history0) + ) + , testCase + "current item after move past output" + ( assertEqual + "getText ([0,1,1:int]<=='') --> Just 1" + (Just "1") + (getCurrentItemText $ moveReplHistIndex Older "" (addInOutInt 1 history0)) + ) + , testCase + "current item after move past same" + ( assertEqual + "getText ([0,1,1:int]<=='1') --> Just 0" + (Just "0") + (getCurrentItemText $ moveReplHistIndex Older "1" (addInOutInt 1 history0)) + ) + ] + where + history0 = newREPLHistory [REPLEntry "0"] + toT :: Int -> Text + toT = fromString . show + addInOutInt :: Int -> REPLHistory -> REPLHistory + addInOutInt i = addREPLItem (REPLOutput $ toT i <> ":int") . addREPLItem (REPLEntry $ toT i)