diff --git a/Network/CommandList.hs b/Network/CommandList.hs --- a/Network/CommandList.hs +++ b/Network/CommandList.hs @@ -1,9 +1,10 @@ module Network.CommandList ( CommandList , defaultCommandList +, getAction +, getHelp +, getComp -, const2 -, helpFTP , quitFTP , systemFTP , pwdFTP @@ -23,6 +24,10 @@ , readBy , getEnv +, const2 +, compRemoteFile +, compLs +, filenameCompletionFunction ) where import Network.FTP.Client (FTPConnection, getbinary, putbinary, uploadbinary, downloadbinary, @@ -34,46 +39,54 @@ import System.IO.Error (isUserError) import System.Posix.Temp (mkstemp) import Data.Maybe (fromJust) +import Data.List (isPrefixOf) import Control.Exception (catchJust, ioErrors, ioError, bracketOnError) +import System.Console.Readline + type Action = FTPConnection -> [String] -> IO Bool -type CommandList = [(String, Action)] +type Command = (Action, String, FTPConnection -> String -> IO [String]) +type CommandList = [(String, Command)] +getAction :: Command -> Action +getAction (act, _, _) = act +getHelp :: Command -> String +getHelp (_, help, _) = help +getComp :: Command -> FTPConnection -> String -> IO [String] +getComp (_, _, comp) = comp + defaultCommandList :: CommandList defaultCommandList = [ - ("?", helpFTP) - , ("q", quitFTP) - , ("quit", quitFTP) - , ("exit", quitFTP) - , ("bye", quitFTP) - , ("!", systemFTP) - , ("pwd", pwdFTP) - , ("ls", \h args -> case args of - ("-l":args_) -> directoryFTP h args_ - _ -> listFTP h args) - , ("cd", changeDirectoryFTP) - , ("lcd", changeDirectoryLocal) - , ("put", putFileFTP) - , ("get", getFileFTP) - , ("cat", showFileFTP) - , ("rm", removeFileFTP) - , ("mkdir", makeDirectoryFTP) - , ("rmdir", removeDirectoryFTP) - , ("mv", moveFileFTP) - , ("cp", copyFileFTP) - , ("edit", editBy $ \fn -> do edt <- catch (getEnv "EDITOR") (const $ return "vi") - return $ edt ++ " " ++ fn) - , ("show", readBy $ \fn -> do pgr <- catch (getEnv "PAGER") (const $ return "less") - return $ pgr ++ " " ++ fn) + ("q", (quitFTP, "exit from yjftp", const2 $ return [])) + , ("quit", (quitFTP, "exit from yjftp", const2 $ return [])) + , ("exit", (quitFTP, "exit from yjftp", const2 $ return [])) + , ("bye", (quitFTP, "exit from yjftp", const2 $ return [])) + , ("!", (systemFTP, "run system command", const2 $ return [])) + , ("pwd", (pwdFTP, "print where directory you are at", const2 $ return [])) + , ("ls", (\h args -> case args of + ("-l":args_) -> directoryFTP h args_ + _ -> listFTP h args , + "list directory contents\n\toption -l list detail of contents", + compLs)) + , ("cd", (changeDirectoryFTP, "change directory in remote", compRemoteFile)) + , ("lcd", (changeDirectoryLocal, "change directory in local", const filenameCompletionFunction)) + , ("put", (putFileFTP, "upload file", const filenameCompletionFunction)) + , ("get", (getFileFTP, "download file", compRemoteFile)) + , ("cat", (showFileFTP, "show remote file", compRemoteFile)) + , ("rm", (removeFileFTP, "delete remote file", compRemoteFile)) + , ("mkdir", (makeDirectoryFTP, "make directory in remote", const2 $ return [])) + , ("rmdir", (removeDirectoryFTP, "delete directory in remote", compRemoteFile)) + , ("mv", (moveFileFTP, "move/change name file in remote", compRemoteFile)) + , ("cp", (copyFileFTP, "copy file in remote", compRemoteFile)) + , ("edit", (editBy $ \fn -> do edt <- catch (getEnv "EDITOR") (const $ return "vi") + return $ edt ++ " " ++ fn , "edit by $EDITOR", compRemoteFile)) + , ("show", (readBy $ \fn -> do pgr <- catch (getEnv "PAGER") (const $ return "less") + return $ pgr ++ " " ++ fn , "show by $PAGER", compRemoteFile)) ] const2 :: a -> b -> c -> a const2 = const . const -helpFTP :: Action -helpFTP = const2 $ putStr helpStr >> return True - where helpStr = unlines [ "ls: list directory contents" , "q : quit" ] - quitFTP :: Action quitFTP = const2 $ return False @@ -168,3 +181,40 @@ mkTempFile fn = do tmpDir <- getTemporaryDirectory mkstemp $ tmpDir ++ "/" ++ fn ++ "-XXXXXX" + +compLs :: FTPConnection -> String -> IO [String] +compLs h str + | elem '/' str = do + let d = reverse $ dropWhile (/='/') $ reverse str + fns <- myNlst h $ Just d + return $ addExcess $ filter (isPrefixOf str) $ "-l" : map (d++) fns + | otherwise = do + fns <- myNlst h Nothing + return $ addExcess $ filter (isPrefixOf str) $ "-l" : fns + +compRemoteFile :: FTPConnection -> String -> IO [String] +compRemoteFile h str + | elem '/' str = do + let d = reverse $ dropWhile (/='/') $ reverse str + fns <- myNlst h $ Just d + return $ addExcess $ filter (isPrefixOf str) $ map (d++) fns + | otherwise = do + fns <- myNlst h Nothing + return $ addExcess $ filter (isPrefixOf str) fns + +addExcess :: [String] -> [String] +addExcess [""] = [""] +addExcess [fp] + | last fp == '/' = [fp, fp++" "] + | otherwise = [fp] +addExcess fps = fps + +myNlst :: FTPConnection -> Maybe String -> IO [String] +myNlst h str = do + cnt <- dir h str + return $ map mkRet cnt + where + mkRet ('d':rest) = last (words rest) ++ "/" + mkRet ('-':rest) = last (words rest) + mkRet ('l':rest) = last (words rest) + mkRet _ = error "myNlst error" diff --git a/Network/Yjftp.hs b/Network/Yjftp.hs --- a/Network/Yjftp.hs +++ b/Network/Yjftp.hs @@ -11,7 +11,6 @@ import System.Directory (setCurrentDirectory) import System.Exit (exitFailure) import System.Environment (getArgs) --- import System.Cmd (system) import System.Posix.IO (stdOutput) import System.Posix.Terminal(getTerminalAttributes, setTerminalAttributes, withoutMode, TerminalState(Immediately), TerminalMode(EnableEcho)) @@ -19,7 +18,9 @@ import Control.Monad (when, unless) import Control.Applicative ((<$>)) import Prelude hiding (catch) -import Data.Char (isSpace, isAlphaNum, isAscii) +import Data.Char (isSpace, isAscii) +import Data.List (isPrefixOf) +import System.Console.Readline runYjftp :: CommandList -> IO () runYjftp cl = do @@ -31,13 +32,16 @@ uploadbinary h (basename s) >> return () (Just Get, Just s) -> downloadbinary h s >> return () (Nothing, _) -> do + setCompletionEntryFunction $ Just $ myCompFunc h cl doWhile_ $ do - putStr "> " hFlush stdout - cmdln <- getLine - case myWords cmdln of - [] -> return True - (cmd:args) -> catch (executeCommand cl h cmd args) ((>> return True) . print) + cmdln <- readline "> " + maybe (return ()) (addHistory) cmdln + case myWords <$> cmdln of + Nothing -> return False + Just [] -> return True + Just ["?"] -> mapM (\cmd -> putStr $ fst cmd ++ ":\t" ++ getHelp (snd cmd) ++ "\n") cl >> return True + Just (cmd:args) -> catch (executeCommand cl h cmd args) ((>> return True) . print) _ -> error "bad argument (put/get)" quit h return () @@ -76,7 +80,7 @@ executeCommand :: CommandList -> FTPConnection -> String -> [String] -> IO Bool executeCommand cl h cmd args = maybe (hPutStrLn stderr ("No such command: " ++ cmd) >> return True) - (\c -> c h args) (lookup cmd cl) + (\c -> (getAction c) h args) (lookup cmd cl) processArgs :: IO (Maybe CLAction, Maybe String, Maybe String, Maybe String, Maybe String, Maybe String) @@ -109,6 +113,18 @@ psswd <- getLineP return psswd +myCompFunc :: FTPConnection -> CommandList -> String -> IO [String] +myCompFunc h cl str = do + bf <- getLineBuffer + case bf of + "" -> return $ filter (isPrefixOf str) $ map fst cl + _ | and (map (not . isSpace) bf) && head bf /= '!' + -> return $ filter (isPrefixOf str) $ map fst cl + | otherwise + -> case getComp <$> lookup (head $ words bf) cl of + Nothing -> return [] + Just f -> f h str + doWhile_ :: IO Bool -> IO () doWhile_ act = do b <- act if b then doWhile_ act @@ -173,11 +189,11 @@ | otherwise = a : dropOptNArg opt as myWords :: String -> [String] -myWords "" = [] +myWords "" = [] +myWords ('!':cs) = "!" : myWords cs myWords str@(c:cs) - | isAlphaNum c || c == '_' = takeWhile isWord str : myWords (dropWhile isWord str) - | isSpace c = myWords cs - | isSym c = takeWhile isSym str : myWords (dropWhile isSym str) - | otherwise = error "myWords: maybe your input is not askii" - where isWord c_ = isAlphaNum c_ || elem c_ [ '_', '.', '/' ] - isSym c_ = isAscii c_ && not (isAlphaNum c_) && not (isSpace c_) + | isWordHead c = takeWhile isNotSpaceAscii str : myWords (dropWhile isNotSpaceAscii str) + | isSpace c = myWords cs + | otherwise = error "myWords: maybe your input is not askii" + where isNotSpaceAscii c_ = isAscii c_ && not (isSpace c_) + isWordHead c_ = isNotSpaceAscii c_ && (c_ /= '!') diff --git a/yjftp.cabal b/yjftp.cabal --- a/yjftp.cabal +++ b/yjftp.cabal @@ -1,5 +1,5 @@ Name: yjftp -Version: 0.3.1 +Version: 0.3.2 License: GPL License-file: LICENSE Author: Yoshikuni Jujo @@ -26,7 +26,7 @@ > yjftp get srvr.address/filepath [user_name] [-p password] Stability: experimental Homepage: http://homepage3.nifty.com/salamander/second/projects/yjftp/index.xhtml -Package-Url: http://homepage3.nifty.com/salamander/second/portage/distfiles/yjftp-0.3.tar.gz +Package-Url: http://homepage3.nifty.com/salamander/second/portage/distfiles/yjftp-0.3.2.tar.gz Cabal-Version: >= 1.2 Build-Type: Simple Tested-With: GHC @@ -36,7 +36,7 @@ Library GHC-Options: -Wall - Build-Depends: base, unix, directory, process, ftphs + Build-Depends: base, unix, directory, process, ftphs, readline Exposed-Modules: Network.Yjftp Other-Modules: Network.CommandList diff --git a/yjftp.hs b/yjftp.hs --- a/yjftp.hs +++ b/yjftp.hs @@ -4,30 +4,31 @@ myCommandList :: CommandList myCommandList = [ - ("?", helpFTP) - , ("q", quitFTP) - , ("quit", quitFTP) - , ("exit", quitFTP) - , ("bye", quitFTP) - , ("!", systemFTP) - , ("pwd", pwdFTP) - , ("ls", \h args -> case args of - ("-l":args_) -> directoryFTP h args_ - _ -> listFTP h args) - , ("cd", changeDirectoryFTP) - , ("lcd", changeDirectoryLocal) - , ("put", putFileFTP) - , ("get", getFileFTP) - , ("cat", showFileFTP) - , ("rm", removeFileFTP) - , ("mkdir", makeDirectoryFTP) - , ("rmdir", removeDirectoryFTP) - , ("mv", moveFileFTP) - , ("cp", copyFileFTP) - , ("edit", editBy $ \fn -> do edt <- catch (getEnv "EDITOR") (const $ return "vi") - return $ edt ++ " " ++ fn) - , ("show", readBy $ \fn -> do pgr <- catch (getEnv "PAGER") (const $ return "less") - return $ pgr ++ " " ++ fn) + ("q", (quitFTP, "exit from yjftp", const2 $ return [])) + , ("quit", (quitFTP, "exit from yjftp", const2 $ return [])) + , ("exit", (quitFTP, "exit from yjftp", const2 $ return [])) + , ("bye", (quitFTP, "exit from yjftp", const2 $ return [])) + , ("!", (systemFTP, "run system command", const2 $ return [])) + , ("pwd", (pwdFTP, "print where directory you are at", const2 $ return [])) + , ("ls", (\h args -> case args of + ("-l":args_) -> directoryFTP h args_ + _ -> listFTP h args , + "list directory contents\n\toption -l list detail of contents", + compLs)) + , ("cd", (changeDirectoryFTP, "change directory in remote", compRemoteFile)) + , ("lcd", (changeDirectoryLocal, "change directory in local", const filenameCompletionFunction)) + , ("put", (putFileFTP, "upload file", const filenameCompletionFunction)) + , ("get", (getFileFTP, "download file", compRemoteFile)) + , ("cat", (showFileFTP, "show remote file", compRemoteFile)) + , ("rm", (removeFileFTP, "delete remote file", compRemoteFile)) + , ("mkdir", (makeDirectoryFTP, "make directory in remote", const2 $ return [])) + , ("rmdir", (removeDirectoryFTP, "delete directory in remote", compRemoteFile)) + , ("mv", (moveFileFTP, "move/change name file in remote", compRemoteFile)) + , ("cp", (copyFileFTP, "copy file in remote", compRemoteFile)) + , ("edit", (editBy $ \fn -> do edt <- catch (getEnv "EDITOR") (const $ return "vi") + return $ edt ++ " " ++ fn , "edit by $EDITOR", compRemoteFile)) + , ("show", (readBy $ \fn -> do pgr <- catch (getEnv "PAGER") (const $ return "less") + return $ pgr ++ " " ++ fn , "show by $PAGER", compRemoteFile)) ] main :: IO ()