{-# 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 :: FilePath -> IO FilePath
canonicalizePath FilePath
path = do
#if !defined(mingw32_HOST_OS)
FilePath
absPath <- FilePath -> IO FilePath
makeAbsolute FilePath
path
(FilePath -> FilePath -> IO FilePath)
-> FilePath -> [FilePath] -> IO FilePath
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\FilePath
x FilePath
y -> FilePath -> IO FilePath
expandSym (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> FilePath
combinePath FilePath
x FilePath
y) FilePath
"/" ([FilePath] -> IO FilePath) -> [FilePath] -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath]
splitPath FilePath
absPath
#else
Win32.getFullPathName . normalise $ path
#endif
expandSym :: FilePath -> IO FilePath
expandSym :: FilePath -> IO FilePath
expandSym FilePath
fpath = do
Maybe FilePath
deref <- IO (Maybe FilePath) -> IO (Maybe FilePath)
forall a. IO (Maybe a) -> IO (Maybe a)
ignoringException (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath) -> IO FilePath -> IO (Maybe FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO FilePath
readSymbolicLink FilePath
fpath)
case Maybe FilePath
deref of
Just FilePath
slink -> FilePath -> IO FilePath
expandSym (if FilePath -> Bool
isAbsolute FilePath
slink
then FilePath
slink
else (FilePath -> FilePath -> FilePath)
-> FilePath -> [FilePath] -> FilePath
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl FilePath -> FilePath -> FilePath
combinePath (FilePath -> FilePath
takeDirectory FilePath
fpath) ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath]
splitPath FilePath
slink)
Maybe FilePath
Nothing -> FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
fpath
makeAbsolute :: FilePath -> IO FilePath
makeAbsolute :: FilePath -> IO FilePath
makeAbsolute FilePath
f
| Bool -> Bool
not (FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
f) Bool -> Bool -> Bool
&& FilePath -> Char
forall a. [a] -> a
head FilePath
f Char -> FilePath -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'~', Char
pathSeparator] = FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
f
| Bool
otherwise = (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath -> FilePath -> FilePath
</> FilePath
f) IO FilePath
getCurrentDirectory
combinePath :: FilePath -> String -> FilePath
combinePath :: FilePath -> FilePath -> FilePath
combinePath FilePath
x FilePath
"." = FilePath
x
combinePath FilePath
x FilePath
".." = FilePath -> FilePath
takeDirectory FilePath
x
combinePath FilePath
"/" FilePath
y = FilePath
"/" FilePath -> FilePath -> FilePath
</> FilePath
y
combinePath FilePath
x FilePath
y
| FilePath -> Bool
isDrive FilePath
x = (FilePath
x FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [Char
pathSeparator]) FilePath -> FilePath -> FilePath
</> FilePath
y
| Bool
otherwise = FilePath
x FilePath -> FilePath -> FilePath
</> FilePath
y
replaceShorthands :: T.Text -> T.Text
replaceShorthands :: Text -> Text
replaceShorthands = Text -> Text -> Text -> Text
r Text
"/~" Text
"~/" (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text -> Text
r Text
"//" Text
"/"
where
r :: T.Text -> T.Text -> T.Text -> T.Text
r :: Text -> Text -> Text -> Text
r Text
s Text
r' Text
a = case Text -> Text -> [Text]
T.splitOn Text
s Text
a of
[] -> Text
T.empty
[Text
a'] -> Text
a'
Text
_ : [Text]
as -> Text
r' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
forall a. [a] -> a
last [Text]
as
splitPath :: FilePath -> [String]
splitPath :: FilePath -> [FilePath]
splitPath = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (FilePath -> Bool) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> [FilePath]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOneOf FilePath
pathSeparators