{-# LANGUAGE CPP               #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      :  System.CanonicalizePath
-- License     :  GPL-2
-- Maintainer  :  yi-devel@googlegroups.com
-- Stability   :  experimental
-- Portability :  portable
--
-- System.Directory.canonicalizePath replacement
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)

-- | Returns absolute name of the file, which doesn't contain
-- any `/./`, `/../`, `//` sequences or symlinks
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

-- | Dereferences symbolic links until regular
-- file/directory/something_else appears
expandSym :: FilePath -> IO FilePath
expandSym :: FilePath -> IO FilePath
expandSym FilePath
fpath = do
  -- System.Posix.Files.getFileStatus dereferences symlink before
  -- checking its status, so it's useless here
  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

-- | Make a path absolute.
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

-- | Combines two paths, moves up one level on ..
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 -- "C:" </> "bin" = "C:bin"
    | Bool
otherwise = FilePath
x FilePath -> FilePath -> FilePath
</> FilePath
y

-- Replace utility shorthands, similar to Emacs
--
-- @
-- somepath//someotherpath  ≅ /someotherpath
-- somepath/~/someotherpath ≅ ~/someotherpath
-- @
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

-- | Splits path into parts by path separator
--
-- Text version would look like
--
-- @'T.filter' (not . T.null) . T.split (`elem` pathSeparators)@
--
-- But we should move to @system-filepath@ package anyway.
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