{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_HADDOCK show-extensions #-}
module System.CanonicalizePath
( canonicalizePath
, replaceShorthands
) where
#ifdef mingw32_HOST_OS
import System.FilePath (normalise)
import qualified System.Win32 as Win32
#endif
import Control.Exc (ignoringException)
import Control.Monad (foldM)
import Data.List.Split (splitOneOf)
import Data.Monoid ((<>))
import qualified Data.Text as T (Text, empty, splitOn)
import System.Directory (getCurrentDirectory)
import System.FilePath (isAbsolute, isDrive, pathSeparator,
pathSeparators, takeDirectory, (</>))
import System.PosixCompat.Files (readSymbolicLink)
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 -> expandSym (if isAbsolute slink
then slink
else 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 "/" y = "/" </> y
combinePath x y
| isDrive x = (x ++ [pathSeparator]) </> y
| otherwise = x </> y
replaceShorthands :: T.Text -> T.Text
replaceShorthands = r "/~" "~/" . r "//" "/"
where
r :: T.Text -> T.Text -> T.Text -> T.Text
r s r' a = case T.splitOn s a of
[] -> T.empty
[a'] -> a'
_ : as -> r' <> last as
splitPath :: FilePath -> [String]
splitPath = filter (not . null) . splitOneOf pathSeparators