Allow directories and file paths as cli arg/cd

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
diff --git a/notes.org b/notes.org
index 89820e3..7b5d4d5 100644
--- a/notes.org
+++ b/notes.org
@@ -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