module System.CanonicalizePath
( canonicalizePath
, normalisePath
, replaceShorthands
) where
#ifdef mingw32_HOST_OS
import qualified System.Win32 as Win32
import System.FilePath (normalise)
#endif
import Control.Applicative
import Control.Monad
import Data.List.Split (splitOn, splitOneOf)
import System.FilePath ((</>), isDrive, isAbsolute, takeDirectory, pathSeparator, pathSeparators)
import System.Directory (getCurrentDirectory)
import System.PosixCompat.Files (readSymbolicLink)
import Control.Exc (ignoringException)
normalisePath :: FilePath -> IO FilePath
normalisePath path = do
absPath <- makeAbsolute path
return $ foldl combinePath "/" $ splitPath absPath
canonicalizePath :: FilePath -> IO FilePath
canonicalizePath path = do
#if !defined(mingw32_HOST_OS)
absPath <- makeAbsolute path
foldM (\x y -> expandSym $ combinePath x y) "/" $ splitPath absPath
#else
Win32.getFullPathName . normalise $ path
#endif
expandSym :: FilePath -> IO FilePath
expandSym fpath = do
deref <- ignoringException (Just <$> readSymbolicLink fpath)
case deref of
Just slink -> if isAbsolute slink then expandSym slink
else expandSym $ foldl combinePath (takeDirectory fpath) $ splitPath slink
Nothing -> return fpath
makeAbsolute :: FilePath -> IO FilePath
makeAbsolute f
| not (null f) && head f `elem` ['~', pathSeparator] = return f
| otherwise = fmap (</> f) getCurrentDirectory
combinePath :: FilePath -> String -> FilePath
combinePath x "." = x
combinePath x ".." = takeDirectory x
combinePath x y
| isDrive x = (x ++ [pathSeparator]) </> y
| otherwise = x </> y
replaceUpTo :: Eq a => [a] -> [a] -> [a] -> [a]
replaceUpTo srch rep as =
case splitOn srch as of
[] -> []
[a] -> a
(_:as') -> rep ++ last as'
replaceShorthands :: FilePath -> FilePath
replaceShorthands = replaceUpTo "/~" "~" . replaceUpTo "//" "/"
splitPath :: FilePath -> [String]
splitPath = filter (not . null) . splitOneOf pathSeparators