src/Darcs/FilePathUtils.hs

   1 {-# OPTIONS_GHC -cpp #-}
   2 {-# LANGUAGE CPP #-}
   3
   4 -- Copyright (C) 2005 David Roundy
   5 --
   6 -- This program is free software; you can redistribute it and/or modify
   7 -- it under the terms of the GNU General Public License as published by
   8 -- the Free Software Foundation; either version 2, or (at your option)
   9 -- any later version.
  10 --
  11 -- This program is distributed in the hope that it will be useful,
  12 -- but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 -- GNU General Public License for more details.
  15 --
  16 -- You should have received a copy of the GNU General Public License
  17 -- along with this program; see the file COPYING.  If not, write to
  18 -- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  19 -- Boston, MA 02110-1301, USA.
  20
  21 module Darcs.FilePathUtils ( absolute_dir, (///) ) where
  22
  23 import System.Directory ( doesDirectoryExist )
  24 import Darcs.Utils ( withCurrentDirectory )
  25 import Workaround ( getCurrentDirectory )
  26 import Darcs.URL ( is_ssh_nopath )
  27 import UglyFileName ( fn2fp, fp2fn, norm_path )
  28
  29 -- WARNING, WARNING, WARNING!!!!
  30
  31 -- This file is deprecated in favor of the newer Darcs.RepoPath.  It's
  32 -- still got a few functions, which are gradually being moved
  33 -- elsewhere.  Please do not add new functions here, and if possible,
  34 -- avoid using these functions in new places.
  35
  36 absolute_dir :: FilePath -> IO FilePath
  37 absolute_dir dir = do
  38   isdir <- doesDirectoryExist dir
  39   if not isdir
  40      then if is_ssh_nopath dir
  41             then return $ dir++"."
  42             else return $ if (take 1 $ reverse dir) == "/"
  43               then init dir
  44               else dir
  45              -- hope it's an URL
  46      else do
  47           realdir <- withCurrentDirectory dir getCurrentDirectory
  48                      -- This one is absolute!
  49           return realdir
  50
  51 (///) :: FilePath -> FilePath -> FilePath
  52 ""///a = do_norm a
  53 a///b = do_norm $ a ++ "/" ++ b
  54
  55 do_norm :: FilePath -> FilePath
  56 do_norm f = fn2fp $ norm_path $ fp2fn f