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

import System.CanonicalizePath (canonicalizePath)
import System.Directory        (getHomeDirectory)
import System.FilePath         (isAbsolute, normalise, pathSeparator)
import System.PosixCompat.User (getUserEntryForName, homeDirectory)


-- 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 (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
path Bool -> Bool -> Bool
|| (FilePath -> Char
forall a. [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
  -- 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 (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
expandTilda FilePath
path = FilePath -> IO FilePath
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