src/Darcs/Commands/TransferMode.lhs

   1 %  Copyright (C) 2008 David Roundy
   2 %
   3 %  This program is free software; you can redistribute it and/or modify
   4 %  it under the terms of the GNU General Public License as published by
   5 %  the Free Software Foundation; either version 2, or (at your option)
   6 %  any later version.
   7 %
   8 %  This program is distributed in the hope that it will be useful,
   9 %  but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 %  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 %  GNU General Public License for more details.
  12 %
  13 %  You should have received a copy of the GNU General Public License
  14 %  along with this program; see the file COPYING.  If not, write to
  15 %  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  16 %  Boston, MA 02110-1301, USA.
  17
  18 \subsection{darcs changes}
  19 \begin{code}
  20 {-# OPTIONS_GHC -cpp -fglasgow-exts #-}
  21 {-# LANGUAGE CPP, PatternGuards #-}
  22
  23 -- The pragma above is only for pattern guards.
  24 module Darcs.Commands.TransferMode ( transfer_mode ) where
  25
  26 import Prelude hiding ( catch )
  27 import Control.Exception ( catch )
  28 import System.IO ( stdout, hFlush )
  29
  30 import Darcs.Utils ( withCurrentDirectory, prettyException )
  31 import Darcs.Commands ( DarcsCommand(..), nodefaults )
  32 import Darcs.Arguments ( DarcsFlag, working_repo_dir )
  33 import Darcs.Repository ( amInRepository )
  34 import Darcs.Progress ( setProgressMode )
  35 import Darcs.Global ( darcsdir )
  36
  37 import qualified Data.ByteString as B (hPut, readFile, length, ByteString)
  38 \end{code}
  39
  40 \options{transfer_mode}
  41 \begin{code}
  42 transfer_mode_description :: String
  43 transfer_mode_description = "Allow access to files in repository."
  44 \end{code}
  45 \haskell{transfer_mode_help}
  46 \begin{code}
  47 transfer_mode_help :: String
  48 transfer_mode_help =
  49  "Transfer-mode is used internally to grab file contents.\n"
  50
  51 transfer_mode :: DarcsCommand
  52 transfer_mode = DarcsCommand {command_name = "transfer-mode",
  53                               command_help = transfer_mode_help,
  54                               command_description = transfer_mode_description,
  55                               command_extra_args = 0,
  56                               command_extra_arg_help = [],
  57                               command_get_arg_possibilities = return [],
  58                               command_command = transfer_mode_cmd,
  59                               command_prereq = amInRepository,
  60                               command_argdefaults = nodefaults,
  61                               command_advanced_options = [],
  62                               command_basic_options = [working_repo_dir]}
  63 \end{code}
  64
  65
  66 \begin{code}
  67 transfer_mode_cmd :: [DarcsFlag] -> [String] -> IO ()
  68 transfer_mode_cmd _ _ = do setProgressMode False
  69                            putStrLn "Hello user, I am darcs transfer mode"
  70                            hFlush stdout
  71                            withCurrentDirectory darcsdir $ transfer
  72
  73 transfer :: IO ()
  74 transfer = do 'g':'e':'t':' ':fn <- getLine
  75               x <- readfile fn
  76               case x of
  77                 Right c -> do putStrLn $ "got " ++ fn
  78                               putStrLn $ show $ B.length c
  79                               B.hPut stdout c
  80                               hFlush stdout
  81                 Left e -> do putStrLn $ "error " ++ fn
  82                              putStrLn $ show e
  83                              hFlush stdout
  84               transfer
  85
  86 readfile :: String -> IO (Either String B.ByteString)
  87 readfile fn = (Right `fmap` B.readFile fn) `catch` (\e -> return $ Left (prettyException e))
  88 \end{code}