    {-# LANGUAGE CPP #-}

    module System.FriendlyPath
      ( userToCanonPath
      , expandTilda
      , isAbsolute'
      ) where

    import System.CanonicalizePath (canonicalizePath)
    import System.Directory        (getHomeDirectory)
    import System.FilePath         (isAbsolute, normalise, pathSeparator)
    #ifndef mingw32_HOST_OS
    import System.Posix.User (getUserEntryForName, homeDirectory)
    #endif

    -- canonicalizePath follows symlinks, and does not work if the directory does not exist.

    -- | Canonicalize a user-friendly path
    userToCanonPath :: FilePath -> IO String
    userToCanonPath :: FilePath -> IO FilePath
    userToCanonPath FilePath
    f = FilePath -> IO FilePath
    canonicalizePath (FilePath -> IO FilePath) -> IO FilePath -> IO FilePath
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< FilePath -> IO FilePath
    expandTilda FilePath
    f

    -- | Turn a user-friendly path into a computer-friendly path by expanding the leading tilda.
    expandTilda :: String -> IO FilePath
    expandTilda :: FilePath -> IO FilePath
    expandTilda (Char
    '~':FilePath
    path)
      | FilePath -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null FilePath
    path Bool -> Bool -> Bool
    || (FilePath -> Char
    forall a. HasCallStack => [a] -> a
    head FilePath
    path Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    pathSeparator) = (FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    path) (FilePath -> FilePath) -> IO FilePath -> IO FilePath
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO FilePath
    getHomeDirectory
    #ifndef mingw32_HOST_OS
      -- Home directory of another user, e.g. ~root/
      | Bool
    otherwise = let username :: FilePath
    username = (Char -> Bool) -> FilePath -> FilePath
    forall a. (a -> Bool) -> [a] -> [a]
    takeWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    pathSeparator) FilePath
    path
                        dirname :: FilePath
    dirname = Int -> FilePath -> FilePath
    forall a. Int -> [a] -> [a]
    drop (FilePath -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length FilePath
    username) FilePath
    path
                    in  (FilePath -> FilePath
    normalise (FilePath -> FilePath)
    -> (UserEntry -> FilePath) -> UserEntry -> FilePath
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    dirname) (FilePath -> FilePath)
    -> (UserEntry -> FilePath) -> UserEntry -> FilePath
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . UserEntry -> FilePath
    homeDirectory) (UserEntry -> FilePath) -> IO UserEntry -> IO FilePath
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> FilePath -> IO UserEntry
    getUserEntryForName FilePath
    username
    #else
      -- unix-compat no longer helps
      | otherwise = ioError $ mkIOError illegalOperationErrorType "Tilda expansion only supported under Unix" Nothing Nothing
    #endif
    expandTilda FilePath
    path = FilePath -> IO FilePath
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return FilePath
    path

    -- | Is a user-friendly path absolute?
    isAbsolute' :: String -> Bool
    isAbsolute' :: FilePath -> Bool
    isAbsolute' (Char
    '~':FilePath
    _) = Bool
    True
    isAbsolute' FilePath
    p = FilePath -> Bool
    isAbsolute FilePath
    p