feat:初始化 QuickJump 项目,实现完整的目录跳转和配置管理功能

This commit is contained in:
2026-02-04 15:49:17 +08:00
commit eb48924491
10 changed files with 1455 additions and 0 deletions

395
app/Commands.hs Normal file
View File

@@ -0,0 +1,395 @@
{-# LANGUAGE OverloadedStrings #-}
module Commands
( runCommand
, runJump
, runQuick
, runConfigCmd
, printShellIntegration
) where
import Control.Monad (forM_, unless, when)
import Data.List (intercalate)
import Data.Map (Map)
import qualified Data.Map as M
import Data.Maybe (fromMaybe, isJust)
import Data.Text (Text)
import qualified Data.Text as T
import System.Directory (doesDirectoryExist, doesFileExist)
import System.Environment (lookupEnv)
import System.Exit (exitFailure, exitSuccess)
import System.FilePath ((</>))
import System.Info (os)
import System.IO (hFlush, stdout)
import System.Process (callCommand, spawnCommand, waitForProcess)
import Config
import Types
import Utils
-- | 运行主命令
runCommand :: Command -> IO ()
runCommand cmd = case cmd of
Jump name quiet -> runJump name quiet
JumpInteractive quiet -> runJumpInteractive quiet
Quick action quiet -> runQuick action quiet
ConfigCmd action quiet -> runConfigCmd action quiet
ShellIntegration -> printShellIntegration
Version -> putStrLn "quickjump version 0.1.0.0"
-- | 跳转到指定条目
runJump :: Text -> Bool -> IO ()
runJump name quiet = do
cfg <- ensureConfigExists
case findEntry name cfg of
Nothing -> do
unless quiet $ do
putStrLn $ "Unknown jump target: " ++ T.unpack name
putStrLn "Use 'quickjump config list' to see available targets"
exitFailure
Just entry -> do
expanded <- expandPath (path entry)
exists <- doesDirectoryExist expanded
if exists
then do
-- 输出 cd 命令供 shell 执行
-- 使用引号包裹路径以处理包含空格的路径
let cdCmd = case os of
"mingw32" -> "cd \"" ++ expanded ++ "\""
"mingw64" -> "cd \"" ++ expanded ++ "\""
_ -> "cd " ++ show expanded
putStrLn cdCmd
else do
unless quiet $ putStrLn $ "Directory does not exist: " ++ expanded
exitFailure
-- | 交互式选择跳转
runJumpInteractive :: Bool -> IO ()
runJumpInteractive quiet = do
cfg <- ensureConfigExists
let sorted = getSortedEntries cfg
if null sorted
then unless quiet $ do
putStrLn "No jump targets configured"
putStrLn "Use 'quickjump config add <name> <path>' to add one"
else do
unless quiet $ do
putStrLn "Available jump targets:"
putStrLn ""
forM_ (zip [1..] sorted) $ \(i, (name, entry)) -> do
let desc = fromMaybe "" (description entry)
putStrLn $ " " ++ show (i :: Int) ++ ". " ++ T.unpack name
++ " -> " ++ path entry
++ if T.null desc then "" else " (" ++ T.unpack desc ++ ")"
putStr "\nSelect target (number or name): "
hFlush stdout
selection <- getLine
case reads selection of
[(n, "")] | n > 0 && n <= length sorted ->
runJump (fst $ sorted !! (n - 1)) quiet
_ -> runJump (T.pack selection) quiet
-- | 运行快速操作
runQuick :: QuickAction -> Bool -> IO ()
runQuick action quiet = do
cfg <- ensureConfigExists
case action of
QuickOpen name -> do
case findEntry name cfg of
Nothing -> do
unless quiet $ putStrLn $ "Unknown quick target: " ++ T.unpack name
exitFailure
Just entry -> openPath (path entry) cfg quiet
QuickOpenPath p -> openPath p cfg quiet
QuickList -> do
let sorted = getSortedEntries cfg
unless quiet $ do
putStrLn "Quick access targets:"
putStrLn ""
forM_ sorted $ \(name, entry) -> do
let desc = fromMaybe "" (description entry)
putStrLn $ " " ++ padRight 15 (T.unpack name)
++ " -> " ++ padRight 30 (path entry)
++ if T.null desc then "" else " # " ++ T.unpack desc
QuickDefault ->
case defaultPath cfg of
Nothing -> do
unless quiet $ do
putStrLn "No default path configured"
putStrLn "Use 'quickjump config set-default <path>' to set one"
exitFailure
Just p -> openPath p cfg quiet
-- | 打开路径(使用文件管理器或 cd
openPath :: FilePath -> Config -> Bool -> IO ()
openPath p cfg quiet = do
expanded <- expandPath p
exists <- doesDirectoryExist expanded
unless exists $ do
unless quiet $ putStrLn $ "Directory does not exist: " ++ expanded
exitFailure
-- 尝试使用配置的文件管理器,或者自动检测
let fm = fileManager cfg
case fm of
Just cmd -> runFileManager cmd expanded quiet
Nothing -> autoDetectAndOpen expanded quiet
-- | 自动检测并打开文件管理器
autoDetectAndOpen :: FilePath -> Bool -> IO ()
autoDetectAndOpen path quiet = do
let (cmd, args) = case os of
"darwin" -> ("open", [path])
"mingw32" -> ("explorer", [path])
"mingw64" -> ("explorer", [path])
"cygwin" -> ("cygstart", [path])
_ -> ("xdg-open", [path]) -- Linux and others
-- 检查命令是否存在
exists <- commandExists cmd
if exists
then do
_ <- spawnCommand (unwords (cmd : map show args)) >>= waitForProcess
return ()
else do
unless quiet $ do
putStrLn $ "Cannot open file manager. Please configure one:"
putStrLn $ " quickjump config set-file-manager <command>"
-- 输出 cd 命令作为备选
putStrLn $ "cd " ++ show path
-- | 运行文件管理器
runFileManager :: FilePath -> FilePath -> Bool -> IO ()
runFileManager cmd path quiet = do
expanded <- expandPath path
let fullCmd = cmd ++ " " ++ show expanded
_ <- spawnCommand fullCmd >>= waitForProcess
return ()
-- | 运行配置命令
runConfigCmd :: ConfigAction -> Bool -> IO ()
runConfigCmd action quiet = do
cfg <- ensureConfigExists
case action of
ConfigAdd name path mDesc -> do
expanded <- expandPath path
exists <- doesDirectoryExist expanded
unless exists $ do
unless quiet $ putStrLn $ "Warning: Directory does not exist: " ++ expanded
let entry = JumpEntry
{ path = path
, description = mDesc
, priority = 100
}
newCfg = cfg { entries = M.insert name entry (entries cfg) }
saveConfig newCfg
unless quiet $ putStrLn $ "Added '" ++ T.unpack name ++ "' -> " ++ path
ConfigRemove name -> do
if M.member name (entries cfg)
then do
let newCfg = cfg { entries = M.delete name (entries cfg) }
saveConfig newCfg
unless quiet $ putStrLn $ "Removed '" ++ T.unpack name ++ "'"
else do
unless quiet $ putStrLn $ "No such entry: '" ++ T.unpack name ++ "'"
exitFailure
ConfigList -> do
let sorted = getSortedEntries cfg
unless quiet $ do
if null sorted
then putStrLn "No entries configured"
else do
putStrLn "Configured jump entries:"
putStrLn ""
forM_ sorted $ \(name, entry) -> do
let desc = fromMaybe "" (description entry)
putStrLn $ " " ++ padRight 15 (T.unpack name)
++ " -> " ++ padRight 30 (path entry)
++ if T.null desc then "" else " # " ++ T.unpack desc
ConfigSetDefault path -> do
expanded <- expandPath path
exists <- doesDirectoryExist expanded
unless exists $ do
unless quiet $ putStrLn $ "Warning: Directory does not exist: " ++ expanded
let newCfg = cfg { defaultPath = Just path }
saveConfig newCfg
unless quiet $ putStrLn $ "Set default path to: " ++ path
ConfigSetEditor cmd -> do
let newCfg = cfg { editor = Just cmd }
saveConfig newCfg
unless quiet $ putStrLn $ "Set editor to: " ++ cmd
ConfigSetFileManager cmd -> do
let newCfg = cfg { fileManager = Just cmd }
saveConfig newCfg
unless quiet $ putStrLn $ "Set file manager to: " ++ cmd
ConfigExport path -> do
saveConfigTo path cfg
unless quiet $ putStrLn $ "Config exported to: " ++ path
ConfigImport path merge -> do
imported <- loadConfigFrom path
let merged = mergeConfigs cfg imported merge
saveConfig merged
unless quiet $
if merge
then putStrLn "Config imported and merged successfully"
else putStrLn "Config imported (replaced existing)"
ConfigEdit -> do
let ed = fromMaybe (defaultEditor os) (editor cfg)
configPath <- getConfigPath
_ <- spawnCommand (ed ++ " " ++ show configPath) >>= waitForProcess
return ()
ConfigShow -> do
configPath <- getConfigPath
unless quiet $ do
putStrLn $ "Config location: " ++ configPath
putStrLn $ "Version: " ++ T.unpack (version cfg)
putStrLn $ "Entries: " ++ show (M.size $ entries cfg)
putStrLn $ "Default path: " ++ fromMaybe "(not set)" (defaultPath cfg)
putStrLn $ "Editor: " ++ fromMaybe "(not set)" (editor cfg)
putStrLn $ "File manager: " ++ fromMaybe "(auto-detect)" (fileManager cfg)
-- | 获取默认编辑器
defaultEditor :: String -> String
defaultEditor platform = case platform of
"darwin" -> "open -t"
"mingw32" -> "notepad"
"mingw64" -> "notepad"
_ -> "vi"
-- | 打印 shell 集成脚本
printShellIntegration :: IO ()
printShellIntegration = do
putStrLn $ shellScript os
-- | 获取对应 shell 的集成脚本
shellScript :: String -> String
shellScript platform = case platform of
"mingw32" -> windowsPowerShellScript
"mingw64" -> windowsPowerShellScript
"cygwin" -> bashScript
"darwin" -> bashScript
_ -> bashScript
-- | Bash/Zsh 集成脚本
bashScript :: String
bashScript = intercalate "\n"
[ "# QuickJump Shell Integration for Bash/Zsh"
, "# Add this to your shell profile (.bashrc, .zshrc, etc.)"
, "#"
, "# eval \"$(quickjump shell-integration)\""
, ""
, "# Bash/Zsh function for directory jumping"
, "qj() {"
, " local output=$(quickjump jump \"$1\")"
, " if [[ $output == cd* ]]; then"
, " eval \"$output\""
, " else"
, " echo \"$output\""
, " fi"
, "}"
, ""
, "# Quick open function"
, "qo() {"
, " quickjump quick \"$1\""
, "}"
, ""
, "# Quiet mode function"
, "qjq() {"
, " quickjump --quiet jump \"$1\""
, "}"
, ""
, "# Tab completion for bash"
, "if [ -n \"$BASH_VERSION\" ]; then"
, " _qj_complete() {"
, " local cur=\"${COMP_WORDS[COMP_CWORD]}\""
, " local entries=$(quickjump config list 2>/dev/null | grep '^ ' | awk '{print $1}')"
, " COMPREPLY=($(compgen -W \"$entries\" -- \"$cur\"))"
, " }"
, " complete -F _qj_complete qj"
, " complete -F _qj_complete qjq"
, "fi"
, ""
, "# Tab completion for zsh"
, "if [ -n \"$ZSH_VERSION\" ]; then"
, " _qj_complete() {"
, " local -a entries"
, " entries=(${(f)\"$(quickjump config list 2>/dev/null | grep '^ ' | awk '{print $1}')\"})"
, " _describe 'jump targets' entries"
, " }"
, " compdef _qj_complete qj"
, " compdef _qj_complete qjq"
, "fi"
]
-- | Windows PowerShell 集成脚本
windowsPowerShellScript :: String
windowsPowerShellScript = intercalate "\n"
[ "# QuickJump Shell Integration for PowerShell"
, "# Add this to your PowerShell profile ($PROFILE)"
, "#"
, "# To edit your profile: notepad $PROFILE"
, "#"
, "# . (quickjump shell-integration | Out-String)"
, ""
, "# Function for directory jumping"
, "function qj {"
, " param([string]$name)"
, " $output = quickjump jump $name"
, " if ($output -like 'cd *') {"
, " # Remove 'cd ' prefix and execute"
, " $path = $output -replace '^cd \"?([^\"\"]*)\"?$', '$1'"
, " Set-Location $path"
, " } else {"
, " Write-Output $output"
, " }"
, "}"
, ""
, "# Quiet mode function"
, "function qjq {"
, " param([string]$name)"
, " $output = quickjump --quiet jump $name"
, " if ($output -like 'cd *') {"
, " $path = $output -replace '^cd \"?([^\"\"]*)\"?$', '$1'"
, " Set-Location $path"
, " }"
, "}"
, ""
, "# Quick open function"
, "function qo {"
, " param([string]$name)"
, " quickjump quick $name"
, "}"
, ""
, "# Tab completion"
, "Register-ArgumentCompleter -CommandName qj -ScriptBlock {"
, " param($commandName, $parameterName, $wordToComplete, $commandAst, $fakeBoundParameter)"
, " $entries = quickjump config list 2>$null | Select-String '^ ' | ForEach-Object {"
, " $_.ToString().Trim().Split()[0]"
, " }"
, " $entries | Where-Object { $_ -like \"$wordToComplete*\" } | ForEach-Object {"
, " [System.Management.Automation.CompletionResult]::new($_, $_, 'ParameterValue', $_)"
, " }"
, "}"
, ""
, "Register-ArgumentCompleter -CommandName qjq -ScriptBlock {"
, " param($commandName, $parameterName, $wordToComplete, $commandAst, $fakeBoundParameter)"
, " $entries = quickjump config list 2>$null | Select-String '^ ' | ForEach-Object {"
, " $_.ToString().Trim().Split()[0]"
, " }"
, " $entries | Where-Object { $_ -like \"$wordToComplete*\" } | ForEach-Object {"
, " [System.Management.Automation.CompletionResult]::new($_, $_, 'ParameterValue', $_)"
, " }"
, "}"
]

168
app/Config.hs Normal file
View File

@@ -0,0 +1,168 @@
{-# LANGUAGE OverloadedStrings #-}
module Config
( getConfigPath
, loadConfig
, loadConfigFrom
, saveConfig
, saveConfigTo
, ensureConfigExists
, findEntry
, expandPath
, getSortedEntries
, mergeConfigs
) where
import Control.Exception (catch, throwIO)
import Control.Monad (unless, when)
import Data.Aeson (eitherDecode, encode)
import Data.Aeson.Encode.Pretty (encodePretty)
import Data.Bifunctor (first)
import Data.List (sortOn)
import Data.Map (Map)
import qualified Data.Map as M
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.ByteString.Lazy as BL
import System.Directory (createDirectoryIfMissing, doesFileExist,
getHomeDirectory)
import System.Environment (lookupEnv)
import System.FilePath ((</>), takeDirectory)
import System.IO.Error (isDoesNotExistError)
import Types
-- | 获取配置文件路径
getConfigPath :: IO FilePath
getConfigPath = do
-- 首先检查环境变量
mEnvPath <- lookupEnv "QUICKJUMP_CONFIG"
case mEnvPath of
Just path -> return path
Nothing -> do
-- 默认使用 XDG 配置目录
xdgConfig <- lookupEnv "XDG_CONFIG_HOME"
configDir <- case xdgConfig of
Just dir -> return dir
Nothing -> do
home <- getHomeDirectory
return $ home </> ".config"
return $ configDir </> "quickjump" </> "config.json"
-- | 展开路径中的 ~ 和环境变量
expandPath :: FilePath -> IO FilePath
expandPath path = do
-- 首先处理 ~ 展开
expanded1 <- if take 1 path == "~"
then do
home <- getHomeDirectory
return $ home </> drop 2 path
else return path
-- 然后处理环境变量(支持 Unix $VAR 和 Windows %VAR% 格式)
expandEnvVars expanded1
-- | 展开环境变量
expandEnvVars :: FilePath -> IO FilePath
expandEnvVars path = do
-- 处理 Unix 风格的环境变量 $VAR
let expandUnixVars s = case s of
'$':'{':rest ->
case break (=='}') rest of
(var, '}':remaining) -> do
mval <- lookupEnv var
case mval of
Just val -> (val ++) <$> expandEnvVars remaining
Nothing -> (("${" ++ var ++ "}") ++) <$> expandEnvVars remaining
_ -> ('$':) <$> expandEnvVars rest
'$':rest ->
case span (\c -> isAlphaNum c || c == '_') rest of
(var, remaining) -> do
mval <- lookupEnv var
case mval of
Just val -> (val ++) <$> expandEnvVars remaining
Nothing -> (('$' : var) ++) <$> expandEnvVars remaining
c:cs -> (c:) <$> expandEnvVars cs
[] -> return []
-- 处理 Windows 风格的环境变量 %VAR%
let expandWindowsVars s = case s of
'%':rest ->
case break (=='%') rest of
(var, '%':remaining) -> do
mval <- lookupEnv var
case mval of
Just val -> (val ++) <$> expandEnvVars remaining
Nothing -> (('%' : var ++ "%") ++) <$> expandEnvVars remaining
_ -> ('%':) <$> expandEnvVars rest
c:cs -> (c:) <$> expandEnvVars cs
[] -> return []
-- 根据操作系统选择展开方式
if '%' `elem` path
then expandWindowsVars path
else expandUnixVars path
where
isAlphaNum c = (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') || (c >= '0' && c <= '9')
-- | 确保配置文件存在(如果不存在则创建默认配置)
ensureConfigExists :: IO Config
ensureConfigExists = do
configPath <- getConfigPath
exists <- doesFileExist configPath
if exists
then loadConfig
else do
putStrLn $ "Config not found, creating default at: " ++ configPath
createDirectoryIfMissing True (takeDirectory configPath)
saveConfig defaultConfig
return defaultConfig
-- | 加载配置
loadConfig :: IO Config
loadConfig = do
configPath <- getConfigPath
loadConfigFrom configPath
-- | 从指定路径加载配置
loadConfigFrom :: FilePath -> IO Config
loadConfigFrom path = do
expanded <- expandPath path
result <- catch
(Right <$> BL.readFile expanded)
(\e -> if isDoesNotExistError e
then return $ Left $ "Config file not found: " ++ expanded
else throwIO e)
case result of
Left err -> error err
Right bs ->
case eitherDecode bs of
Left err -> error $ "Failed to parse config: " ++ err
Right cfg -> return cfg
-- | 保存配置
saveConfig :: Config -> IO ()
saveConfig cfg = do
configPath <- getConfigPath
saveConfigTo configPath cfg
-- | 保存配置到指定路径
saveConfigTo :: FilePath -> Config -> IO ()
saveConfigTo path cfg = do
expanded <- expandPath path
createDirectoryIfMissing True (takeDirectory expanded)
BL.writeFile expanded (encodePretty cfg)
-- | 查找条目
findEntry :: Text -> Config -> Maybe JumpEntry
findEntry name cfg = M.lookup name (entries cfg)
-- | 获取按优先级排序的条目列表
getSortedEntries :: Config -> [(Text, JumpEntry)]
getSortedEntries cfg =
sortOn (priority . snd) $ M.toList (entries cfg)
-- | 合并两个配置(用于导入)
mergeConfigs :: Config -> Config -> Bool -> Config
mergeConfigs base new shouldMerge =
if shouldMerge
then base { entries = M.union (entries new) (entries base) }
else new

190
app/Main.hs Normal file
View File

@@ -0,0 +1,190 @@
{-# LANGUAGE OverloadedStrings #-}
module Main where
-- import Data.Text (Text)
-- import qualified Data.Text as T
import Options.Applicative
import System.Environment (getArgs, withArgs)
-- import System.IO (hPutStrLn, stderr)
import Commands
import Types
-- | 主函数
main :: IO ()
main = do
args <- getArgs
-- 如果没有参数,显示帮助
if null args
then withArgs ["--help"] runParser
else runParser
where
runParser = do
cmd <- execParser opts
runCommand cmd
opts = info (helper <*> versionOption <*> commandParser)
( fullDesc
<> progDesc "QuickJump - Fast directory navigation tool"
<> header "quickjump - A command line tool for quick directory jumping" )
-- | 静默模式选项
quietOption :: Parser Bool
quietOption = switch
( long "quiet"
<> short 'q'
<> help "Suppress output messages (quiet mode)" )
-- | 版本选项
versionOption :: Parser (a -> a)
versionOption = infoOption "quickjump 0.3.0.1"
( long "version"
<> short 'v'
<> help "Show version information" )
-- | 主命令解析器
commandParser :: Parser Command
commandParser = subparser
( command "jump" (info jumpParser
( progDesc "Jump to a configured directory" ))
<> command "j" (info jumpParser
( progDesc "Alias for jump" ))
<> command "quick" (info quickParser
( progDesc "Quick open a directory" ))
<> command "k" (info quickParser
( progDesc "Alias for quick" ))
<> command "config" (info configParser
( progDesc "Manage configuration" ))
<> command "c" (info configParser
( progDesc "Alias for config" ))
<> command "shell-integration" (info shellIntegrationParser
( progDesc "Output shell integration script" ))
)
<|> jumpParser -- 默认命令是 jump
-- | 跳转命令解析器
jumpParser :: Parser Command
jumpParser = (Jump <$> argument str
( metavar "NAME"
<> help "Name of the jump target" ))
<*> quietOption
<|> (JumpInteractive <$> flag' False
( long "interactive"
<> short 'i'
<> help "Interactive mode - select from list" ))
-- | 快速命令解析器
quickParser :: Parser Command
quickParser = (Quick <$> subparser
( command "open" (info (QuickOpen <$> argument str (metavar "NAME"))
( progDesc "Open a configured directory" ))
<> command "list" (info (pure QuickList)
( progDesc "List all quick access targets" ))
<> command "default" (info (pure QuickDefault)
( progDesc "Open the default directory" ))
)
<*> quietOption)
<|> (Quick <$> (QuickOpen <$> strOption
( long "open"
<> short 'o'
<> metavar "NAME"
<> help "Open the specified target" ))
<*> quietOption)
<|> (Quick <$> (QuickOpenPath <$> strOption
( long "path"
<> short 'p'
<> metavar "PATH"
<> help "Open the specified path" ))
<*> quietOption)
<|> (Quick <$> flag' QuickList
( long "list"
<> short 'l'
<> help "List all targets" )
<*> quietOption)
<|> (Quick <$> flag' QuickDefault
( long "default"
<> short 'd'
<> help "Open default directory" )
<*> quietOption)
<|> (Quick <$> (QuickOpen <$> argument str (metavar "NAME" <> help "Target name or path"))
<*> quietOption)
-- | 配置命令解析器
configParser :: Parser Command
configParser = ConfigCmd <$> subparser
( command "add" (info addParser
( progDesc "Add a new jump entry" ))
<> command "remove" (info removeParser
( progDesc "Remove a jump entry" ))
<> command "rm" (info removeParser
( progDesc "Alias for remove" ))
<> command "list" (info (pure ConfigList)
( progDesc "List all entries" ))
<> command "ls" (info (pure ConfigList)
( progDesc "Alias for list" ))
<> command "set-default" (info setDefaultParser
( progDesc "Set the default path" ))
<> command "set-editor" (info setEditorParser
( progDesc "Set the preferred editor" ))
<> command "set-file-manager" (info setFileManagerParser
( progDesc "Set the preferred file manager" ))
<> command "export" (info exportParser
( progDesc "Export configuration to file" ))
<> command "import" (info importParser
( progDesc "Import configuration from file" ))
<> command "edit" (info (pure ConfigEdit)
( progDesc "Edit configuration with editor" ))
<> command "show" (info (pure ConfigShow)
( progDesc "Show current configuration" ))
)
<*> quietOption
-- | 添加条目解析器
addParser :: Parser ConfigAction
addParser = ConfigAdd
<$> argument str (metavar "NAME" <> help "Entry name")
<*> argument str (metavar "PATH" <> help "Directory path")
<*> optional (strOption
( long "description"
<> short 'd'
<> metavar "DESC"
<> help "Optional description" ))
-- | 删除条目解析器
removeParser :: Parser ConfigAction
removeParser = ConfigRemove
<$> argument str (metavar "NAME" <> help "Entry name to remove")
-- | 设置默认路径解析器
setDefaultParser :: Parser ConfigAction
setDefaultParser = ConfigSetDefault
<$> argument str (metavar "PATH" <> help "Default directory path")
-- | 设置编辑器解析器
setEditorParser :: Parser ConfigAction
setEditorParser = ConfigSetEditor
<$> argument str (metavar "COMMAND" <> help "Editor command")
-- | 设置文件管理器解析器
setFileManagerParser :: Parser ConfigAction
setFileManagerParser = ConfigSetFileManager
<$> argument str (metavar "COMMAND" <> help "File manager command")
-- | 导出配置解析器
exportParser :: Parser ConfigAction
exportParser = ConfigExport
<$> argument str (metavar "FILE" <> help "Export file path")
-- | 导入配置解析器
importParser :: Parser ConfigAction
importParser = ConfigImport
<$> argument str (metavar "FILE" <> help "Import file path")
<*> switch
( long "merge"
<> short 'm'
<> help "Merge with existing config instead of replacing" )
-- | Shell 集成解析器
shellIntegrationParser :: Parser Command
shellIntegrationParser = pure ShellIntegration

132
app/Types.hs Normal file
View File

@@ -0,0 +1,132 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
module Types
( Config(..)
, JumpEntry(..)
, Command(..)
, QuickAction(..)
, ConfigAction(..)
, defaultConfig
, emptyConfig
) where
import Data.Aeson
import Data.Map (Map)
import qualified Data.Map as M
import Data.Text (Text)
import GHC.Generics
-- | 单个跳转条目
data JumpEntry = JumpEntry
{ path :: FilePath -- ^ 目标路径
, description :: Maybe Text -- ^ 可选描述
, priority :: Int -- ^ 优先级(数字越小越优先)
} deriving (Show, Eq, Generic)
instance ToJSON JumpEntry where
toJSON entry = object
[ "path" .= path entry
, "description" .= description entry
, "priority" .= priority entry
]
instance FromJSON JumpEntry where
parseJSON = withObject "JumpEntry" $ \v -> JumpEntry
<$> v .: "path"
<*> v .:? "description"
<*> v .:? "priority" .!= 100
-- | 配置文件结构
data Config = Config
{ version :: Text -- ^ 配置版本
, entries :: Map Text JumpEntry -- ^ 命名跳转条目
, defaultPath :: Maybe FilePath -- ^ 默认打开路径
, editor :: Maybe FilePath -- ^ 首选编辑器
, fileManager :: Maybe FilePath -- ^ 首选文件管理器
} deriving (Show, Eq, Generic)
instance ToJSON Config where
toJSON cfg = object
[ "version" .= version cfg
, "entries" .= entries cfg
, "default_path" .= defaultPath cfg
, "editor" .= editor cfg
, "file_manager" .= fileManager cfg
]
instance FromJSON Config where
parseJSON = withObject "Config" $ \v -> Config
<$> v .:? "version" .!= "1.0"
<*> v .:? "entries" .!= M.empty
<*> v .:? "default_path"
<*> v .:? "editor"
<*> v .:? "file_manager"
-- | 快速操作类型
data QuickAction
= QuickOpen Text -- ^ 打开配置中的指定条目
| QuickOpenPath FilePath -- ^ 打开指定路径
| QuickList -- ^ 列出所有快速条目
| QuickDefault -- ^ 打开默认路径
deriving (Show, Eq)
-- | 配置操作类型
data ConfigAction
= ConfigAdd Text FilePath (Maybe Text) -- ^ 添加条目: 名称 路径 [描述]
| ConfigRemove Text -- ^ 删除条目
| ConfigList -- ^ 列出所有条目
| ConfigSetDefault FilePath -- ^ 设置默认路径
| ConfigSetEditor FilePath -- ^ 设置编辑器
| ConfigSetFileManager FilePath -- ^ 设置文件管理器
| ConfigExport FilePath -- ^ 导出配置到文件
| ConfigImport FilePath Bool -- ^ 导入配置 (文件路径, 是否合并)
| ConfigEdit -- ^ 用编辑器打开配置文件
| ConfigShow -- ^ 显示当前配置
deriving (Show, Eq)
-- | 主命令类型
data Command
= Jump Text Bool -- ^ 跳转到指定条目 (名称, 是否静默)
| JumpInteractive Bool -- ^ 交互式选择跳转 (是否静默)
| Quick QuickAction Bool -- ^ 快速操作 (操作, 是否静默)
| ConfigCmd ConfigAction Bool -- ^ 配置操作 (操作, 是否静默)
| ShellIntegration -- ^ 输出 shell 集成脚本
| Version -- ^ 显示版本
deriving (Show, Eq)
-- | 空配置
emptyConfig :: Config
emptyConfig = Config
{ version = "1.0"
, entries = M.empty
, defaultPath = Nothing
, editor = Nothing
, fileManager = Nothing
}
-- | 默认配置(带示例)
defaultConfig :: Config
defaultConfig = Config
{ version = "1.0"
, entries = M.fromList
[ ("home", JumpEntry
{ path = "~"
, description = Just "Home directory"
, priority = 1
})
, ("docs", JumpEntry
{ path = "~/Documents"
, description = Just "Documents folder"
, priority = 2
})
, ("downloads", JumpEntry
{ path = "~/Downloads"
, description = Just "Downloads folder"
, priority = 3
})
]
, defaultPath = Just "~"
, editor = Just "vim"
, fileManager = Nothing
}

88
app/Utils.hs Normal file
View File

@@ -0,0 +1,88 @@
{-# LANGUAGE OverloadedStrings #-}
module Utils
( padRight
, commandExists
, formatTable
, truncatePath
) where
import Control.Exception (catch)
import Data.List (intercalate, transpose)
import System.Directory (findExecutable)
import System.IO.Error (isDoesNotExistError)
-- | 右填充字符串到指定长度
padRight :: Int -> String -> String
padRight n s = s ++ replicate (max 0 (n - length s)) ' '
-- | 左填充字符串到指定长度
padLeft :: Int -> String -> String
padLeft n s = replicate (max 0 (n - length s)) ' ' ++ s
-- | 检查命令是否存在
commandExists :: String -> IO Bool
commandExists cmd = do
result <- findExecutable cmd
return $ case result of
Just _ -> True
Nothing -> False
-- | 截断路径显示
truncatePath :: Int -> String -> String
truncatePath maxLen path
| length path <= maxLen = path
| otherwise = "..." ++ drop (length path - maxLen + 3) path
-- | 格式化表格
data TableCell = TableCell String Int -- ^ 内容和对齐宽度
formatTable :: [[String]] -> String
formatTable rows =
let -- 计算每列的最大宽度
colWidths = map maximum $ transpose
[ map length row | row <- rows ]
-- 格式化每一行
formatRow row = intercalate " "
[ padRight w cell | (cell, w) <- zip row colWidths ]
in intercalate "\n" $ map formatRow rows
-- | 安全的读取文件
safeReadFile :: FilePath -> IO (Maybe String)
safeReadFile path = do
result <- catch
(Just <$> readFile path)
(\e -> if isDoesNotExistError e then return Nothing else return Nothing)
return result
-- | 字符串居中
center :: Int -> String -> String
center width s =
let padding = max 0 (width - length s)
leftPad = padding `div` 2
rightPad = padding - leftPad
in replicate leftPad ' ' ++ s ++ replicate rightPad ' '
-- | 重复字符串
repeatString :: Int -> String -> String
repeatString n = concat . replicate n
-- | 高亮文本(终端颜色)
highlight :: String -> String
highlight s = "\ESC[1m" ++ s ++ "\ESC[0m"
-- | 绿色文本
green :: String -> String
green s = "\ESC[32m" ++ s ++ "\ESC[0m"
-- | 黄色文本
yellow :: String -> String
yellow s = "\ESC[33m" ++ s ++ "\ESC[0m"
-- | 红色文本
red :: String -> String
red s = "\ESC[31m" ++ s ++ "\ESC[0m"
-- | 蓝色文本
blue :: String -> String
blue s = "\ESC[34m" ++ s ++ "\ESC[0m"