yjftp 0.3.1 → 0.3.2
raw patch · 4 files changed
+140/−73 lines, 4 filesdep +readline
Dependencies added: readline
Files
- Network/CommandList.hs +81/−31
- Network/Yjftp.hs +31/−15
- yjftp.cabal +3/−3
- yjftp.hs +25/−24
Network/CommandList.hs view
@@ -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"
Network/Yjftp.hs view
@@ -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_ /= '!')
yjftp.cabal view
@@ -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
yjftp.hs view
@@ -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 ()