{-# OPTIONS_HADDOCK hide #-}

module StrongPath.FilePath
  ( -- ** Parsers (from 'FilePath' to 'Path')
    -- $parsersFilepath
    parseRelDir,
    parseRelFile,
    parseAbsDir,
    parseAbsFile,
    parseRelDirW,
    parseRelFileW,
    parseAbsDirW,
    parseAbsFileW,
    parseRelDirP,
    parseRelFileP,
    parseAbsDirP,
    parseAbsFileP,

    -- ** Conversion (from 'Path' to 'FilePath')
    -- $conversionFilepath
    toFilePath,
    fromRelDir,
    fromRelFile,
    fromAbsDir,
    fromAbsFile,
    fromRelDirP,
    fromRelFileP,
    fromAbsDirP,
    fromAbsFileP,
    fromRelDirW,
    fromRelFileW,
    fromAbsDirW,
    fromAbsFileW,
  )
where

import Control.Monad.Catch (MonadThrow)
import Data.List (intercalate)
import qualified Path as P
import qualified Path.Posix as PP
import qualified Path.Windows as PW
import StrongPath.Internal
import StrongPath.Path
import qualified System.FilePath as FP
import qualified System.FilePath.Posix as FPP
import qualified System.FilePath.Windows as FPW

-- $parsersFilepath
-- Path can be constructed from `FilePath`:
--
-- > parse<base><type><standard> :: MonadThrow m => FilePath -> m (<corresponding_path_type>)
--
-- There are 12 parser functions, each of them parsing 'FilePath' into a specific 'Path'
-- type.
-- All of them work in the same fashion and will throw an error (via 'MonadThrow')
-- if given 'FilePath' can't be parsed into the specific 'Path' type.
-- For example, if path is absolute, 'parseRelDir' will throw an error.
--
-- Not all parsers accept all types of separators, for example
-- 'parseRelDirP' parser will fail to parse paths using Windows separators,
-- while 'parseRelDirW' will accept both Windows and Posix separators.
--
-- Below is a table describing, for all the parser functions,
-- which path standard (separators) do they accept as input
-- and to what path standard they parse it.
--
-- +---------------------------+-----------------+----------+
-- |          Parsers          |      From       |    To    |
-- +===========================+=================+==========+
-- | parse[Abs|Rel][Dir|File]  |  System/Posix   |  System  |
-- +---------------------------+-----------------+----------+
-- | parse[Abs|Rel][Dir|File]W |  Win/Posix      |   Win    |
-- +---------------------------+-----------------+----------+
-- | parse[Abs|Rel][Dir|File]P |   Posix         |  Posix   |
-- +---------------------------+-----------------+----------+
--
-- NOTE: Root of @parseAbs...@ input always has to match its path standard!
--   e.g., 'parseAbsDirW' can parse @\"C:\\foo\/bar\"@ but it can't parse @\"\/foo\/bar\"@.
--
-- Examples:
--
--  - @parseAbsFile \"C:\\foo\\bar.txt\"@ is valid if system is Windows, and gives the same result as @parseAbsFile \"C:\\foo\/bar.txt\"@.
--    On the other hand, both are invalid if system is Linux.
--  - @parseRelFile \"foo\/bar.txt\"@ is valid independent of the system.
--  - @parseRelFile \"foo\\bar.txt\"@ is valid only if system is Windows.
--  - @parseRelDirW \"foo\\bar\\test\"@ is valid, independent of the system, and gives the same result as @parseRelDirW \"foo\\bar\/test\"@ or @parseRelDirW "foo\/bar\/test\"@.
--
-- Basically, all of the parsers accept their \"native\" standard AND Posix,
-- which enables you to hardcode paths as Posix in the code that will compile
-- and work both on Linux and Windows when using `System` as a standard.
-- So Posix becames a kind of \"universal\" language for hardcoding the paths.

parseRelDir :: MonadThrow m => FilePath -> m (Path System (Rel d1) (Dir d2))
parseRelFile :: MonadThrow m => FilePath -> m (Path System (Rel d) (File f))
parseAbsDir :: MonadThrow m => FilePath -> m (Path System Abs (Dir d))
parseAbsFile :: MonadThrow m => FilePath -> m (Path System Abs (File f))
parseRelDirW :: MonadThrow m => FilePath -> m (Path Windows (Rel d1) (Dir d2))
parseRelFileW :: MonadThrow m => FilePath -> m (Path Windows (Rel d) (File f))
parseAbsDirW :: MonadThrow m => FilePath -> m (Path Windows Abs (Dir d))
parseAbsFileW :: MonadThrow m => FilePath -> m (Path Windows Abs (File f))
parseRelDirP :: MonadThrow m => FilePath -> m (Path Posix (Rel d1) (Dir d2))
parseRelFileP :: MonadThrow m => FilePath -> m (Path Posix (Rel d) (File f))
parseAbsDirP :: MonadThrow m => FilePath -> m (Path Posix Abs (Dir d))
parseAbsFileP :: MonadThrow m => FilePath -> m (Path Posix Abs (File f))
---- System
parseRelDir :: FilePath -> m (Path System (Rel d1) (Dir d2))
parseRelDir = (Path Rel Dir -> RelPathPrefix -> Path System (Rel d1) (Dir d2))
-> FilePath
-> (FilePath -> m (Path Rel Dir))
-> FilePath
-> m (Path System (Rel d1) (Dir d2))
forall (m :: * -> *) p s d1 d2.
MonadThrow m =>
(p -> RelPathPrefix -> Path s (Rel d1) (Dir d2))
-> FilePath
-> (FilePath -> m p)
-> FilePath
-> m (Path s (Rel d1) (Dir d2))
parseRelDirFP Path Rel Dir -> RelPathPrefix -> Path System (Rel d1) (Dir d2)
forall s b t. Path Rel Dir -> RelPathPrefix -> Path s b t
RelDir [Char
FP.pathSeparator, Char
FPP.pathSeparator] FilePath -> m (Path Rel Dir)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Rel Dir)
P.parseRelDir

parseRelFile :: FilePath -> m (Path System (Rel d) (File f))
parseRelFile = (Path Rel File -> RelPathPrefix -> Path System (Rel d) (File f))
-> FilePath
-> (FilePath -> m (Path Rel File))
-> FilePath
-> m (Path System (Rel d) (File f))
forall (m :: * -> *) p s d f.
MonadThrow m =>
(p -> RelPathPrefix -> Path s (Rel d) (File f))
-> FilePath
-> (FilePath -> m p)
-> FilePath
-> m (Path s (Rel d) (File f))
parseRelFileFP Path Rel File -> RelPathPrefix -> Path System (Rel d) (File f)
forall s b t. Path Rel File -> RelPathPrefix -> Path s b t
RelFile [Char
FP.pathSeparator, Char
FPP.pathSeparator] FilePath -> m (Path Rel File)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Rel File)
P.parseRelFile

parseAbsDir :: FilePath -> m (Path System Abs (Dir d))
parseAbsDir FilePath
fp = Path Abs Dir -> Path System Abs (Dir d)
forall a. Path Abs Dir -> Path System Abs (Dir a)
fromPathAbsDir (Path Abs Dir -> Path System Abs (Dir d))
-> m (Path Abs Dir) -> m (Path System Abs (Dir d))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> m (Path Abs Dir)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Abs Dir)
P.parseAbsDir FilePath
fp

parseAbsFile :: FilePath -> m (Path System Abs (File f))
parseAbsFile FilePath
fp = Path Abs File -> Path System Abs (File f)
forall f. Path Abs File -> Path System Abs (File f)
fromPathAbsFile (Path Abs File -> Path System Abs (File f))
-> m (Path Abs File) -> m (Path System Abs (File f))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> m (Path Abs File)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Abs File)
P.parseAbsFile FilePath
fp

---- Windows
parseRelDirW :: FilePath -> m (Path Windows (Rel d1) (Dir d2))
parseRelDirW = (Path Rel Dir -> RelPathPrefix -> Path Windows (Rel d1) (Dir d2))
-> FilePath
-> (FilePath -> m (Path Rel Dir))
-> FilePath
-> m (Path Windows (Rel d1) (Dir d2))
forall (m :: * -> *) p s d1 d2.
MonadThrow m =>
(p -> RelPathPrefix -> Path s (Rel d1) (Dir d2))
-> FilePath
-> (FilePath -> m p)
-> FilePath
-> m (Path s (Rel d1) (Dir d2))
parseRelDirFP Path Rel Dir -> RelPathPrefix -> Path Windows (Rel d1) (Dir d2)
forall s b t. Path Rel Dir -> RelPathPrefix -> Path s b t
RelDirW [Char
FPW.pathSeparator, Char
FPP.pathSeparator] FilePath -> m (Path Rel Dir)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Rel Dir)
PW.parseRelDir

parseRelFileW :: FilePath -> m (Path Windows (Rel d) (File f))
parseRelFileW = (Path Rel File -> RelPathPrefix -> Path Windows (Rel d) (File f))
-> FilePath
-> (FilePath -> m (Path Rel File))
-> FilePath
-> m (Path Windows (Rel d) (File f))
forall (m :: * -> *) p s d f.
MonadThrow m =>
(p -> RelPathPrefix -> Path s (Rel d) (File f))
-> FilePath
-> (FilePath -> m p)
-> FilePath
-> m (Path s (Rel d) (File f))
parseRelFileFP Path Rel File -> RelPathPrefix -> Path Windows (Rel d) (File f)
forall s b t. Path Rel File -> RelPathPrefix -> Path s b t
RelFileW [Char
FPW.pathSeparator, Char
FPP.pathSeparator] FilePath -> m (Path Rel File)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Rel File)
PW.parseRelFile

parseAbsDirW :: FilePath -> m (Path Windows Abs (Dir d))
parseAbsDirW FilePath
fp = Path Abs Dir -> Path Windows Abs (Dir d)
forall a. Path Abs Dir -> Path Windows Abs (Dir a)
fromPathAbsDirW (Path Abs Dir -> Path Windows Abs (Dir d))
-> m (Path Abs Dir) -> m (Path Windows Abs (Dir d))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> m (Path Abs Dir)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Abs Dir)
PW.parseAbsDir FilePath
fp

parseAbsFileW :: FilePath -> m (Path Windows Abs (File f))
parseAbsFileW FilePath
fp = Path Abs File -> Path Windows Abs (File f)
forall f. Path Abs File -> Path Windows Abs (File f)
fromPathAbsFileW (Path Abs File -> Path Windows Abs (File f))
-> m (Path Abs File) -> m (Path Windows Abs (File f))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> m (Path Abs File)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Abs File)
PW.parseAbsFile FilePath
fp

---- Posix
parseRelDirP :: FilePath -> m (Path Posix (Rel d1) (Dir d2))
parseRelDirP = (Path Rel Dir -> RelPathPrefix -> Path Posix (Rel d1) (Dir d2))
-> FilePath
-> (FilePath -> m (Path Rel Dir))
-> FilePath
-> m (Path Posix (Rel d1) (Dir d2))
forall (m :: * -> *) p s d1 d2.
MonadThrow m =>
(p -> RelPathPrefix -> Path s (Rel d1) (Dir d2))
-> FilePath
-> (FilePath -> m p)
-> FilePath
-> m (Path s (Rel d1) (Dir d2))
parseRelDirFP Path Rel Dir -> RelPathPrefix -> Path Posix (Rel d1) (Dir d2)
forall s b t. Path Rel Dir -> RelPathPrefix -> Path s b t
RelDirP [Char
FPP.pathSeparator] FilePath -> m (Path Rel Dir)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Rel Dir)
PP.parseRelDir

parseRelFileP :: FilePath -> m (Path Posix (Rel d) (File f))
parseRelFileP = (Path Rel File -> RelPathPrefix -> Path Posix (Rel d) (File f))
-> FilePath
-> (FilePath -> m (Path Rel File))
-> FilePath
-> m (Path Posix (Rel d) (File f))
forall (m :: * -> *) p s d f.
MonadThrow m =>
(p -> RelPathPrefix -> Path s (Rel d) (File f))
-> FilePath
-> (FilePath -> m p)
-> FilePath
-> m (Path s (Rel d) (File f))
parseRelFileFP Path Rel File -> RelPathPrefix -> Path Posix (Rel d) (File f)
forall s b t. Path Rel File -> RelPathPrefix -> Path s b t
RelFileP [Char
FPP.pathSeparator] FilePath -> m (Path Rel File)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Rel File)
PP.parseRelFile

parseAbsDirP :: FilePath -> m (Path Posix Abs (Dir d))
parseAbsDirP FilePath
fp = Path Abs Dir -> Path Posix Abs (Dir d)
forall a. Path Abs Dir -> Path Posix Abs (Dir a)
fromPathAbsDirP (Path Abs Dir -> Path Posix Abs (Dir d))
-> m (Path Abs Dir) -> m (Path Posix Abs (Dir d))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> m (Path Abs Dir)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Abs Dir)
PP.parseAbsDir FilePath
fp

parseAbsFileP :: FilePath -> m (Path Posix Abs (File f))
parseAbsFileP FilePath
fp = Path Abs File -> Path Posix Abs (File f)
forall f. Path Abs File -> Path Posix Abs (File f)
fromPathAbsFileP (Path Abs File -> Path Posix Abs (File f))
-> m (Path Abs File) -> m (Path Posix Abs (File f))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> m (Path Abs File)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Abs File)
PP.parseAbsFile FilePath
fp

-- $conversionFilepath
-- 'Path' can be converted into 'FilePath' via polymorphic function 'toFilePath'
-- or via any of the 12 functions that accept specific path type.
--
-- We recommend using specific functions instead of 'toFilePath',
-- because that way you are explicit about which path you expect
-- and if that expectancy is not met, type system will catch it.

toFilePath :: Path s b t -> FilePath
toFilePath :: Path s b t -> FilePath
toFilePath Path s b t
sp = case Path s b t
sp of
  ---- System
  RelDir Path Rel Dir
p RelPathPrefix
prefix -> (Path Rel Dir -> FilePath)
-> Char -> RelPathPrefix -> Path Rel Dir -> FilePath
forall t. (t -> FilePath) -> Char -> RelPathPrefix -> t -> FilePath
relPathToFilePath Path Rel Dir -> FilePath
forall b t. Path b t -> FilePath
P.toFilePath Char
FP.pathSeparator RelPathPrefix
prefix Path Rel Dir
p
  RelFile Path Rel File
p RelPathPrefix
prefix -> (Path Rel File -> FilePath)
-> Char -> RelPathPrefix -> Path Rel File -> FilePath
forall t. (t -> FilePath) -> Char -> RelPathPrefix -> t -> FilePath
relPathToFilePath Path Rel File -> FilePath
forall b t. Path b t -> FilePath
P.toFilePath Char
FP.pathSeparator RelPathPrefix
prefix Path Rel File
p
  AbsDir Path Abs Dir
p -> Path Abs Dir -> FilePath
forall b t. Path b t -> FilePath
P.toFilePath Path Abs Dir
p
  AbsFile Path Abs File
p -> Path Abs File -> FilePath
forall b t. Path b t -> FilePath
P.toFilePath Path Abs File
p
  ---- Windows
  RelDirW Path Rel Dir
p RelPathPrefix
prefix -> (Path Rel Dir -> FilePath)
-> Char -> RelPathPrefix -> Path Rel Dir -> FilePath
forall t. (t -> FilePath) -> Char -> RelPathPrefix -> t -> FilePath
relPathToFilePath Path Rel Dir -> FilePath
forall b t. Path b t -> FilePath
PW.toFilePath Char
FPW.pathSeparator RelPathPrefix
prefix Path Rel Dir
p
  RelFileW Path Rel File
p RelPathPrefix
prefix -> (Path Rel File -> FilePath)
-> Char -> RelPathPrefix -> Path Rel File -> FilePath
forall t. (t -> FilePath) -> Char -> RelPathPrefix -> t -> FilePath
relPathToFilePath Path Rel File -> FilePath
forall b t. Path b t -> FilePath
PW.toFilePath Char
FPW.pathSeparator RelPathPrefix
prefix Path Rel File
p
  AbsDirW Path Abs Dir
p -> Path Abs Dir -> FilePath
forall b t. Path b t -> FilePath
PW.toFilePath Path Abs Dir
p
  AbsFileW Path Abs File
p -> Path Abs File -> FilePath
forall b t. Path b t -> FilePath
PW.toFilePath Path Abs File
p
  ---- Posix
  RelDirP Path Rel Dir
p RelPathPrefix
prefix -> (Path Rel Dir -> FilePath)
-> Char -> RelPathPrefix -> Path Rel Dir -> FilePath
forall t. (t -> FilePath) -> Char -> RelPathPrefix -> t -> FilePath
relPathToFilePath Path Rel Dir -> FilePath
forall b t. Path b t -> FilePath
PP.toFilePath Char
FPP.pathSeparator RelPathPrefix
prefix Path Rel Dir
p
  RelFileP Path Rel File
p RelPathPrefix
prefix -> (Path Rel File -> FilePath)
-> Char -> RelPathPrefix -> Path Rel File -> FilePath
forall t. (t -> FilePath) -> Char -> RelPathPrefix -> t -> FilePath
relPathToFilePath Path Rel File -> FilePath
forall b t. Path b t -> FilePath
PP.toFilePath Char
FPP.pathSeparator RelPathPrefix
prefix Path Rel File
p
  AbsDirP Path Abs Dir
p -> Path Abs Dir -> FilePath
forall b t. Path b t -> FilePath
PP.toFilePath Path Abs Dir
p
  AbsFileP Path Abs File
p -> Path Abs File -> FilePath
forall b t. Path b t -> FilePath
PP.toFilePath Path Abs File
p
  where
    relPathToFilePath :: (t -> FilePath) -> Char -> RelPathPrefix -> t -> FilePath
relPathToFilePath t -> FilePath
pathToFilePath Char
sep RelPathPrefix
prefix t
path =
      Char -> FilePath -> FilePath -> FilePath
combinePrefixWithPath Char
sep (Char -> RelPathPrefix -> FilePath
relPathPrefixToFilePath Char
sep RelPathPrefix
prefix) (t -> FilePath
pathToFilePath t
path)

    relPathPrefixToFilePath :: Char -> RelPathPrefix -> FilePath
    relPathPrefixToFilePath :: Char -> RelPathPrefix -> FilePath
relPathPrefixToFilePath Char
_ RelPathPrefix
NoPrefix = FilePath
""
    relPathPrefixToFilePath Char
sep (ParentDir Int
n) =
      FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate [Char
sep] (Int -> FilePath -> [FilePath]
forall a. Int -> a -> [a]
replicate Int
n FilePath
"..") FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [Char
sep]

    -- TODO: This function and helper functions above are somewhat too loose and hard to
    --   follow, implement them in better way.
    -- Here we are assuming that prefix is of form (../)*, therefore it ends with separator,
    -- and it could also be empty.
    combinePrefixWithPath :: Char -> String -> FilePath -> FilePath
    combinePrefixWithPath :: Char -> FilePath -> FilePath -> FilePath
combinePrefixWithPath Char
sep FilePath
prefix FilePath
path
      | FilePath
path FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath
".", [Char
'.', Char
sep], FilePath
"./"] Bool -> Bool -> Bool
&& Bool -> Bool
not (FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
prefix) = FilePath
prefix
    combinePrefixWithPath Char
_ FilePath
prefix FilePath
path = FilePath
prefix FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
path

-- These functions just call toFilePath, but their value is in
-- their type: they allow you to capture expected type of the strong path
-- that you want to convert into FilePath.
fromRelDir :: Path System (Rel r) (Dir d) -> FilePath
fromRelDir :: Path System (Rel r) (Dir d) -> FilePath
fromRelDir = Path System (Rel r) (Dir d) -> FilePath
forall s b t. Path s b t -> FilePath
toFilePath

fromRelFile :: Path System (Rel r) (File f) -> FilePath
fromRelFile :: Path System (Rel r) (File f) -> FilePath
fromRelFile = Path System (Rel r) (File f) -> FilePath
forall s b t. Path s b t -> FilePath
toFilePath

fromAbsDir :: Path System Abs (Dir d) -> FilePath
fromAbsDir :: Path System Abs (Dir d) -> FilePath
fromAbsDir = Path System Abs (Dir d) -> FilePath
forall s b t. Path s b t -> FilePath
toFilePath

fromAbsFile :: Path System Abs (File f) -> FilePath
fromAbsFile :: Path System Abs (File f) -> FilePath
fromAbsFile = Path System Abs (File f) -> FilePath
forall s b t. Path s b t -> FilePath
toFilePath

fromRelDirP :: Path Posix (Rel r) (Dir d) -> FilePath
fromRelDirP :: Path Posix (Rel r) (Dir d) -> FilePath
fromRelDirP = Path Posix (Rel r) (Dir d) -> FilePath
forall s b t. Path s b t -> FilePath
toFilePath

fromRelFileP :: Path Posix (Rel r) (File f) -> FilePath
fromRelFileP :: Path Posix (Rel r) (File f) -> FilePath
fromRelFileP = Path Posix (Rel r) (File f) -> FilePath
forall s b t. Path s b t -> FilePath
toFilePath

fromAbsDirP :: Path Posix Abs (Dir d) -> FilePath
fromAbsDirP :: Path Posix Abs (Dir d) -> FilePath
fromAbsDirP = Path Posix Abs (Dir d) -> FilePath
forall s b t. Path s b t -> FilePath
toFilePath

fromAbsFileP :: Path Posix Abs (File f) -> FilePath
fromAbsFileP :: Path Posix Abs (File f) -> FilePath
fromAbsFileP = Path Posix Abs (File f) -> FilePath
forall s b t. Path s b t -> FilePath
toFilePath

fromRelDirW :: Path Windows (Rel r) (Dir d) -> FilePath
fromRelDirW :: Path Windows (Rel r) (Dir d) -> FilePath
fromRelDirW = Path Windows (Rel r) (Dir d) -> FilePath
forall s b t. Path s b t -> FilePath
toFilePath

fromRelFileW :: Path Windows (Rel r) (File f) -> FilePath
fromRelFileW :: Path Windows (Rel r) (File f) -> FilePath
fromRelFileW = Path Windows (Rel r) (File f) -> FilePath
forall s b t. Path s b t -> FilePath
toFilePath

fromAbsDirW :: Path Windows Abs (Dir d) -> FilePath
fromAbsDirW :: Path Windows Abs (Dir d) -> FilePath
fromAbsDirW = Path Windows Abs (Dir d) -> FilePath
forall s b t. Path s b t -> FilePath
toFilePath

fromAbsFileW :: Path Windows Abs (File f) -> FilePath
fromAbsFileW :: Path Windows Abs (File f) -> FilePath
fromAbsFileW = Path Windows Abs (File f) -> FilePath
forall s b t. Path s b t -> FilePath
toFilePath