diff options
Diffstat (limited to '')
| -rw-r--r-- | exe/Main.hs | 19 | ||||
| -rw-r--r-- | lib/Daffm/State.hs | 31 | ||||
| -rw-r--r-- | notes.org | 2 |
3 files changed, 30 insertions, 22 deletions
diff --git a/exe/Main.hs b/exe/Main.hs index 2bfe08b..e150569 100644 --- a/exe/Main.hs +++ b/exe/Main.hs @@ -11,7 +11,7 @@ import System.Directory (getCurrentDirectory) import System.Environment (getArgs) data Args = Args - { argsCwd :: Maybe Text.Text, + { argsDirOrFile :: Maybe Text.Text, argsConfigFile :: Maybe FilePath, argsHelp :: Bool } @@ -23,12 +23,11 @@ main = do evaluate args evaluate :: Args -> IO () -evaluate (Args {argsHelp = True}) = - putStrLn helpMenuContents -evaluate (Args {argsCwd, argsConfigFile}) = do +evaluate (Args {argsHelp = True}) = putStrLn helpMenuContents +evaluate (Args {argsDirOrFile, argsConfigFile}) = do cwd <- getCurrentDirectory config <- loadConfigFile argsConfigFile - let dir = fromMaybe (Text.pack cwd) argsCwd + let dir = fromMaybe (Text.pack cwd) argsDirOrFile initialState <- Daffm.loadDirToState dir $ Daffm.mkEmptyAppState config void $ M.defaultMain Daffm.app initialState @@ -37,17 +36,17 @@ parseArgs rawArgs = case parsedArgs of Left e -> throwIO $ userError e Right v -> pure v where - parsedArgs = parse rawArgs (Args {argsCwd = Nothing, argsConfigFile = Nothing, argsHelp = False}) + parsedArgs = parse rawArgs (Args {argsDirOrFile = Nothing, argsConfigFile = Nothing, argsHelp = False}) parse :: [String] -> Args -> Either String Args parse [] args = Right args parse ("-h" : _) args = Right $ args {argsHelp = True} parse ("--help" : _) args = Right $ args {argsHelp = True} - parse ("-c" : config : rest) args = parse rest $ args {argsConfigFile = Just config} parse ["-c"] _ = Left "Missing value for -c arg" - parse ("--config" : config : rest) args = parse rest $ args {argsConfigFile = Just config} + parse ("-c" : config : rest) args = parse rest $ args {argsConfigFile = Just config} parse ["--config"] _ = Left "Missing value for --config arg" + parse ("--config" : config : rest) args = parse rest $ args {argsConfigFile = Just config} parse (flag@('-' : _) : _) _ = Left $ "Invalid flag " <> flag - parse (dir : rest) args = parse rest $ args {argsCwd = Just $ Text.pack dir} + parse (dir : rest) args = parse rest $ args {argsDirOrFile = Just $ Text.pack dir} helpMenuContents :: String helpMenuContents = @@ -58,7 +57,7 @@ helpMenuContents = "", "Arguments:", " [dir]", - " Directory to load. Defaults to current working directory", + " Directory or file path to load. Defaults to current working directory", "", "Options:", " -c, --config <CONFIG-PATH>", diff --git a/lib/Daffm/State.hs b/lib/Daffm/State.hs index 355acab..7601acd 100644 --- a/lib/Daffm/State.hs +++ b/lib/Daffm/State.hs @@ -14,8 +14,8 @@ import qualified Data.Text as Text import qualified Data.Text.Zipper.Generic as Zipper import qualified Data.Vector as Vec import qualified Graphics.Vty as K -import System.Directory (doesDirectoryExist, getHomeDirectory, listDirectory, makeAbsolute, setCurrentDirectory) -import System.FilePath (joinPath) +import System.Directory (doesDirectoryExist, doesPathExist, getCurrentDirectory, getHomeDirectory, listDirectory, makeAbsolute, setCurrentDirectory) +import System.FilePath (joinPath, takeDirectory, takeFileName) import System.PosixCompat (fileExist) import qualified System.PosixCompat as Posix @@ -65,12 +65,16 @@ toggleFileSelection :: FilePathText -> AppState -> AppState toggleFileSelection path st = st {stateFileSelections = toggleSetItem path $ stateFileSelections st} normalizePath :: FilePathText -> IO FilePathText -normalizePath (Text.null -> True) = Text.pack <$> getHomeDirectory normalizePath "~" = Text.pack <$> getHomeDirectory normalizePath (Text.stripPrefix "~/" -> (Just rest)) = do home <- getHomeDirectory pure . Text.pack . joinPath $ [home, Text.unpack rest] -normalizePath dir = pure dir +normalizePath dir = Text.pack <$> makeAbsolute (Text.unpack dir) + +withCwdFallback :: FilePathText -> IO FilePathText +withCwdFallback path = do + exists <- doesPathExist $ Text.unpack path + if exists then pure path else Text.pack <$> getCurrentDirectory stripQuotes :: Text.Text -> Text.Text stripQuotes txt = fromMaybe txt (double <|> single) @@ -78,22 +82,27 @@ stripQuotes txt = fromMaybe txt (double <|> single) double = Text.stripPrefix "\"" txt >>= Text.stripSuffix "\"" single = Text.stripPrefix "'" txt >>= Text.stripSuffix "'" +textAsString :: (String -> String) -> Text.Text -> Text.Text +textAsString f = Text.pack . f . Text.unpack + loadDirToState :: FilePathText -> AppState -> IO AppState loadDirToState dir' appState@(AppState {stateCwd, stateListPositionHistory}) = do - dir <- normalizePath . stripQuotes $ trim dir' + normalizedDir <- (normalizePath . stripQuotes . trim) dir' >>= withCwdFallback + stat <- Posix.getSymbolicLinkStatus $ Text.unpack normalizedDir + let (dir, targetFilePathM) = + if Posix.isDirectory stat + then (normalizedDir, Nothing) + else (textAsString takeDirectory normalizedDir, Just normalizedDir) doesDirectoryExist (Text.unpack dir) >>= \case True -> do setCurrentDirectory $ Text.unpack dir files <- listFilesInDir dir let prevDirPosM = findIndex ((== stateCwd) . filePath) files let cachedPosM = Map.lookup dir stateListPositionHistory - let pos = fromMaybe 0 (cachedPosM <|> prevDirPosM) + let targetFilePosM = targetFilePathM >>= \f -> findIndex ((== f) . filePath) files + let pos = fromMaybe 0 (targetFilePosM <|> cachedPosM <|> prevDirPosM) let list = L.listMoveTo pos $ L.list FocusMain (Vec.fromList files) 1 - pure $ - appState - { stateFiles = list, - stateCwd = dir - } + pure $ appState {stateFiles = list, stateCwd = dir} False -> pure appState fileTypeFromStatus :: Posix.FileStatus -> FileType @@ -24,7 +24,7 @@ - [X] chain multiple commands - [X] Fix cmd substitution for all command args - [X] Command: command-shell special variant of shell that evaluates output as commands -- [ ] Given file name, open dir of file with cursor on file +- [X] Given file name, open dir of file with cursor on file - [ ] Store last directory path (for auto cd in shell) - [ ] Store selections path (for copy/move/paste across instances) - [ ] Command: search, search-next, search-prev |