    {-# 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 :: String -> IO String
    canonicalizePath String
    path = do
    #if !defined(mingw32_HOST_OS)
      absPath <- String -> IO String
    makeAbsolute String
    path
      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) "/" $ splitPath absPath
    #else
      Win32.getFullPathName . normalise $ path
    #endif

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

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

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

    -- | 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 :: 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