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