{-# LANGUAGE QuasiQuotes #-}
{-# OPTIONS_HADDOCK hide #-}

module StrongPath.Operations
  ( -- ** Operations
    (</>),
    parent,
    basename,

    -- ** Casting
    castRel,
    castDir,
    castFile,

    -- ** Conversion of path standard
    relDirToPosix,
    relFileToPosix,
  )
where

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

-- TODO: Add relDirToWindows and relFileToWindows?
-- TODO: Implement relFile?
-- TODO: Can I use type classes and return type polymorhipsm to make all this shorter and reduce duplication?
-- class Path, and then I have PathWindows and PathPosix and PathSystem implement it, smth like that?
-- And then fromPathRelDir has polymorhic return type based on standard? I tried a little bit but it is complicated.
-- TODO: If there is no other solution to all this duplication, do some template haskell magic to simplify it.

-- | Gets parent dir of the path.
--
-- Either removes last entry in the path or if there are no entries and just @\"..\/\"@s, adds one more @\"..\/\"@.
--
-- If path is absolute root and it has no parent, it will return unchanged path.
--
-- Examples (pseudocode):
--
-- > parent "a/b/c" == "a/b"
-- > parent "/a" == "/"
-- > parent "/" == "/"
-- > parent "../a/b" == "../a"
-- > parent ".." == "../.."
-- > parent (parent "../a") == "../.."
parent :: Path s b t -> Path s b (Dir d)
parent :: Path s b t -> Path s b (Dir d)
parent Path s b t
path = case Path s b t
path of
  ---- System
  RelDir Path Rel Dir
p RelPathPrefix
prefix -> (Path Rel Dir -> RelPathPrefix -> Path s b (Dir d))
-> (Path Rel Dir -> Path Rel Dir)
-> Path Rel Dir
-> RelPathPrefix
-> Path s b (Dir d)
forall t p.
Eq t =>
(t -> RelPathPrefix -> p) -> (t -> t) -> t -> RelPathPrefix -> p
relDirPathParent Path Rel Dir -> RelPathPrefix -> Path s b (Dir d)
forall s b t. Path Rel Dir -> RelPathPrefix -> Path s b t
RelDir Path Rel Dir -> Path Rel Dir
forall b t. Path b t -> Path b Dir
P.parent Path Rel Dir
p RelPathPrefix
prefix
  RelFile Path Rel File
p RelPathPrefix
prefix -> Path Rel Dir -> RelPathPrefix -> Path s b (Dir d)
forall s b t. Path Rel Dir -> RelPathPrefix -> Path s b t
RelDir (Path Rel File -> Path Rel Dir
forall b t. Path b t -> Path b Dir
P.parent Path Rel File
p) RelPathPrefix
prefix
  AbsDir Path Abs Dir
p -> Path Abs Dir -> Path s b (Dir d)
forall s b t. Path Abs Dir -> Path s b t
AbsDir (Path Abs Dir -> Path s b (Dir d))
-> Path Abs Dir -> Path s b (Dir d)
forall a b. (a -> b) -> a -> b
$ Path Abs Dir -> Path Abs Dir
forall b t. Path b t -> Path b Dir
P.parent Path Abs Dir
p
  AbsFile Path Abs File
p -> Path Abs Dir -> Path s b (Dir d)
forall s b t. Path Abs Dir -> Path s b t
AbsDir (Path Abs Dir -> Path s b (Dir d))
-> Path Abs Dir -> Path s b (Dir d)
forall a b. (a -> b) -> a -> b
$ Path Abs File -> Path Abs Dir
forall b t. Path b t -> Path b Dir
P.parent Path Abs File
p
  ---- Windows
  RelDirW Path Rel Dir
p RelPathPrefix
prefix -> (Path Rel Dir -> RelPathPrefix -> Path s b (Dir d))
-> (Path Rel Dir -> Path Rel Dir)
-> Path Rel Dir
-> RelPathPrefix
-> Path s b (Dir d)
forall t p.
Eq t =>
(t -> RelPathPrefix -> p) -> (t -> t) -> t -> RelPathPrefix -> p
relDirPathParent Path Rel Dir -> RelPathPrefix -> Path s b (Dir d)
forall s b t. Path Rel Dir -> RelPathPrefix -> Path s b t
RelDirW Path Rel Dir -> Path Rel Dir
forall b t. Path b t -> Path b Dir
PW.parent Path Rel Dir
p RelPathPrefix
prefix
  RelFileW Path Rel File
p RelPathPrefix
prefix -> Path Rel Dir -> RelPathPrefix -> Path s b (Dir d)
forall s b t. Path Rel Dir -> RelPathPrefix -> Path s b t
RelDirW (Path Rel File -> Path Rel Dir
forall b t. Path b t -> Path b Dir
PW.parent Path Rel File
p) RelPathPrefix
prefix
  AbsDirW Path Abs Dir
p -> Path Abs Dir -> Path s b (Dir d)
forall s b t. Path Abs Dir -> Path s b t
AbsDirW (Path Abs Dir -> Path s b (Dir d))
-> Path Abs Dir -> Path s b (Dir d)
forall a b. (a -> b) -> a -> b
$ Path Abs Dir -> Path Abs Dir
forall b t. Path b t -> Path b Dir
PW.parent Path Abs Dir
p
  AbsFileW Path Abs File
p -> Path Abs Dir -> Path s b (Dir d)
forall s b t. Path Abs Dir -> Path s b t
AbsDirW (Path Abs Dir -> Path s b (Dir d))
-> Path Abs Dir -> Path s b (Dir d)
forall a b. (a -> b) -> a -> b
$ Path Abs File -> Path Abs Dir
forall b t. Path b t -> Path b Dir
PW.parent Path Abs File
p
  ---- Posix
  RelDirP Path Rel Dir
p RelPathPrefix
prefix -> (Path Rel Dir -> RelPathPrefix -> Path s b (Dir d))
-> (Path Rel Dir -> Path Rel Dir)
-> Path Rel Dir
-> RelPathPrefix
-> Path s b (Dir d)
forall t p.
Eq t =>
(t -> RelPathPrefix -> p) -> (t -> t) -> t -> RelPathPrefix -> p
relDirPathParent Path Rel Dir -> RelPathPrefix -> Path s b (Dir d)
forall s b t. Path Rel Dir -> RelPathPrefix -> Path s b t
RelDirP Path Rel Dir -> Path Rel Dir
forall b t. Path b t -> Path b Dir
PP.parent Path Rel Dir
p RelPathPrefix
prefix
  RelFileP Path Rel File
p RelPathPrefix
prefix -> Path Rel Dir -> RelPathPrefix -> Path s b (Dir d)
forall s b t. Path Rel Dir -> RelPathPrefix -> Path s b t
RelDirP (Path Rel File -> Path Rel Dir
forall b t. Path b t -> Path b Dir
PP.parent Path Rel File
p) RelPathPrefix
prefix
  AbsDirP Path Abs Dir
p -> Path Abs Dir -> Path s b (Dir d)
forall s b t. Path Abs Dir -> Path s b t
AbsDirP (Path Abs Dir -> Path s b (Dir d))
-> Path Abs Dir -> Path s b (Dir d)
forall a b. (a -> b) -> a -> b
$ Path Abs Dir -> Path Abs Dir
forall b t. Path b t -> Path b Dir
PP.parent Path Abs Dir
p
  AbsFileP Path Abs File
p -> Path Abs Dir -> Path s b (Dir d)
forall s b t. Path Abs Dir -> Path s b t
AbsDirP (Path Abs Dir -> Path s b (Dir d))
-> Path Abs Dir -> Path s b (Dir d)
forall a b. (a -> b) -> a -> b
$ Path Abs File -> Path Abs Dir
forall b t. Path b t -> Path b Dir
PP.parent Path Abs File
p
  where
    -- NOTE: We need this special logic for RelDir, because if we have RelDir Path,
    --   it is possible that it is "." or smth like that and no parent can be obtained,
    --   in which case we want to add "../" to our prefix.
    --   For file though, we don't have that concern, because it will always be possible to
    --   get a parent, as per current Path implementation.
    relDirPathParent :: (t -> RelPathPrefix -> p) -> (t -> t) -> t -> RelPathPrefix -> p
relDirPathParent t -> RelPathPrefix -> p
constructor t -> t
pathParent t
p RelPathPrefix
prefix =
      if t -> t
pathParent t
p t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
p
        then
          let prefix' :: RelPathPrefix
prefix' = case RelPathPrefix
prefix of
                ParentDir n -> Int -> RelPathPrefix
ParentDir (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                RelPathPrefix
NoPrefix -> Int -> RelPathPrefix
ParentDir Int
1
           in t -> RelPathPrefix -> p
constructor t
p RelPathPrefix
prefix'
        else
          let p' :: t
p' = t -> t
pathParent t
p
           in t -> RelPathPrefix -> p
constructor t
p' RelPathPrefix
prefix

-- | Concatenates two paths, same as "FilePath".'FilePath.</>', but only if the second path is relative
-- to the directory that first path leads to, and if both paths use the same path standard.
--
-- How @\"..\/\"@s are resolved (examples are pseudocode):
--
-- - For each @\"..\/\"@ at the start of the right hand path, one most right entry is removed
--   from the left hand path.
--
-- > "a/b" </> "../c" == "a/c"
--
-- - If left path is absolute and right path has too many @"..\/"@s, they go \"over\" the root
--   and are effectively ignored.
--
-- > "/a/b" </> "../../../../../c" == "/c"
--
-- - If left path is relative and right path has more @\"..\/\"@s then left has entries,
--   the leftover @\"..\/\"@s are carried over.
--
-- > "a/b" </> "../../../../../c" == "../../../c"
(</>) :: Path s b (Dir d) -> Path s (Rel d) t -> Path s b t
---- System
lsp :: Path s b (Dir d)
lsp@(RelDir Path Rel Dir
_ RelPathPrefix
_) </> :: Path s b (Dir d) -> Path s (Rel d) t -> Path s b t
</> (RelFile Path Rel File
rp RelPathPrefix
rprefix) =
  let (RelDir Path Rel Dir
lp' RelPathPrefix
lprefix') = (Path s b (Dir d) -> Path s b (Dir d))
-> Path s b (Dir d) -> [Path s b (Dir d)]
forall a. (a -> a) -> a -> [a]
iterate Path s b (Dir d) -> Path s b (Dir d)
forall s b t d. Path s b t -> Path s b (Dir d)
parent Path s b (Dir d)
lsp [Path s b (Dir d)] -> Int -> Path s b (Dir d)
forall a. [a] -> Int -> a
!! RelPathPrefix -> Int
prefixNumParentDirs RelPathPrefix
rprefix
   in Path Rel File -> RelPathPrefix -> Path s b t
forall s b t. Path Rel File -> RelPathPrefix -> Path s b t
RelFile (Path Rel Dir
lp' Path Rel Dir -> Path Rel File -> Path Rel File
forall b t. Path b Dir -> Path Rel t -> Path b t
P.</> Path Rel File
rp) RelPathPrefix
lprefix'
lsp :: Path s b (Dir d)
lsp@(RelDir Path Rel Dir
_ RelPathPrefix
_) </> (RelDir Path Rel Dir
rp RelPathPrefix
rprefix) =
  let (RelDir Path Rel Dir
lp' RelPathPrefix
lprefix') = (Path s b (Dir d) -> Path s b (Dir d))
-> Path s b (Dir d) -> [Path s b (Dir d)]
forall a. (a -> a) -> a -> [a]
iterate Path s b (Dir d) -> Path s b (Dir d)
forall s b t d. Path s b t -> Path s b (Dir d)
parent Path s b (Dir d)
lsp [Path s b (Dir d)] -> Int -> Path s b (Dir d)
forall a. [a] -> Int -> a
!! RelPathPrefix -> Int
prefixNumParentDirs RelPathPrefix
rprefix
   in Path Rel Dir -> RelPathPrefix -> Path s b t
forall s b t. Path Rel Dir -> RelPathPrefix -> Path s b t
RelDir (Path Rel Dir
lp' Path Rel Dir -> Path Rel Dir -> Path Rel Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
P.</> Path Rel Dir
rp) RelPathPrefix
lprefix'
lsp :: Path s b (Dir d)
lsp@(AbsDir Path Abs Dir
_) </> (RelFile Path Rel File
rp RelPathPrefix
rprefix) =
  let (AbsDir Path Abs Dir
lp') = (Path s b (Dir d) -> Path s b (Dir d))
-> Path s b (Dir d) -> [Path s b (Dir d)]
forall a. (a -> a) -> a -> [a]
iterate Path s b (Dir d) -> Path s b (Dir d)
forall s b t d. Path s b t -> Path s b (Dir d)
parent Path s b (Dir d)
lsp [Path s b (Dir d)] -> Int -> Path s b (Dir d)
forall a. [a] -> Int -> a
!! RelPathPrefix -> Int
prefixNumParentDirs RelPathPrefix
rprefix
   in Path Abs File -> Path s b t
forall s b t. Path Abs File -> Path s b t
AbsFile (Path Abs Dir
lp' Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
P.</> Path Rel File
rp)
lsp :: Path s b (Dir d)
lsp@(AbsDir Path Abs Dir
_) </> (RelDir Path Rel Dir
rp RelPathPrefix
rprefix) =
  let (AbsDir Path Abs Dir
lp') = (Path s b (Dir d) -> Path s b (Dir d))
-> Path s b (Dir d) -> [Path s b (Dir d)]
forall a. (a -> a) -> a -> [a]
iterate Path s b (Dir d) -> Path s b (Dir d)
forall s b t d. Path s b t -> Path s b (Dir d)
parent Path s b (Dir d)
lsp [Path s b (Dir d)] -> Int -> Path s b (Dir d)
forall a. [a] -> Int -> a
!! RelPathPrefix -> Int
prefixNumParentDirs RelPathPrefix
rprefix
   in Path Abs Dir -> Path s b t
forall s b t. Path Abs Dir -> Path s b t
AbsDir (Path Abs Dir
lp' Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
P.</> Path Rel Dir
rp)
---- Windows
lsp :: Path s b (Dir d)
lsp@(RelDirW Path Rel Dir
_ RelPathPrefix
_) </> (RelFileW Path Rel File
rp RelPathPrefix
rprefix) =
  let (RelDirW Path Rel Dir
lp' RelPathPrefix
lprefix') = (Path s b (Dir d) -> Path s b (Dir d))
-> Path s b (Dir d) -> [Path s b (Dir d)]
forall a. (a -> a) -> a -> [a]
iterate Path s b (Dir d) -> Path s b (Dir d)
forall s b t d. Path s b t -> Path s b (Dir d)
parent Path s b (Dir d)
lsp [Path s b (Dir d)] -> Int -> Path s b (Dir d)
forall a. [a] -> Int -> a
!! RelPathPrefix -> Int
prefixNumParentDirs RelPathPrefix
rprefix
   in Path Rel File -> RelPathPrefix -> Path s b t
forall s b t. Path Rel File -> RelPathPrefix -> Path s b t
RelFileW (Path Rel Dir
lp' Path Rel Dir -> Path Rel File -> Path Rel File
forall b t. Path b Dir -> Path Rel t -> Path b t
PW.</> Path Rel File
rp) RelPathPrefix
lprefix'
lsp :: Path s b (Dir d)
lsp@(RelDirW Path Rel Dir
_ RelPathPrefix
_) </> (RelDirW Path Rel Dir
rp RelPathPrefix
rprefix) =
  let (RelDirW Path Rel Dir
lp' RelPathPrefix
lprefix') = (Path s b (Dir d) -> Path s b (Dir d))
-> Path s b (Dir d) -> [Path s b (Dir d)]
forall a. (a -> a) -> a -> [a]
iterate Path s b (Dir d) -> Path s b (Dir d)
forall s b t d. Path s b t -> Path s b (Dir d)
parent Path s b (Dir d)
lsp [Path s b (Dir d)] -> Int -> Path s b (Dir d)
forall a. [a] -> Int -> a
!! RelPathPrefix -> Int
prefixNumParentDirs RelPathPrefix
rprefix
   in Path Rel Dir -> RelPathPrefix -> Path s b t
forall s b t. Path Rel Dir -> RelPathPrefix -> Path s b t
RelDirW (Path Rel Dir
lp' Path Rel Dir -> Path Rel Dir -> Path Rel Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
PW.</> Path Rel Dir
rp) RelPathPrefix
lprefix'
lsp :: Path s b (Dir d)
lsp@(AbsDirW Path Abs Dir
_) </> (RelFileW Path Rel File
rp RelPathPrefix
rprefix) =
  let (AbsDirW Path Abs Dir
lp') = (Path s b (Dir d) -> Path s b (Dir d))
-> Path s b (Dir d) -> [Path s b (Dir d)]
forall a. (a -> a) -> a -> [a]
iterate Path s b (Dir d) -> Path s b (Dir d)
forall s b t d. Path s b t -> Path s b (Dir d)
parent Path s b (Dir d)
lsp [Path s b (Dir d)] -> Int -> Path s b (Dir d)
forall a. [a] -> Int -> a
!! RelPathPrefix -> Int
prefixNumParentDirs RelPathPrefix
rprefix
   in Path Abs File -> Path s b t
forall s b t. Path Abs File -> Path s b t
AbsFileW (Path Abs Dir
lp' Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
PW.</> Path Rel File
rp)
lsp :: Path s b (Dir d)
lsp@(AbsDirW Path Abs Dir
_) </> (RelDirW Path Rel Dir
rp RelPathPrefix
rprefix) =
  let (AbsDirW Path Abs Dir
lp') = (Path s b (Dir d) -> Path s b (Dir d))
-> Path s b (Dir d) -> [Path s b (Dir d)]
forall a. (a -> a) -> a -> [a]
iterate Path s b (Dir d) -> Path s b (Dir d)
forall s b t d. Path s b t -> Path s b (Dir d)
parent Path s b (Dir d)
lsp [Path s b (Dir d)] -> Int -> Path s b (Dir d)
forall a. [a] -> Int -> a
!! RelPathPrefix -> Int
prefixNumParentDirs RelPathPrefix
rprefix
   in Path Abs Dir -> Path s b t
forall s b t. Path Abs Dir -> Path s b t
AbsDirW (Path Abs Dir
lp' Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
PW.</> Path Rel Dir
rp)
---- Posix
lsp :: Path s b (Dir d)
lsp@(RelDirP Path Rel Dir
_ RelPathPrefix
_) </> (RelFileP Path Rel File
rp RelPathPrefix
rprefix) =
  let (RelDirP Path Rel Dir
lp' RelPathPrefix
lprefix') = (Path s b (Dir d) -> Path s b (Dir d))
-> Path s b (Dir d) -> [Path s b (Dir d)]
forall a. (a -> a) -> a -> [a]
iterate Path s b (Dir d) -> Path s b (Dir d)
forall s b t d. Path s b t -> Path s b (Dir d)
parent Path s b (Dir d)
lsp [Path s b (Dir d)] -> Int -> Path s b (Dir d)
forall a. [a] -> Int -> a
!! RelPathPrefix -> Int
prefixNumParentDirs RelPathPrefix
rprefix
   in Path Rel File -> RelPathPrefix -> Path s b t
forall s b t. Path Rel File -> RelPathPrefix -> Path s b t
RelFileP (Path Rel Dir
lp' Path Rel Dir -> Path Rel File -> Path Rel File
forall b t. Path b Dir -> Path Rel t -> Path b t
PP.</> Path Rel File
rp) RelPathPrefix
lprefix'
lsp :: Path s b (Dir d)
lsp@(RelDirP Path Rel Dir
_ RelPathPrefix
_) </> (RelDirP Path Rel Dir
rp RelPathPrefix
rprefix) =
  let (RelDirP Path Rel Dir
lp' RelPathPrefix
lprefix') = (Path s b (Dir d) -> Path s b (Dir d))
-> Path s b (Dir d) -> [Path s b (Dir d)]
forall a. (a -> a) -> a -> [a]
iterate Path s b (Dir d) -> Path s b (Dir d)
forall s b t d. Path s b t -> Path s b (Dir d)
parent Path s b (Dir d)
lsp [Path s b (Dir d)] -> Int -> Path s b (Dir d)
forall a. [a] -> Int -> a
!! RelPathPrefix -> Int
prefixNumParentDirs RelPathPrefix
rprefix
   in Path Rel Dir -> RelPathPrefix -> Path s b t
forall s b t. Path Rel Dir -> RelPathPrefix -> Path s b t
RelDirP (Path Rel Dir
lp' Path Rel Dir -> Path Rel Dir -> Path Rel Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
PP.</> Path Rel Dir
rp) RelPathPrefix
lprefix'
lsp :: Path s b (Dir d)
lsp@(AbsDirP Path Abs Dir
_) </> (RelFileP Path Rel File
rp RelPathPrefix
rprefix) =
  let (AbsDirP Path Abs Dir
lp') = (Path s b (Dir d) -> Path s b (Dir d))
-> Path s b (Dir d) -> [Path s b (Dir d)]
forall a. (a -> a) -> a -> [a]
iterate Path s b (Dir d) -> Path s b (Dir d)
forall s b t d. Path s b t -> Path s b (Dir d)
parent Path s b (Dir d)
lsp [Path s b (Dir d)] -> Int -> Path s b (Dir d)
forall a. [a] -> Int -> a
!! RelPathPrefix -> Int
prefixNumParentDirs RelPathPrefix
rprefix
   in Path Abs File -> Path s b t
forall s b t. Path Abs File -> Path s b t
AbsFileP (Path Abs Dir
lp' Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
PP.</> Path Rel File
rp)
lsp :: Path s b (Dir d)
lsp@(AbsDirP Path Abs Dir
_) </> (RelDirP Path Rel Dir
rp RelPathPrefix
rprefix) =
  let (AbsDirP Path Abs Dir
lp') = (Path s b (Dir d) -> Path s b (Dir d))
-> Path s b (Dir d) -> [Path s b (Dir d)]
forall a. (a -> a) -> a -> [a]
iterate Path s b (Dir d) -> Path s b (Dir d)
forall s b t d. Path s b t -> Path s b (Dir d)
parent Path s b (Dir d)
lsp [Path s b (Dir d)] -> Int -> Path s b (Dir d)
forall a. [a] -> Int -> a
!! RelPathPrefix -> Int
prefixNumParentDirs RelPathPrefix
rprefix
   in Path Abs Dir -> Path s b t
forall s b t. Path Abs Dir -> Path s b t
AbsDirP (Path Abs Dir
lp' Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
PP.</> Path Rel Dir
rp)
Path s b (Dir d)
_ </> Path s (Rel d) t
_ = Path s b t
forall a. a
impossible

-- | Returns the most right member of the path once split by separators.
-- If path is pointing to file, basename will be name of the file.
-- If path is pointing to a directory, basename will be name of the directory.
-- Check examples below to see how are special paths like @..@, @.@, @\/@ and similar resolved.
--
-- Examples (pseudocode):
-- > basename "/a/b/c" == "c"
-- > basename "file.txt" == "file.txt"
-- > basename "../file.txt" == "file.txt"
-- > basename "../.." == ".."
-- > basename ".." == ".."
-- > basename "." == "."
-- > basename "/" == "."
basename :: Path s b t -> Path s (Rel d) t
-- System
basename :: Path s b t -> Path s (Rel d) t
basename (RelDir Path Rel Dir
p RelPathPrefix
pr) =
  if Path Rel Dir
p Path Rel Dir -> Path Rel Dir -> Bool
forall a. Eq a => a -> a -> Bool
== [P.reldir|.|] Bool -> Bool -> Bool
&& RelPathPrefix
pr RelPathPrefix -> RelPathPrefix -> Bool
forall a. Eq a => a -> a -> Bool
/= RelPathPrefix
NoPrefix
    then Path Rel Dir -> RelPathPrefix -> Path s (Rel d) t
forall s b t. Path Rel Dir -> RelPathPrefix -> Path s b t
RelDir Path Rel Dir
p (Int -> RelPathPrefix
ParentDir Int
1)
    else Path Rel Dir -> RelPathPrefix -> Path s (Rel d) t
forall s b t. Path Rel Dir -> RelPathPrefix -> Path s b t
RelDir (Path Rel Dir -> Path Rel Dir
forall b. Path b Dir -> Path Rel Dir
P.dirname Path Rel Dir
p) RelPathPrefix
NoPrefix
basename (RelFile Path Rel File
p RelPathPrefix
_) = Path Rel File -> RelPathPrefix -> Path s (Rel d) t
forall s b t. Path Rel File -> RelPathPrefix -> Path s b t
RelFile (Path Rel File -> Path Rel File
forall b. Path b File -> Path Rel File
P.filename Path Rel File
p) RelPathPrefix
NoPrefix
basename (AbsDir Path Abs Dir
p) = Path Rel Dir -> RelPathPrefix -> Path s (Rel d) t
forall s b t. Path Rel Dir -> RelPathPrefix -> Path s b t
RelDir (Path Abs Dir -> Path Rel Dir
forall b. Path b Dir -> Path Rel Dir
P.dirname Path Abs Dir
p) RelPathPrefix
NoPrefix
basename (AbsFile Path Abs File
p) = Path Rel File -> RelPathPrefix -> Path s (Rel d) t
forall s b t. Path Rel File -> RelPathPrefix -> Path s b t
RelFile (Path Abs File -> Path Rel File
forall b. Path b File -> Path Rel File
P.filename Path Abs File
p) RelPathPrefix
NoPrefix
-- Posix
basename (RelDirP Path Rel Dir
p RelPathPrefix
pr) =
  if Path Rel Dir
p Path Rel Dir -> Path Rel Dir -> Bool
forall a. Eq a => a -> a -> Bool
== [PP.reldir|.|] Bool -> Bool -> Bool
&& RelPathPrefix
pr RelPathPrefix -> RelPathPrefix -> Bool
forall a. Eq a => a -> a -> Bool
/= RelPathPrefix
NoPrefix
    then Path Rel Dir -> RelPathPrefix -> Path s (Rel d) t
forall s b t. Path Rel Dir -> RelPathPrefix -> Path s b t
RelDirP Path Rel Dir
p (Int -> RelPathPrefix
ParentDir Int
1)
    else Path Rel Dir -> RelPathPrefix -> Path s (Rel d) t
forall s b t. Path Rel Dir -> RelPathPrefix -> Path s b t
RelDirP (Path Rel Dir -> Path Rel Dir
forall b. Path b Dir -> Path Rel Dir
PP.dirname Path Rel Dir
p) RelPathPrefix
NoPrefix
basename (RelFileP Path Rel File
p RelPathPrefix
_) = Path Rel File -> RelPathPrefix -> Path s (Rel d) t
forall s b t. Path Rel File -> RelPathPrefix -> Path s b t
RelFileP (Path Rel File -> Path Rel File
forall b. Path b File -> Path Rel File
PP.filename Path Rel File
p) RelPathPrefix
NoPrefix
basename (AbsDirP Path Abs Dir
p) = Path Rel Dir -> RelPathPrefix -> Path s (Rel d) t
forall s b t. Path Rel Dir -> RelPathPrefix -> Path s b t
RelDirP (Path Abs Dir -> Path Rel Dir
forall b. Path b Dir -> Path Rel Dir
PP.dirname Path Abs Dir
p) RelPathPrefix
NoPrefix
basename (AbsFileP Path Abs File
p) = Path Rel File -> RelPathPrefix -> Path s (Rel d) t
forall s b t. Path Rel File -> RelPathPrefix -> Path s b t
RelFileP (Path Abs File -> Path Rel File
forall b. Path b File -> Path Rel File
PP.filename Path Abs File
p) RelPathPrefix
NoPrefix
-- Windows
basename (RelDirW Path Rel Dir
p RelPathPrefix
pr) =
  if Path Rel Dir
p Path Rel Dir -> Path Rel Dir -> Bool
forall a. Eq a => a -> a -> Bool
== [PW.reldir|.|] Bool -> Bool -> Bool
&& RelPathPrefix
pr RelPathPrefix -> RelPathPrefix -> Bool
forall a. Eq a => a -> a -> Bool
/= RelPathPrefix
NoPrefix
    then Path Rel Dir -> RelPathPrefix -> Path s (Rel d) t
forall s b t. Path Rel Dir -> RelPathPrefix -> Path s b t
RelDirW Path Rel Dir
p (Int -> RelPathPrefix
ParentDir Int
1)
    else Path Rel Dir -> RelPathPrefix -> Path s (Rel d) t
forall s b t. Path Rel Dir -> RelPathPrefix -> Path s b t
RelDirW (Path Rel Dir -> Path Rel Dir
forall b. Path b Dir -> Path Rel Dir
PW.dirname Path Rel Dir
p) RelPathPrefix
NoPrefix
basename (RelFileW Path Rel File
p RelPathPrefix
_) = Path Rel File -> RelPathPrefix -> Path s (Rel d) t
forall s b t. Path Rel File -> RelPathPrefix -> Path s b t
RelFileW (Path Rel File -> Path Rel File
forall b. Path b File -> Path Rel File
PW.filename Path Rel File
p) RelPathPrefix
NoPrefix
basename (AbsDirW Path Abs Dir
p) = Path Rel Dir -> RelPathPrefix -> Path s (Rel d) t
forall s b t. Path Rel Dir -> RelPathPrefix -> Path s b t
RelDirW (Path Abs Dir -> Path Rel Dir
forall b. Path b Dir -> Path Rel Dir
PW.dirname Path Abs Dir
p) RelPathPrefix
NoPrefix
basename (AbsFileW Path Abs File
p) = Path Rel File -> RelPathPrefix -> Path s (Rel d) t
forall s b t. Path Rel File -> RelPathPrefix -> Path s b t
RelFileW (Path Abs File -> Path Rel File
forall b. Path b File -> Path Rel File
PW.filename Path Abs File
p) RelPathPrefix
NoPrefix

-- | Enables you to redefine which dir is the path relative to.
castRel :: Path s (Rel d1) a -> Path s (Rel d2) a
---- System
castRel :: Path s (Rel d1) a -> Path s (Rel d2) a
castRel (RelDir Path Rel Dir
p RelPathPrefix
pr) = Path Rel Dir -> RelPathPrefix -> Path s (Rel d2) a
forall s b t. Path Rel Dir -> RelPathPrefix -> Path s b t
RelDir Path Rel Dir
p RelPathPrefix
pr
castRel (RelFile Path Rel File
p RelPathPrefix
pr) = Path Rel File -> RelPathPrefix -> Path s (Rel d2) a
forall s b t. Path Rel File -> RelPathPrefix -> Path s b t
RelFile Path Rel File
p RelPathPrefix
pr
---- Windows
castRel (RelDirW Path Rel Dir
p RelPathPrefix
pr) = Path Rel Dir -> RelPathPrefix -> Path s (Rel d2) a
forall s b t. Path Rel Dir -> RelPathPrefix -> Path s b t
RelDirW Path Rel Dir
p RelPathPrefix
pr
castRel (RelFileW Path Rel File
p RelPathPrefix
pr) = Path Rel File -> RelPathPrefix -> Path s (Rel d2) a
forall s b t. Path Rel File -> RelPathPrefix -> Path s b t
RelFileW Path Rel File
p RelPathPrefix
pr
---- Posix
castRel (RelDirP Path Rel Dir
p RelPathPrefix
pr) = Path Rel Dir -> RelPathPrefix -> Path s (Rel d2) a
forall s b t. Path Rel Dir -> RelPathPrefix -> Path s b t
RelDirP Path Rel Dir
p RelPathPrefix
pr
castRel (RelFileP Path Rel File
p RelPathPrefix
pr) = Path Rel File -> RelPathPrefix -> Path s (Rel d2) a
forall s b t. Path Rel File -> RelPathPrefix -> Path s b t
RelFileP Path Rel File
p RelPathPrefix
pr
castRel Path s (Rel d1) a
_ = Path s (Rel d2) a
forall a. a
impossible

-- | Enables you to rename the dir.
castDir :: Path s a (Dir d1) -> Path s a (Dir d2)
---- System
castDir :: Path s a (Dir d1) -> Path s a (Dir d2)
castDir (AbsDir Path Abs Dir
p) = Path Abs Dir -> Path s a (Dir d2)
forall s b t. Path Abs Dir -> Path s b t
AbsDir Path Abs Dir
p
castDir (RelDir Path Rel Dir
p RelPathPrefix
pr) = Path Rel Dir -> RelPathPrefix -> Path s a (Dir d2)
forall s b t. Path Rel Dir -> RelPathPrefix -> Path s b t
RelDir Path Rel Dir
p RelPathPrefix
pr
---- Windows
castDir (AbsDirW Path Abs Dir
p) = Path Abs Dir -> Path s a (Dir d2)
forall s b t. Path Abs Dir -> Path s b t
AbsDirW Path Abs Dir
p
castDir (RelDirW Path Rel Dir
p RelPathPrefix
pr) = Path Rel Dir -> RelPathPrefix -> Path s a (Dir d2)
forall s b t. Path Rel Dir -> RelPathPrefix -> Path s b t
RelDirW Path Rel Dir
p RelPathPrefix
pr
---- Posix
castDir (AbsDirP Path Abs Dir
p) = Path Abs Dir -> Path s a (Dir d2)
forall s b t. Path Abs Dir -> Path s b t
AbsDirP Path Abs Dir
p
castDir (RelDirP Path Rel Dir
p RelPathPrefix
pr) = Path Rel Dir -> RelPathPrefix -> Path s a (Dir d2)
forall s b t. Path Rel Dir -> RelPathPrefix -> Path s b t
RelDirP Path Rel Dir
p RelPathPrefix
pr
castDir Path s a (Dir d1)
_ = Path s a (Dir d2)
forall a. a
impossible

-- | Enables you to rename the file.
castFile :: Path s a (File f1) -> Path s a (File f2)
---- System
castFile :: Path s a (File f1) -> Path s a (File f2)
castFile (AbsFile Path Abs File
p) = Path Abs File -> Path s a (File f2)
forall s b t. Path Abs File -> Path s b t
AbsFile Path Abs File
p
castFile (RelFile Path Rel File
p RelPathPrefix
pr) = Path Rel File -> RelPathPrefix -> Path s a (File f2)
forall s b t. Path Rel File -> RelPathPrefix -> Path s b t
RelFile Path Rel File
p RelPathPrefix
pr
---- Windows
castFile (AbsFileW Path Abs File
p) = Path Abs File -> Path s a (File f2)
forall s b t. Path Abs File -> Path s b t
AbsFileW Path Abs File
p
castFile (RelFileW Path Rel File
p RelPathPrefix
pr) = Path Rel File -> RelPathPrefix -> Path s a (File f2)
forall s b t. Path Rel File -> RelPathPrefix -> Path s b t
RelFileW Path Rel File
p RelPathPrefix
pr
---- Posix
castFile (AbsFileP Path Abs File
p) = Path Abs File -> Path s a (File f2)
forall s b t. Path Abs File -> Path s b t
AbsFileP Path Abs File
p
castFile (RelFileP Path Rel File
p RelPathPrefix
pr) = Path Rel File -> RelPathPrefix -> Path s a (File f2)
forall s b t. Path Rel File -> RelPathPrefix -> Path s b t
RelFileP Path Rel File
p RelPathPrefix
pr
castFile Path s a (File f1)
_ = Path s a (File f2)
forall a. a
impossible

-- TODO: I was not able to unite these two functions (`relDirToPosix` and `relFileToPosix`) into just `toPosix``
--   because Haskell did not believe me that I would be returning same "t" (Dir/File) in Path
--   as was in first argument. I wonder if there is easy way to go around that or if
--   we have to redo significant part of the StrongPath to be able to do smth like this.

-- | Converts relative dir path to posix by replacing current path separators with posix path separators.
-- If path is already posix, it will not change.
--
-- Works well for \"normal\" relative paths like @\"a\\b\\c\"@ (Win) or @\"a\/b\/c\"@ (Posix).
-- If path is weird but still considered relative, like just @\"C:\"@ on Win,
-- results can be unexpected, most likely resulting with error thrown.
relDirToPosix :: MonadThrow m => Path s (Rel d1) (Dir d2) -> m (Path Posix (Rel d1) (Dir d2))
relDirToPosix :: Path s (Rel d1) (Dir d2) -> m (Path Posix (Rel d1) (Dir d2))
relDirToPosix sp :: Path s (Rel d1) (Dir d2)
sp@(RelDir Path Rel Dir
_ RelPathPrefix
_) = [Char] -> m (Path Posix (Rel d1) (Dir d2))
forall (m :: * -> *) d1 d2.
MonadThrow m =>
[Char] -> m (Path Posix (Rel d1) (Dir d2))
parseRelDirP ([Char] -> m (Path Posix (Rel d1) (Dir d2)))
-> [Char] -> m (Path Posix (Rel d1) (Dir d2))
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
FPP.joinPath ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]]
FP.splitDirectories ([Char] -> [[Char]]) -> [Char] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ Path s (Rel d1) (Dir d2) -> [Char]
forall s b t. Path s b t -> [Char]
toFilePath Path s (Rel d1) (Dir d2)
sp
relDirToPosix sp :: Path s (Rel d1) (Dir d2)
sp@(RelDirW Path Rel Dir
_ RelPathPrefix
_) = [Char] -> m (Path Posix (Rel d1) (Dir d2))
forall (m :: * -> *) d1 d2.
MonadThrow m =>
[Char] -> m (Path Posix (Rel d1) (Dir d2))
parseRelDirP ([Char] -> m (Path Posix (Rel d1) (Dir d2)))
-> [Char] -> m (Path Posix (Rel d1) (Dir d2))
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
FPP.joinPath ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]]
FPW.splitDirectories ([Char] -> [[Char]]) -> [Char] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ Path s (Rel d1) (Dir d2) -> [Char]
forall s b t. Path s b t -> [Char]
toFilePath Path s (Rel d1) (Dir d2)
sp
relDirToPosix (RelDirP Path Rel Dir
p RelPathPrefix
pr) = Path Posix (Rel d1) (Dir d2) -> m (Path Posix (Rel d1) (Dir d2))
forall (m :: * -> *) a. Monad m => a -> m a
return (Path Posix (Rel d1) (Dir d2) -> m (Path Posix (Rel d1) (Dir d2)))
-> Path Posix (Rel d1) (Dir d2) -> m (Path Posix (Rel d1) (Dir d2))
forall a b. (a -> b) -> a -> b
$ Path Rel Dir -> RelPathPrefix -> Path Posix (Rel d1) (Dir d2)
forall s b t. Path Rel Dir -> RelPathPrefix -> Path s b t
RelDirP Path Rel Dir
p RelPathPrefix
pr
relDirToPosix Path s (Rel d1) (Dir d2)
_ = m (Path Posix (Rel d1) (Dir d2))
forall a. a
impossible

-- | Converts relative file path to posix, if it is not already posix.
-- Check 'relDirToPosix' for more details, they behave the same.
relFileToPosix :: MonadThrow m => Path s (Rel d1) (File f) -> m (Path Posix (Rel d1) (File f))
relFileToPosix :: Path s (Rel d1) (File f) -> m (Path Posix (Rel d1) (File f))
relFileToPosix sp :: Path s (Rel d1) (File f)
sp@(RelFile Path Rel File
_ RelPathPrefix
_) = [Char] -> m (Path Posix (Rel d1) (File f))
forall (m :: * -> *) d f.
MonadThrow m =>
[Char] -> m (Path Posix (Rel d) (File f))
parseRelFileP ([Char] -> m (Path Posix (Rel d1) (File f)))
-> [Char] -> m (Path Posix (Rel d1) (File f))
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
FPP.joinPath ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]]
FP.splitDirectories ([Char] -> [[Char]]) -> [Char] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ Path s (Rel d1) (File f) -> [Char]
forall s b t. Path s b t -> [Char]
toFilePath Path s (Rel d1) (File f)
sp
relFileToPosix sp :: Path s (Rel d1) (File f)
sp@(RelFileW Path Rel File
_ RelPathPrefix
_) = [Char] -> m (Path Posix (Rel d1) (File f))
forall (m :: * -> *) d f.
MonadThrow m =>
[Char] -> m (Path Posix (Rel d) (File f))
parseRelFileP ([Char] -> m (Path Posix (Rel d1) (File f)))
-> [Char] -> m (Path Posix (Rel d1) (File f))
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
FPP.joinPath ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]]
FPW.splitDirectories ([Char] -> [[Char]]) -> [Char] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ Path s (Rel d1) (File f) -> [Char]
forall s b t. Path s b t -> [Char]
toFilePath Path s (Rel d1) (File f)
sp
relFileToPosix (RelFileP Path Rel File
p RelPathPrefix
pr) = Path Posix (Rel d1) (File f) -> m (Path Posix (Rel d1) (File f))
forall (m :: * -> *) a. Monad m => a -> m a
return (Path Posix (Rel d1) (File f) -> m (Path Posix (Rel d1) (File f)))
-> Path Posix (Rel d1) (File f) -> m (Path Posix (Rel d1) (File f))
forall a b. (a -> b) -> a -> b
$ Path Rel File -> RelPathPrefix -> Path Posix (Rel d1) (File f)
forall s b t. Path Rel File -> RelPathPrefix -> Path s b t
RelFileP Path Rel File
p RelPathPrefix
pr
relFileToPosix Path s (Rel d1) (File f)
_ = m (Path Posix (Rel d1) (File f))
forall a. a
impossible