% Copyright (C) 2008 David Roundy % % This program is free software; you can redistribute it and/or modify % it under the terms of the GNU General Public License as published by % the Free Software Foundation; either version 2, or (at your option) % any later version. % % This program is distributed in the hope that it will be useful, % but WITHOUT ANY WARRANTY; without even the implied warranty of % MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the % GNU General Public License for more details. % % You should have received a copy of the GNU General Public License % along with this program; see the file COPYING. If not, write to % the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, % Boston, MA 02110-1301, USA. \subsection{darcs changes} \begin{code} {-# OPTIONS_GHC -cpp -fglasgow-exts #-} -- The pragma above is only for pattern guards. module Darcs.Commands.TransferMode ( transfer_mode ) where import Prelude hiding ( catch ) import Control.Exception ( catch ) import System.IO ( stdout, hFlush ) import Darcs.Utils ( withCurrentDirectory, prettyException ) import Darcs.Commands ( DarcsCommand(..), nodefaults ) import Darcs.Arguments ( DarcsFlag, working_repo_dir ) import Darcs.Repository ( amInRepository ) import Darcs.Progress ( setProgressMode ) import Darcs.Global ( darcsdir ) import FastPackedString ( PackedString, readFilePS, lengthPS, hPutPS ) \end{code} \options{transfer_mode} \begin{code} transfer_mode_description :: String transfer_mode_description = "Allow access to files in repository." \end{code} \haskell{transfer_mode_help} \begin{code} transfer_mode_help :: String transfer_mode_help = "Transfer-mode is used internally to grab file contents.\n" transfer_mode :: DarcsCommand transfer_mode = DarcsCommand {command_name = "transfer-mode", command_help = transfer_mode_help, command_description = transfer_mode_description, command_extra_args = 0, command_extra_arg_help = [], command_get_arg_possibilities = return [], command_command = transfer_mode_cmd, command_prereq = amInRepository, command_argdefaults = nodefaults, command_advanced_options = [], command_basic_options = [working_repo_dir]} \end{code} \begin{code} transfer_mode_cmd :: [DarcsFlag] -> [String] -> IO () transfer_mode_cmd _ _ = do setProgressMode False putStrLn "Hello user, I am darcs transfer mode" hFlush stdout withCurrentDirectory darcsdir $ transfer transfer :: IO () transfer = do 'g':'e':'t':' ':fn <- getLine x <- readfile fn case x of Right c -> do putStrLn $ "got " ++ fn putStrLn $ show $ lengthPS c hPutPS stdout c hFlush stdout Left e -> do putStrLn $ "error " ++ fn putStrLn $ show e hFlush stdout transfer readfile :: String -> IO (Either String PackedString) readfile fn = (Right `fmap` readFilePS fn) `catch` (\e -> return $ Left (prettyException e)) \end{code}