FTPLine 1.2.0 → 1.3.0
raw patch · 2 files changed
+75/−29 lines, 2 filesdep ~haskelinedep ~mtl
Dependency ranges changed: haskeline, mtl
Files
- FTPLine.cabal +8/−10
- Main.hs +67/−19
FTPLine.cabal view
@@ -1,5 +1,5 @@ Name: FTPLine -Version: 1.2.0 +Version: 1.3.0 Cabal-Version: >= 1.6 License: BSD3 License-file: license @@ -10,26 +10,24 @@ Synopsis: A command-line FTP client. Description: A command-line FTP client. Type @help@ for a list of commands. Online documentation at the homepage. . - Changes from last version: - . - * Echoing of @stdin@ is turned off while running @pause@ command. + Changes from the last version: . - * New field (@interactive@) in the state record. + * Now, mtl dependency is == 2.0.*. . - * New login method, with hidden password. Now haskeline dependency is @>= 0.6.3 && < 0.7@. + * Due to the update to mtl-2, now haskeline dependency is >= 0.6.3.2 && < 0.7. . - * Added history. + * New feature: Reestablishing of last connection and login. . - * Added a few notes in the @help@ command. + * Current mode (local or remote) is displayed when switching between them. Build-Type: Simple Executable FTPLine Build-depends: base == 4.* - , mtl + , mtl == 2.0.* , ftphs , directory , network - , haskeline >= 0.6.3 && < 0.7 + , haskeline >= 0.6.3.2 && < 0.7 , ansi-terminal , strict , bytestring
Main.hs view
@@ -3,11 +3,11 @@ -- -- Below is the code of the FTPLine application. --- Sorry for lack of code notes. +-- Sorry for the lack of code notes. -- If you have any question about the code, I have your answer (I hope). -- -- Daniel Diaz < danieldiaz@asofilak.es > --- 2010 +-- 2011 -- import Data.Maybe @@ -65,6 +65,10 @@ , mode :: Bool , interactive :: Bool } +-- Added for the 1.3.0 version. +boolToMode :: Bool -> String +boolToMode b = if b then "Remote" else "Local" + initialFTPState :: FTPState initialFTPState = FTPState { conn = Nothing , file = Strict.Nothing @@ -122,18 +126,48 @@ else (liftIO $ quit $ fromJust mc) >> return () (c,r) <- liftIO $ connectFTP hn pn newConnection hn c + saveConnection hn pn return r +-- Added for the 1.3.0 version. +saveConnection :: HostName -> PortNumber -> FTPLine () +saveConnection hn pn = do + appDir <- liftIO ftpLineDir + liftIO $ writeFile (appDir ++ "/LastConnection") $ + show (hn,pn) + withConnection :: (FTPConnection -> FTPLine a) -> FTPLine a withConnection f = do mc <- getConnection if isNothing mc then ftperror "Connection not established." else f $ fromJust mc +-- Added for the 1.3.0 version. +saveLogin :: String -> String -> FTPLine () +saveLogin name pass = do + appDir <- liftIO ftpLineDir + liftIO $ writeFile (appDir ++ "/LastLogin") $ + show (name,pass) + ftplogin :: Maybe (String,String) -> FTPLine FTPResult ftplogin Nothing = withConnection $ liftIO . loginAnon -ftplogin (Just (name,pass)) = withConnection $ - \c -> liftIO $ login c name (Just pass) Nothing +ftplogin (Just (name,pass)) = do + r <- withConnection $ + \c -> liftIO $ login c name (Just pass) Nothing + saveLogin name pass + return r +-- Added for the 1.3.0 version. +lastConn :: FTPLine () +lastConn = hand (const $ withColor Red $ outputStrLn "Last connection doesn't exist.") $ do + appDir <- liftIO ftpLineDir + lc <- liftIO $ readFile $ appDir ++ "/LastConnection" + (liftIO $ readIO lc) >>= uncurry connect + outputStrLn "Last connection reestablished." + hand (const $ withColor Red $ outputStrLn "Last login doesn't exist.") $ do + ll <- liftIO $ readFile $ appDir ++ "/LastLogin" + (liftIO $ readIO ll) >>= ftplogin . Just + outputStrLn "Last login reestablished." + disconnect :: FTPLine FTPResult disconnect = withConnection $ \c -> do removeConnection @@ -173,7 +207,6 @@ localdir :: Maybe String -> FTPLine () localdir fp = if isNothing fp then liftIO (getDirectoryContents ".") >>= mapM_ outputStrLn else liftIO (getDirectoryContents $ fromJust fp) >>= mapM_ outputStrLn - pdir :: Maybe String -> FTPLine () pdir fp = localdir fp <-> @@ -181,7 +214,7 @@ getfile :: String -> FTPLine FTPResult getfile fp = (do x <- liftIO $ B.readFile fp - newFile $ File fp x -- $ B.pack x + newFile $ File fp x return success ) <-> \c -> do (x,r) <- liftIO $ getbinary c fp @@ -263,32 +296,34 @@ output :: Show a => a -> FTPLine () output = outputStrLn . show -hand :: MonadException m => (IOException -> m a) -> m a -> m a -hand = handle - command :: String -> FTPLine () command str = if null xs then outputStrLn "No command introduced." else withColor Green $ runCom (head xs) (tail xs) where xs = args str +printHelp :: String -> FTPLine () +printHelp str = withColor Cyan $ mapM_ (\ln -> if head ln == '*' then outputStrLn ln + else italized $ outputStrLn ln ) $ commandDesc str + +-- Handling exceptions + +hand :: MonadException m => (IOException -> m a) -> m a -> m a +hand = handle + handres :: FTPLine FTPResult -> FTPLine () handres c = hand ((>> return failure) . withColor Red . output) c >>= outputFTPResult hand_ :: FTPLine () -> FTPLine () hand_ = hand (withColor Red . output) -printHelp :: String -> FTPLine () -printHelp str = withColor Cyan $ mapM_ (\ln -> if head ln == '*' then outputStrLn ln - else italized $ outputStrLn ln ) $ commandDesc str - --- Echo set +-- Echo setting inEchoOff, inEchoOn :: FTPLine () inEchoOff = liftIO $ hSetEcho stdin False inEchoOn = liftIO $ hSetEcho stdin True --- +-- runCom :: String -> [String] -> FTPLine () runCom str ["help"] = printHelp str @@ -337,12 +372,18 @@ liftIO $ getLine inEchoOn outputStrLn "" -runCom "switch" _ = turnMode +runCom "switch" _ = do turnMode + b <- getMode + outputStrLn $ "Current mode: " ++ boolToMode b +runCom "last" _ = lastConn runCom x _ = withColor Cyan $ outputStrLn $ "Command doesn't exist: " ++ x +-- List of commands + commands :: [String] commands = [ "connect" , "disconnect" , "login" , "ftpdebug" + , "last" , "dir" , "cd" , "md" , "rd" , "getfile" , "putfile" , "clear" , "download" , "upload" @@ -357,9 +398,11 @@ helpHead = unlines [ "" , "Below is a list of available commands." , "Arguments in brackets are optional." - , "Arguments in braces only are used in batch mode." + , "Arguments in braces are only used in batch mode." ] +-- Description of the commands. + commandDesc :: String -> [String] commandDesc "connect" = [ "connect HostName Port" , "* Connect to remote FTP server." ] @@ -401,6 +444,8 @@ commandDesc "switch" = [ "switch" , "* Switch between local and remote mode." , "* CTRL+D invokes this action." ] +commandDesc "last" = [ "last" + , "* Try to connect and login as it was done the last time." ] commandDesc _ = ["* Invalid command."] mkCom :: Arg a => [String] -> (a -> FTPLine b) -> FTPLine b @@ -464,14 +509,17 @@ -- Main +ftpLineDir :: IO FilePath +ftpLineDir = getAppUserDataDirectory "FTPLine" + main :: IO () main = do setSGR [ SetColor Foreground Vivid White ] -- args <- getArgs - appDir <- getAppUserDataDirectory "FTPLine" + appDir <- ftpLineDir createDirectoryIfMissing True appDir -- - putStrLn "*** Welcome to FTPLine 1.2.0 ***" + putStrLn "*** Welcome to FTPLine 1.3.0 ***" if null args then do withColor Cyan $ do putStr "Type " italized $ putStr "help" putStrLn " for a list of commands."