summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorYoshikuniJujo <>2008-10-16 09:30:04 (GMT)
committerLuite Stegeman <luite@luite.com>2008-10-16 09:30:04 (GMT)
commitc04a8296c2597f72cc239fd7358b10ada64a7ec9 (patch)
tree0bd0984989fa2e13349d54eb28a49d5f89cdbbcc
parent132570352216a29df45c7846a56dd1cfe83a97c3 (diff)
version 0.3.20.3.2
-rw-r--r--Network/CommandList.hs112
-rw-r--r--Network/Yjftp.hs46
-rw-r--r--yjftp.cabal6
-rw-r--r--yjftp.hs49
4 files changed, 140 insertions, 73 deletions
diff --git a/Network/CommandList.hs b/Network/CommandList.hs
index 22318c4..4e0f629 100644
--- 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 @@ module Network.CommandList (
, readBy
, getEnv
+, const2
+, compRemoteFile
+, compLs
+, filenameCompletionFunction
) where
import Network.FTP.Client (FTPConnection, getbinary, putbinary, uploadbinary, downloadbinary,
@@ -34,46 +39,54 @@ import System.Cmd (system)
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 :: String -> IO (String, Handle)
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
index 9f21557..851cd92 100644
--- a/Network/Yjftp.hs
+++ b/Network/Yjftp.hs
@@ -11,7 +11,6 @@ import System.IO (hFlush, stdin, stdout, stderr, hPutStrLn,
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.Exception (catch, Exception)
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 @@ runYjftp cl = do
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 @@ tryNTimes n errM act
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 @@ getPassword = do
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 @@ dropOptNArg opt (a:as)
| 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
index 4c6fdb3..3cf08b9 100644
--- 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 @@ Description: Just CUI FTP client.
> 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 @@ Extra-Tmp-Files:
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
index 065b3c3..1fae67a 100644
--- a/yjftp.hs
+++ b/yjftp.hs
@@ -4,30 +4,31 @@ import Network.Yjftp
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 ()