-- Copyright (C) 2005 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.

module FilePathUtils ( fix_maybe_absolute, unfix_maybe_absolute,
                       drop_paths, (///) ) where

import List ( isPrefixOf )
import Maybe ( catMaybes )

import Autoconf ( path_separator )
import FileName ( fn2fp, fp2fn, norm_path )
import DarcsURL ( is_absolute, is_relative, is_file )
#include "impossible.h"

fix_maybe_absolute :: FilePath -> FilePath -> FilePath -> FilePath
fix_maybe_absolute _ _ pat  | not $ is_file pat = pat
fix_maybe_absolute repo fix pat = fma $ map cleanup pat
    where fma p | is_relative p = fix /// p
                | is_absolute p = unabsolute p
                | otherwise = p
          unabsolute p
            | null repo         = p -- it's ok not to specify a repository
            | not_absolute repo = bug $ "Repository was not an absolute path: " ++ repo
            | is_in_repo p      = "." ++ (drop (length repo) p)
            | otherwise         = p
          -- Note that (repo `isPrefixOf` p) without the slash is not a good idea.
          -- The slash is important: what if your repo is "foo" and p is "foobar"?
          is_in_repo p = (repo == p || (repo ++ "/") `isPrefixOf` p)
          not_absolute = not.is_absolute -- is relative or url

unfix_maybe_absolute :: FilePath -> FilePath -> FilePath
unfix_maybe_absolute _ pat | not $ is_file pat = pat
unfix_maybe_absolute fix pat = fma $ map cleanup pat
    where fma p | is_absolute p = p
          fma p = make_dotdots fix /// p

cleanup :: Char -> Char
cleanup '\\' | path_separator == '\\' = '/'
cleanup c = c

make_dotdots :: FilePath -> FilePath
make_dotdots "" = ""
make_dotdots p | is_absolute p = bug $ "Can't make_dotdots on an absolute path:  "
make_dotdots p = "../" ++ case snd $ break (=='/') p of
                          "" -> ""
                          r -> make_dotdots r

drop_paths :: String -> [String] -> [String]
drop_paths "" ps = map norm_relative ps
    where norm_relative f | is_relative f = do_norm f
                          | otherwise = f
drop_paths fix ps = catMaybes $ map drop_path ps
  where drop_path p | not $ is_relative p = Just p
        drop_path ('.':'/':p) = drop_path $ dropWhile (=='/') p
        drop_path p = if take (length fix) p == fix
                      then Just $ dropWhile (=='/') $ drop (length fix) p
                      else if is_relative p
                           then Nothing
                           else Just p

(///) :: FilePath -> FilePath -> FilePath
""///a = do_norm a
a///b = do_norm $ a ++ "/" ++ b

do_norm :: FilePath -> FilePath
do_norm f = fn2fp $ norm_path $ fp2fn f