#define mingw32_TARGET_OS
module FilePath
         ( -- * FilePath
           splitFileName
         , splitFileExt
         , splitFilePath
         , joinFileName
         , joinFileExt
         , joinPaths         
         , changeFileExt
         , isRootedPath
         , isAbsolutePath
         , absolutizePath
         , normalizePath
         , getPathRoot
         
         , pathParents
         , commonParent
         
         -- * Search path
         , parseSearchPath
         , mkSearchPath
         
         -- * Separators
         , isPathSeparator
         , pathSeparator
         , searchPathSeparator
         ) where

import Data.List(intersperse)
import Data.Char(toLower, isAlphaNum)
import System.Directory(getCurrentDirectory)
import System.Environment(getEnv)

--------------------------------------------------------------
-- * FilePath
--------------------------------------------------------------

-- | Split the path into directory and file name
--
-- Examples:
--
-- \[Posix\]
--
-- > splitFileName "/"            == ("/",    "")
-- > splitFileName "/foo/bar.ext" == ("/foo", "bar.ext")
-- > splitFileName "bar.ext"      == (".",    "bar.ext")
-- > splitFileName "/foo/."       == ("/foo", ".")
-- > splitFileName "/foo/.."      == ("/foo", "..")
--
-- \[Windows\]
--
-- > splitFileName "\\"               == ("\\",      "")
-- > splitFileName "c:\\foo\\bar.ext" == ("c:\\foo", "bar.ext")
-- > splitFileName "bar.ext"          == (".",       "bar.ext")
-- > splitFileName "c:\\foo\\."       == ("c:\\foo", ".")
-- > splitFileName "c:\\foo\\.."      == ("c:\\foo", "..")
--
-- The first case in the above examples returns an empty file name.
-- This is a special case because the \"\/\" (\"\\\\\" on Windows) 
-- path doesn\'t refer to an object (file or directory) which resides 
-- within a directory.
splitFileName :: FilePath -> (String, String)
splitFileName p = (reverse (path2++drive), reverse fname)
  where
#ifdef mingw32_TARGET_OS
    (path,drive) = break (== ':') (reverse p)
#else
    (path,drive) = (reverse p,"")
#endif
    (fname,path1) = break isPathSeparator path
    path2 = case path1 of
      []                           -> "."
      [_]                          -> path1   -- don't remove the trailing slash if 
                                              -- there is only one character
      (c:path) | isPathSeparator c -> path
      _                            -> path1

-- | Split the path into file name and extension. If the file doesn\'t have extension,
-- the function will return empty string. The extension doesn\'t include a leading period.
--
-- Examples:
--
-- > splitFileExt "foo.ext" == ("foo", "ext")
-- > splitFileExt "foo"     == ("foo", "")
-- > splitFileExt "."       == (".",   "")
-- > splitFileExt ".."      == ("..",  "")
splitFileExt :: FilePath -> (String, String)
splitFileExt p =
  case pre of
	[]      -> (p, [])
	(_:pre) -> (reverse (pre++path), reverse suf)
  where
    (fname,path) = break isPathSeparator (reverse p)
    (suf,pre) | fname == "." || fname == ".." = (fname,"")
              | otherwise                     = break (== '.') fname

-- | Split the path into directory, file name and extension. 
-- The function is an optimized version of the following equation:
--
-- > splitFilePath path = (dir,name,ext)
-- >   where
-- >     (dir,basename) = splitFileName path
-- >     (name,ext)     = splitFileExt  basename
splitFilePath :: FilePath -> (String, String, String)
splitFilePath p =
  case pre of
    []      -> (reverse real_dir, reverse suf, [])
    (_:pre) -> (reverse real_dir, reverse pre, reverse suf)
  where
#ifdef mingw32_TARGET_OS
    (path,drive) = break (== ':') (reverse p)
#else
    (path,drive) = (reverse p,"")
#endif
    (file,dir)   = break isPathSeparator path
    (suf,pre)    = case file of
                     ".." -> ("..", "")
                     _    -> break (== '.') file
    
    real_dir = case dir of
      []      -> '.':drive
      [_]     -> pathSeparator:drive
      (_:dir) -> dir++drive

-- | The 'joinFileName' function is the opposite of 'splitFileName'. 
-- It joins directory and file names to form complete file path.
--
-- The general rule is:
--
-- > dir `joinFileName` basename == path
-- >   where
-- >     (dir,basename) = splitFileName path
--
-- There might be an exeptions to the rule but in any case the
-- reconstructed path will refer to the same object (file or directory).
-- An example exception is that on Windows some slashes might be converted
-- to backslashes.
joinFileName :: String -> String -> FilePath
joinFileName ""  fname = fname
joinFileName "." fname = fname
joinFileName dir fname
  | isPathSeparator (last dir) = dir++fname
  | otherwise                  = dir++pathSeparator:fname

-- | The 'joinFileExt' function is the opposite of 'splitFileExt'.
-- It joins file name and extension to form complete file path.
--
-- The general rule is:
--
-- > filename `joinFileExt` ext == path
-- >   where
-- >     (filename,ext) = splitFileExt path
joinFileExt :: String -> String -> FilePath
joinFileExt path ""  = path
joinFileExt path ext = path ++ '.':ext

-- | Combines two path strings.
-- If the second path is not rooted (does not include a root or a drive specification on Windows), 
-- the result is a concatenation of the two paths. If the second path includes a root then it
-- is returned.
joinPaths :: FilePath -> FilePath -> FilePath
joinPaths path1 path2
  | isRootedPath path2 = path2
  | otherwise          = 
#ifdef mingw32_TARGET_OS
        case path2 of
          d:':':path2' | take 2 path1 == [d,':'] -> path1 `joinFileName` path2'
                       | otherwise               -> path2
          _                                      -> path1 `joinFileName` path2
#else
        path1 `joinFileName` path2
#endif
  
-- | Changes the extension of a file path.
changeFileExt :: FilePath           -- ^ The path information to modify.
          -> String                 -- ^ The new extension (without a leading period).
                                    -- Specify an empty string to remove an existing 
                                    -- extension from path.
          -> FilePath               -- ^ A string containing the modified path information.
changeFileExt path ext = joinFileExt name ext
  where
    (name,_) = splitFileExt path

-- | On Unix and Macintosh the 'isRootedPath' function is a synonym to 'isAbsolutePath'.
-- The difference is important only on Windows. The rooted path must start from the root
-- directory but may not include the drive letter while the absolute path always includes
-- the drive letter and the full file path.
isRootedPath :: FilePath -> Bool
isRootedPath (c:_) | isPathSeparator c = True
#ifdef mingw32_TARGET_OS
isRootedPath (_:':':c:_) | isPathSeparator c = True  -- path with drive letter
#endif
isRootedPath _ = False

-- | Return 'True' if the specified path is absolute.
isAbsolutePath :: FilePath -> Bool
#ifdef mingw32_TARGET_OS
isAbsolutePath (_:':':c:_) | isPathSeparator c = True
#else
isAbsolutePath (c:_)       | isPathSeparator c = True
#endif
isAbsolutePath _ = False

-- | Return a normalized absolutized version of the file path.
-- The function is in 'IO' monad because it needs to retrieve the
-- current directory.
absolutizePath :: FilePath -> IO FilePath
absolutizePath path = do
  cur <- getCurrentDirectory
  return (normalizePath (cur `joinPaths` path))

-- | Normalize a pathname. This collapses redundant separators and up-level references, 
-- e.g. A\/\/B, A\/.\/B and A\/foo\/..\/B all become A\/B. 
-- On Windows, it converts forward slashes to backward slashes.
normalizePath :: FilePath -> FilePath
normalizePath path = vol ++ concat (intersperse [pathSeparator] (normalize path1))
  where
    (vol,path1) = case path of
      (c:path)       | isPathSeparator c -> ([c],path)
      (d:':':c:path) | isPathSeparator c -> ([d,':',c],path)
      _                                  -> ("",path)

    normalize path
      | null path1 = []
      | otherwise  = 
          case normalize path2 of
            "..":path -> path
            path | dir == "." -> path
                 | otherwise  -> dir : path
      where
        path1       = dropWhile isPathSeparator path
        (dir,path2) = break isPathSeparator path1

-- | Gets the root directory information of the specified path.
-- On Unix and Macintosh this is @Just \"\/\"@ if the path is
-- absolute, @Just \"~\/\"@ if the path is relative to the home
-- directory and @Nothing@ in other cases. On Windows the @Just@
-- value can contain a drive letter and slash (@Just \"c:\\\"@) for 
-- absolute paths or only drive (@Just \"c:\"@) for relative paths.
getPathRoot :: FilePath -> Maybe String
getPathRoot (c:path)       | isPathSeparator c = Just [c]         -- "\\" or "/"
#ifdef mingw32_TARGET_OS
getPathRoot (d:':':c:path) | isPathSeparator c = Just [d,':',c]   -- "c:\\"
getPathRoot (d:':':path)                       = Just [d,':']     -- "c:"
#else
getPathRoot ('~':'/':path)                     = Just "~/"        -- "~/"
#endif
getPathRoot _                                  = Nothing

-- | Gets this path and all its \'real\' parents.
-- The function is useful in case if you want to create 
-- some file but you aren\'t sure whether all directories 
-- in the path exists. The 'pathParents' returns a list of
-- all directories that must be created.
-- 
-- Some examples:
--
-- \[Posix\]
--
-- >  pathParents "/"          == []
-- >  pathParents "/dir1"      == ["/dir1/"]
-- >  pathParents "/dir1/dir2" == ["/dir1/", "/dir1/dir2/"]
--
-- In the above examples \"\/\" isn\'t included in the list 
-- because you can\'t create root directory.
--
-- \[Windows\]
--
-- >  pathParents "c:"             == []
-- >  pathParents "c:\\"           == []
-- >  pathParents "c:\\dir1"       == ["c:\\dir1\\"]
-- >  pathParents "c:\\dir1\\dir2" == ["c:\\dir1\\", "c:\\dir1\\dir2\\"]
--
-- Here \"c:\" and \"c:\\\" aren\'t listed because you can\'t create \"c:\\\" as directory.
pathParents :: FilePath -> [FilePath]
pathParents p =
    map ((++) root') (dropEmptyPath $ inits path')
    where
#ifdef mingw32_TARGET_OS
       (root,path) = case break (== ':') p of
          (path,    "") -> ("",path)
          (root,_:path) -> (root++":",path)
#else
       (root,path) = ("",p)
#endif
       (root',path') = case path of
         (c:path) | isPathSeparator c -> (root++[pathSeparator],path)
         _                            -> (root,path)
         
       dropEmptyPath ("":paths) = paths
       dropEmptyPath paths      = paths

       inits :: String -> [String]
       inits [] =  [""]
       inits cs = 
         case pre of
           "."  -> inits suf
           ".." -> map (joinFileName pre) (dropEmptyPath $ inits suf)
           _    -> "" : map (joinFileName pre) (inits suf)
         where
           (pre,suf) = case break isPathSeparator cs of
              (pre,"")    -> (pre, "")
              (pre,_:suf) -> (pre,suf)

-- | Given a list of file paths, returns the longest common parent.
commonParent :: [FilePath] -> Maybe FilePath
commonParent []           = Nothing
commonParent paths@(p:ps) = 
  case common Nothing "" p ps of
#ifdef mingw32_TARGET_OS
    Nothing | all (not . isAbsolutePath) paths -> 
      case foldr getDrive [] paths of
        []  -> Just "."
        [d] -> Just [d,':']
        _   -> Nothing
#else
    Nothing | all (not . isAbsolutePath) paths -> Just "."
#endif
    mb_path   -> mb_path
  where
    getDrive (d:':':_) ds 
      | not (d `elem` ds) = d:ds
    getDrive _         ds = ds

    common i acc []     ps = checkSep   i acc         ps
    common i acc (c:cs) ps
      | isPathSeparator c  = removeSep  i acc   cs [] ps
      | otherwise          = removeChar i acc c cs [] ps

    checkSep i acc []      = Just (reverse acc)
    checkSep i acc ([]:ps) = Just (reverse acc)
    checkSep i acc ((c1:p):ps)
      | isPathSeparator c1 = checkSep i acc ps
    checkSep i acc ps      = i

    removeSep i acc cs pacc []          = 
      common (Just (reverse (pathSeparator:acc))) (pathSeparator:acc) cs pacc
    removeSep i acc cs pacc ([]    :ps) = Just (reverse acc)
    removeSep i acc cs pacc ((c1:p):ps)
      | isPathSeparator c1              = removeSep i acc cs (p:pacc) ps
    removeSep i acc cs pacc ps          = i

    removeChar i acc c cs pacc []          = common i (c:acc) cs pacc
    removeChar i acc c cs pacc ([]    :ps) = i
    removeChar i acc c cs pacc ((c1:p):ps)
      | c == c1                            = removeChar i acc c cs (p:pacc) ps
    removeChar i acc c cs pacc ps          = i

--------------------------------------------------------------
-- * Search path
--------------------------------------------------------------

-- | The function splits the given string to substrings
-- using the 'searchPathSeparator'.
parseSearchPath :: String -> [FilePath]
parseSearchPath path = split searchPathSeparator path
  where
    split :: Char -> String -> [String]
    split c s =
      case rest of
        []      -> [chunk] 
        _:rest' -> chunk : split c rest'
      where
        (chunk, rest) = break (==c) s

-- | The function concatenates the given paths to form a
-- single string where the paths are separated with 'searchPathSeparator'.
mkSearchPath :: [FilePath] -> String
mkSearchPath paths = concat (intersperse [searchPathSeparator] paths)


--------------------------------------------------------------
-- * Separators
--------------------------------------------------------------

-- | Checks whether the character is a valid path separator for the host platform.
-- The valid character is a 'pathSeparator' but since the Windows operating system 
-- also accepts a backslash (\"\\\") the function also checks for \"\/\" on this platform.
isPathSeparator :: Char -> Bool
isPathSeparator ch =
#ifdef mingw32_TARGET_OS
  ch == '/' || ch == '\\'
#else
  ch == '/'
#endif

-- | Provides a platform-specific character used to separate directory levels in a 
-- path string that reflects a hierarchical file system organization.
-- The separator is a slash (\"\/\") on Unix and Macintosh, and a backslash (\"\\\") on the 
-- Windows operating system.
pathSeparator :: Char
#ifdef mingw32_TARGET_OS
pathSeparator = '\\'
#else
pathSeparator = '/'
#endif

-- | A platform-specific character used to separate search path strings in 
-- environment variables. The separator is a colon (\":\") on Unix and Macintosh, 
-- and a semicolon (\";\") on the Windows operating system.
searchPathSeparator :: Char
#ifdef mingw32_TARGET_OS
searchPathSeparator = ';'
#else
searchPathSeparator = ':'
#endif