Add move command and gj gk keys

5 files changed, 137 insertions, 112 deletions

diff --git a/lib/Daffm/Action/Commands.hs b/lib/Daffm/Action/Commands.hs
index a6a55e6..669ff3c 100644
--- a/lib/Daffm/Action/Commands.hs
+++ b/lib/Daffm/Action/Commands.hs
@@ -4,9 +4,10 @@
 module Daffm.Action.Commands where
 
 import qualified Brick as M
+import qualified Brick.Widgets.List as L
 import Control.Monad (forM_)
 import Control.Monad.IO.Class (MonadIO (liftIO))
-import Control.Monad.State (modify)
+import Control.Monad.State (gets, modify)
 import Daffm.Action.Cmdline
 import Daffm.Action.Core
 import Daffm.Keymap (parseKeySequence)
@@ -27,8 +28,9 @@ runCmdline = do
   evaluateCommand cmd
 
 parseCommand :: Text.Text -> Maybe Command
-parseCommand (Text.splitAt 2 -> ("!!", cmd)) = Just $ CmdShell True cmd
-parseCommand (Text.splitAt 1 -> ("!", cmd)) = Just $ CmdShell False cmd
+parseCommand (Text.stripPrefix "!!" -> Just cmd) = Just $ CmdShell True cmd
+parseCommand (Text.stripPrefix "!" -> Just cmd) = Just $ CmdShell False cmd
+parseCommand (Text.stripPrefix "/" -> Just term) = Just $ CmdSearch $ trim term
 parseCommand cmd = mkCmd . splitCmdArgs $ trimStart cmd
   where
     splitCmdArgs = second trimStart . Text.break isSpace
@@ -37,7 +39,7 @@ parseCommand cmd = mkCmd . splitCmdArgs $ trimStart cmd
       ("quit", _) -> Just CmdQuit
       ("shell!", cmd') -> Just $ CmdShell True cmd'
       ("shell", cmd') -> Just $ CmdShell False cmd'
-      ("command-shell", cmd') -> Just $ CmdCommandShell cmd'
+      ("eval", cmd') -> Just $ CmdCommandShell cmd'
       ("back", _) -> Just CmdGoBack
       ("open", _) -> Just CmdOpenSelection
       ("reload", _) -> Just CmdReload
@@ -51,6 +53,10 @@ parseCommand cmd = mkCmd . splitCmdArgs $ trimStart cmd
       ("search", term) -> Just $ CmdSearch $ trim term
       ("search-next", _) -> Just $ CmdSearchNext 1
       ("search-prev", _) -> Just $ CmdSearchNext (-1)
+      ("move", Text.stripPrefix "$" -> Just _) -> Just $ CmdMove MoveToEnd
+      ("move", Text.stripPrefix "+" -> Just inc) -> Just . CmdMove . MoveDown . read $ Text.unpack inc
+      ("move", Text.stripPrefix "-" -> Just inc) -> Just . CmdMove . MoveUp . read $ Text.unpack inc
+      ("move", pos) -> Just . CmdMove . MoveTo . read $ Text.unpack pos
       ("map", Text.break isSpace -> (keysraw, cmdraw)) -> do
         keys <- parseKeySequence keysraw
         cmd' <- parseCommand $ trimStart cmdraw
@@ -95,7 +101,18 @@ processCommand CmdGoBack = goBackToParentDir
 processCommand (CmdChain chain) = forM_ chain processCommand
 processCommand (CmdSearch term) = setSearchTerm term >> applySearch >> nextSearchMatch
 processCommand (CmdSearchNext change) = updateSearchIndex (+ change) >> nextSearchMatch
-processCommand (CmdKeymapSet keys command) = modify $ \s -> s {stateKeyMap = Map.insert keys command $ stateKeyMap s}
+processCommand (CmdKeymapSet keys command) =
+  modify $ \st -> st {stateKeyMap = Map.insert keys command $ stateKeyMap st}
+processCommand (CmdMove move) = moveCursor $ toUpdater move
+  where
+    toUpdater MoveToEnd = L.listMoveToEnd
+    toUpdater (MoveTo pos) = L.listMoveTo pos
+    toUpdater (MoveUp inc) = L.listMoveBy $ - inc
+    toUpdater (MoveDown inc) = L.listMoveBy inc
+    moveCursor :: (L.List FocusTarget FileInfo -> L.List FocusTarget FileInfo) -> AppEvent ()
+    moveCursor updater = do
+      files <- gets $ updater . stateFiles
+      modify $ \st -> st {stateFiles = files}
 processCommand CmdNoop = pure ()
 
 evaluateCommand :: Text.Text -> AppEvent ()
diff --git a/lib/Daffm/Action/Core.hs b/lib/Daffm/Action/Core.hs
index 72bccef..dc68c5d 100644
--- a/lib/Daffm/Action/Core.hs
+++ b/lib/Daffm/Action/Core.hs
@@ -25,24 +25,21 @@ modifyM f = get >>= f >>= put
 loadDir :: FilePathText -> AppEvent ()
 loadDir dir = do
   modifyM (liftIO . (>>= filterInvalidSelections) . loadDirToState dir)
-  applySearch
+  applySearch -- Apply search after loading dir to update match indexes
 
 reloadDir :: AppEvent ()
-reloadDir = do
-  AppState {stateCwd} <- get
-  loadDir stateCwd
+reloadDir = gets stateCwd >>= loadDir
 
 goBackToParentDir :: AppEvent ()
 goBackToParentDir = do
-  dir <- gets (Text.pack . takeDirectory . Text.unpack . stateCwd)
-  loadDir dir
+  parentDir <- gets (Text.pack . takeDirectory . Text.unpack . stateCwd)
+  loadDir parentDir
 
 changeDir :: FilePathText -> AppEvent ()
 changeDir = loadDir
 
 goHome :: AppEvent ()
-goHome = do
-  liftIO getHomeDirectory >>= changeDir . Text.pack
+goHome = liftIO getHomeDirectory >>= changeDir . Text.pack
 
 openSelectedFile :: AppEvent ()
 openSelectedFile = do
@@ -54,99 +51,98 @@ openSelectedFile = do
       cmdSubstitutions opener >>= suspendAndRunShellCommand False
     Nothing -> pure ()
 
-shellCommand :: String -> IO Proc.ExitCode
-shellCommand cmd = do
-  Proc.withCreateProcess
-    (Proc.shell cmd) {Proc.delegate_ctlc = True}
-    $ \_ _ _ p -> Proc.waitForProcess p
-
 cmdSubstitutions :: Text.Text -> AppEvent Text.Text
-cmdSubstitutions cmd = do
-  (AppState {stateFiles, stateCwd, stateFileSelections}) <- get
-  let file = maybe "" (filePath . snd) . L.listSelectedElement $ stateFiles
-  let escape = (\s -> "'" <> s <> "'") . Text.replace "'" "\\'"
-  let selections = Set.elems stateFileSelections
-  let selectionsOrCurrent = if Set.null stateFileSelections then [file] else selections
-  let subst =
-        Text.replace "%" (escape file)
-          . Text.replace "%d" (escape stateCwd)
-          . Text.replace "%s" (Text.unwords $ map escape selections)
-          . Text.replace "%S" (Text.dropWhileEnd (== '\n') $ Text.unlines selections)
-          . Text.replace "%f" (Text.unwords $ map escape selectionsOrCurrent)
-          . Text.replace "%F" (Text.dropWhileEnd (== '\n') $ Text.unlines selectionsOrCurrent)
-  pure . subst $ cmd
+cmdSubstitutions cmd = gets (`substitute` cmd)
+  where
+    escape = (\s -> "'" <> s <> "'") . Text.replace "'" "\\'"
+    substitute (AppState {stateFiles, stateCwd, stateFileSelections}) =
+      Text.replace "%" (escape cursorFile)
+        . Text.replace "%d" (escape stateCwd)
+        . Text.replace "%s" (Text.unwords $ map escape selections)
+        . Text.replace "%S" (Text.dropWhileEnd (== '\n') $ Text.unlines selections)
+        . Text.replace "%f" (Text.unwords $ map escape selectionsOrCursor)
+        . Text.replace "%F" (Text.dropWhileEnd (== '\n') $ Text.unlines selectionsOrCursor)
+      where
+        cursorFile = maybe "" (filePath . snd) . L.listSelectedElement $ stateFiles
+        selections = Set.elems stateFileSelections
+        selectionsOrCursor = if Set.null stateFileSelections then [cursorFile] else selections
 
 -- Suspend tui and run shell command
 -- When waitForKey is true, it will prompt for a key press on success
 -- When exit code is non-zero, it will print it and prompt for key press regardless of waitForKey
 suspendAndRunShellCommand :: Bool -> Text.Text -> AppEvent ()
 suspendAndRunShellCommand waitForKey cmd = do
-  suspendAndResume' $ do
-    exitCode <- shellCommand $ Text.unpack cmd
-    case exitCode of
+  suspendAndResume' $
+    shellCommand (Text.unpack cmd) >>= \case
       Proc.ExitFailure code -> do
         putStrLn $ "Process exited with " <> show code
         putStrLn "Press any key to continue" >> void getChar
       _ | waitForKey -> putStrLn "Press any key to continue" >> void getChar
       _ -> pure ()
 
+shellCommand :: String -> IO Proc.ExitCode
+shellCommand cmd = do
+  Proc.withCreateProcess
+    (Proc.shell cmd) {Proc.delegate_ctlc = True}
+    $ \_ _ _ p -> Proc.waitForProcess p
+
 currentFile :: AppEvent (Maybe FileInfo)
-currentFile = do
-  gets (fmap snd . L.listSelectedElement . stateFiles)
+currentFile = gets (fmap snd . L.listSelectedElement . stateFiles)
 
 toggleCurrentFileSelection :: AppEvent ()
 toggleCurrentFileSelection = do
-  currentFile >>= maybe (pure ()) (modify . toggleFileSelection . filePath)
+  currentFile >>= \case
+    Just fileInfo -> modify . toggleFileSelection . filePath $ fileInfo
+    Nothing -> pure ()
   moveCurrent 1
 
 clearFileSelections :: AppEvent ()
 clearFileSelections =
-  modify $ \s -> s {stateFileSelections = Set.empty}
+  modify $ \st -> st {stateFileSelections = Set.empty}
 
 moveCurrent :: Int -> AppEvent ()
-moveCurrent count = do
-  files <- gets stateFiles
-  modify $ \s -> s {stateFiles = L.listMoveBy count files}
+moveCurrent count =
+  modify $ \st -> st {stateFiles = L.listMoveBy count $ stateFiles st}
 
 setSearchTerm :: Text.Text -> AppEvent ()
-setSearchTerm "" = modify (\st -> st {stateSearchTerm = Nothing, stateSearchIndex = 0})
-setSearchTerm term = modify (\st -> st {stateSearchTerm = Just term, stateSearchIndex = 0})
+setSearchTerm "" = modify $ \st -> st {stateSearchTerm = Nothing, stateSearchIndex = 0}
+setSearchTerm term = modify $ \st -> st {stateSearchTerm = Just term, stateSearchIndex = 0}
 
 applySearch :: AppEvent ()
-applySearch = get >>= apply
+applySearch = get >>= search
   where
-    apply :: AppState -> AppEvent ()
-    apply (AppState {stateSearchTerm = Nothing}) =
-      modify
-        (\st -> st {stateSearchMatches = Vec.empty, stateSearchIndex = 0})
-    apply (AppState {stateSearchTerm = Just term, stateFiles}) = do
-      let search (_, FileInfo {fileName}) = Text.toLower term `Text.isInfixOf` Text.toLower fileName
-      let matches = Vec.map fst . Vec.filter search . Vec.indexed $ L.listElements stateFiles
-      modify
-        ( \st ->
-            st
-              { stateSearchMatches = matches,
-                stateSearchIndex = wrapSearchIndex st (stateSearchIndex st)
-              }
-        )
+    search :: AppState -> AppEvent ()
+    search (AppState {stateSearchTerm = Nothing}) =
+      modify $ \st -> st {stateSearchMatches = Vec.empty, stateSearchIndex = 0}
+    search (AppState {stateSearchTerm = Just term, stateFiles}) =
+      modify $
+        \st ->
+          st
+            { stateSearchMatches = searchFiles stateFiles,
+              stateSearchIndex = wrapSearchIndex st $ stateSearchIndex st
+            }
+      where
+        isAMatch (FileInfo {fileName}) = Text.toLower term `Text.isInfixOf` Text.toLower fileName
+        searchFiles = Vec.map fst . Vec.filter (isAMatch . snd) . Vec.indexed . L.listElements
 
 nextSearchMatch :: AppEvent ()
-nextSearchMatch = do
-  st@(AppState {stateSearchMatches, stateFiles, stateSearchIndex}) <- get
-  let nextFiles =
-        if Vec.null stateSearchMatches
-          then stateFiles
-          else L.listMoveTo (stateSearchMatches Vec.! wrapSearchIndex st stateSearchIndex) stateFiles
-  modify (\st' -> st' {stateFiles = nextFiles})
+nextSearchMatch =
+  modify (\st -> st {stateFiles = forwardSearch st})
+  where
+    forwardSearch st@(AppState {stateSearchMatches, stateFiles, stateSearchIndex}) =
+      if Vec.null stateSearchMatches
+        then stateFiles
+        else L.listMoveTo (stateSearchMatches Vec.! wrapSearchIndex st stateSearchIndex) stateFiles
 
 wrapSearchIndex :: AppState -> Int -> Int
 wrapSearchIndex (AppState {stateSearchMatches}) nextIndex =
-  let matchCount = length stateSearchMatches
-   in if
-        | nextIndex < 0 -> matchCount - 1
-        | nextIndex >= matchCount && matchCount /= 0 -> nextIndex `mod` matchCount
-        | otherwise -> nextIndex
+  if
+    | nextIndex < 0 -> matchCount - 1
+    | nextIndex >= matchCount && matchCount /= 0 -> nextIndex `mod` matchCount
+    | otherwise -> nextIndex
+  where
+    matchCount = length stateSearchMatches
 
 updateSearchIndex :: (Int -> Int) -> AppEvent ()
-updateSearchIndex upd =
-  modify (\st -> st {stateSearchIndex = wrapSearchIndex st $ upd $ stateSearchIndex st})
+updateSearchIndex update =
+  modify $ \st -> st {stateSearchIndex = wrapSearchIndex st $ update $ stateSearchIndex st}
diff --git a/lib/Daffm/Configuration.hs b/lib/Daffm/Configuration.hs
index 9536007..884db36 100644
--- a/lib/Daffm/Configuration.hs
+++ b/lib/Daffm/Configuration.hs
@@ -15,11 +15,49 @@ import qualified Data.Map as Map
 import Data.Maybe (fromMaybe)
 import qualified Data.Text as Text
 import qualified Data.Text.IO as Text
+import qualified Graphics.Vty as K
 import System.Directory (XdgDirectory (XdgConfig), getXdgDirectory)
 import System.FilePath (joinPath)
 import Toml ((.=))
 import qualified Toml
 
+defaultConfiguration :: Configuration
+defaultConfiguration =
+  Configuration
+    { configKeymap = defaultKeymaps,
+      configOpener = Nothing,
+      configTheme = Map.empty,
+      configExtend = Nothing
+    }
+
+defaultKeymaps :: Keymap
+defaultKeymaps =
+  Map.fromList
+    [ ([K.KChar 'q'], CmdQuit),
+      ([K.KChar 'r', K.KChar 'r'], CmdReload),
+      ([K.KChar '!'], CmdSetCmdline "!"),
+      ([K.KChar '/'], CmdSetCmdline "/"),
+      ([K.KChar 'n'], CmdSearchNext 1),
+      ([K.KChar 'N'], CmdSearchNext (-1)),
+      ([K.KChar ':'], CmdEnterCmdline),
+      ([K.KChar 'l'], CmdOpenSelection),
+      ([K.KChar 'h'], CmdGoBack),
+      ([K.KEnter], CmdOpenSelection),
+      ([K.KBS], CmdGoBack),
+      ([K.KChar 'v'], CmdToggleSelection),
+      ([K.KChar '\t'], CmdToggleSelection),
+      ([K.KChar 'C'], CmdClearSelection),
+      ([K.KChar '~'], CmdChangeDir "~"),
+      ([K.KChar '$'], CmdShell False "$SHELL"),
+      ([K.KChar 'g', K.KChar 'x'], CmdShell False "!xdg-open % >/dev/null 2>&1"),
+      ([K.KChar 'g', K.KChar 'h'], CmdChangeDir "~"),
+      ([K.KChar 'g', K.KChar 'c', K.KChar 'f', K.KChar 'g'], CmdChangeDir "~/.config/daffm"),
+      ([K.KChar 'g', K.KChar 'g'], CmdMove $ MoveTo 0),
+      ([K.KChar 'g', K.KChar 'k'], CmdMove $ MoveTo 0),
+      ([K.KChar 'g', K.KChar 'j'], CmdMove MoveToEnd),
+      ([K.KChar 'G'], CmdMove MoveToEnd)
+    ]
+
 getConfigDir :: IO FilePath
 getConfigDir = getXdgDirectory XdgConfig "daffm"
 
diff --git a/lib/Daffm/State.hs b/lib/Daffm/State.hs
index 98b9aa9..cd8d6ec 100644
--- a/lib/Daffm/State.hs
+++ b/lib/Daffm/State.hs
@@ -3,11 +3,13 @@
 {-# HLINT ignore "Redundant multi-way if" #-}
 module Daffm.State where
 
+import Brick (suspendAndResume')
 import qualified Brick.Widgets.Edit as Editor
 import qualified Brick.Widgets.List as L
 import Control.Applicative ((<|>))
 import Control.Exception (try)
 import Control.Monad (filterM, forM)
+import qualified Debug.Trace as Debug
 import Daffm.Types
 import Daffm.Utils (trim)
 import Data.List (findIndex, sortBy)
@@ -69,6 +71,7 @@ stripQuotes txt = fromMaybe txt (double <|> single)
     single = Text.stripPrefix "'" txt >>= Text.stripSuffix "'"
 
 stripTrailingSlash :: Text.Text -> Text.Text
+stripTrailingSlash path@"/" = path
 stripTrailingSlash path = fromMaybe path $ Text.stripSuffix "/" path
 
 textAsString :: (String -> String) -> Text.Text -> Text.Text
@@ -78,7 +81,7 @@ loadDirToState :: FilePathText -> AppState -> IO AppState
 loadDirToState dir' appState@(AppState {stateCwd, stateListPositionHistory}) = do
   normalizedDir <- (normalizePath . stripTrailingSlash . stripQuotes . trim) dir' >>= withCwdFallback
   stat <- Posix.getFileStatus $ Text.unpack normalizedDir
-  let (dir, targetFilePathM) =
+  let (dir, targetFilePath) =
         if Posix.isDirectory stat
           then (normalizedDir, Nothing)
           else (textAsString takeDirectory normalizedDir, Just normalizedDir)
@@ -86,10 +89,10 @@ loadDirToState dir' appState@(AppState {stateCwd, stateListPositionHistory}) = d
     True -> do
       setCurrentDirectory $ Text.unpack dir
       files <- listFilesInDir dir
-      let prevDirPosM = findIndex ((== stateCwd) . filePath) files
-      let cachedPosM = Map.lookup dir stateListPositionHistory
-      let targetFilePosM = targetFilePathM >>= \f -> findIndex ((== f) . filePath) files
-      let pos = fromMaybe 0 (targetFilePosM <|> cachedPosM <|> prevDirPosM)
+      let prevDirPos = findIndex ((== stateCwd) . filePath) files
+      let cachedPos = Map.lookup dir stateListPositionHistory
+      let targetFilePos = targetFilePath >>= \target -> findIndex ((== target) . filePath) files
+      let pos = fromMaybe 0 (targetFilePos <|> cachedPos <|> prevDirPos)
       let list = L.listMoveTo pos $ L.list FocusMain (Vec.fromList files) 1
       pure $ appState {stateFiles = list, stateCwd = dir, stateSearchIndex = 0, stateSearchMatches = Vec.empty}
     False -> pure appState
diff --git a/lib/Daffm/Types.hs b/lib/Daffm/Types.hs
index 3fd7086..d9dd977 100644
--- a/lib/Daffm/Types.hs
+++ b/lib/Daffm/Types.hs
@@ -8,7 +8,6 @@ import qualified Data.Map as Map
 import qualified Data.Set as Set
 import qualified Data.Text as Text
 import qualified Data.Vector as Vec
-import qualified Graphics.Vty as K
 import qualified Graphics.Vty as V
 import System.Posix.Types (FileMode, FileOffset)
 
@@ -61,6 +60,9 @@ type CmdlineEditor = Editor.Editor Text.Text FocusTarget
 data KeyMatchResult = MatchSuccess Command | MatchPartial | MatchFailure
   deriving (Show, Eq)
 
+data MoveInc = MoveDown Int | MoveUp Int | MoveTo Int | MoveToEnd
+  deriving (Show, Eq)
+
 data Command
   = CmdShell Bool Text.Text
   | CmdCommandShell Text.Text
@@ -78,6 +80,7 @@ data Command
   | CmdSearch Text.Text
   | CmdSearchNext Int
   | CmdKeymapSet [Key] Command
+  | CmdMove MoveInc
   | CmdNoop
   deriving (Show, Eq)
 
@@ -110,35 +113,3 @@ data Args = Args
   }
   deriving (Show)
 
-defaultConfiguration :: Configuration
-defaultConfiguration =
-  Configuration
-    { configKeymap = defaultKeymaps,
-      configOpener = Nothing,
-      configTheme = Map.empty,
-      configExtend = Nothing
-    }
-
-defaultKeymaps :: Keymap
-defaultKeymaps =
-  Map.fromList
-    [ ([K.KChar 'q'], CmdQuit),
-      ([K.KChar 'r', K.KChar 'r'], CmdReload),
-      ([K.KChar '!'], CmdSetCmdline "!"),
-      ([K.KChar '/'], CmdSetCmdline "search "),
-      ([K.KChar 'n'], CmdSearchNext 1),
-      ([K.KChar 'N'], CmdSearchNext (-1)),
-      ([K.KChar ':'], CmdEnterCmdline),
-      ([K.KChar 'l'], CmdOpenSelection),
-      ([K.KChar 'h'], CmdGoBack),
-      ([K.KEnter], CmdOpenSelection),
-      ([K.KBS], CmdGoBack),
-      ([K.KChar 'v'], CmdToggleSelection),
-      ([K.KChar '\t'], CmdToggleSelection),
-      ([K.KChar 'C'], CmdClearSelection),
-      ([K.KChar '~'], CmdChangeDir "~"),
-      ([K.KChar '$'], CmdShell False "$SHELL"),
-      ([K.KChar 'g', K.KChar 'x'], CmdShell False "!xdg-open % >/dev/null 2>&1"),
-      ([K.KChar 'g', K.KChar 'h'], CmdChangeDir "~"),
-      ([K.KChar 'g', K.KChar 'c', K.KChar 'f', K.KChar 'g'], CmdChangeDir "~/.config/daffm")
-    ]