module StrongPath.Path
  ( -- * Parsers (from "Path".'Path.Path' to 'StrongPath.Path')
    -- $parsersPath
    fromPathRelDir,
    fromPathRelFile,
    fromPathAbsDir,
    fromPathAbsFile,
    fromPathRelDirW,
    fromPathRelFileW,
    fromPathAbsDirW,
    fromPathAbsFileW,
    fromPathRelDirP,
    fromPathRelFileP,
    fromPathAbsDirP,
    fromPathAbsFileP,

    -- * Conversion (from 'StrongPath.Path' to "Path".'Path.Path')
    -- $conversionPath
    toPathRelDir,
    toPathRelFile,
    toPathAbsDir,
    toPathAbsFile,
    toPathRelDirW,
    toPathRelFileW,
    toPathAbsDirW,
    toPathAbsFileW,
    toPathRelDirP,
    toPathRelFileP,
    toPathAbsDirP,
    toPathAbsFileP,
  )
where

import qualified Path as P
import qualified Path.Posix as PP
import qualified Path.Windows as PW
import StrongPath.Internal

-- $parsersPath
-- Functions for parsing "Path" paths into "StrongPath" paths.

-- Constructors
fromPathRelDir :: P.Path P.Rel P.Dir -> Path System (Rel a) (Dir b)
fromPathRelFile :: P.Path P.Rel P.File -> Path System (Rel a) (File f)
fromPathAbsDir :: P.Path P.Abs P.Dir -> Path System Abs (Dir a)
fromPathAbsFile :: P.Path P.Abs P.File -> Path System Abs (File f)
fromPathRelDirW :: PW.Path PW.Rel PW.Dir -> Path Windows (Rel a) (Dir b)
fromPathRelFileW :: PW.Path PW.Rel PW.File -> Path Windows (Rel a) (File f)
fromPathAbsDirW :: PW.Path PW.Abs PW.Dir -> Path Windows Abs (Dir a)
fromPathAbsFileW :: PW.Path PW.Abs PW.File -> Path Windows Abs (File f)
fromPathRelDirP :: PP.Path PP.Rel PP.Dir -> Path Posix (Rel a) (Dir b)
fromPathRelFileP :: PP.Path PP.Rel PP.File -> Path Posix (Rel a) (File f)
fromPathAbsDirP :: PP.Path PP.Abs PP.Dir -> Path Posix Abs (Dir a)
fromPathAbsFileP :: PP.Path PP.Abs PP.File -> Path Posix Abs (File f)
---- System
fromPathRelDir :: Path Rel Dir -> Path System (Rel a) (Dir b)
fromPathRelDir Path Rel Dir
p = Path Rel Dir -> RelPathPrefix -> Path System (Rel a) (Dir b)
forall s b t. Path Rel Dir -> RelPathPrefix -> Path s b t
RelDir Path Rel Dir
p RelPathPrefix
NoPrefix

fromPathRelFile :: Path Rel File -> Path System (Rel a) (File f)
fromPathRelFile Path Rel File
p = Path Rel File -> RelPathPrefix -> Path System (Rel a) (File f)
forall s b t. Path Rel File -> RelPathPrefix -> Path s b t
RelFile Path Rel File
p RelPathPrefix
NoPrefix

fromPathAbsDir :: Path Abs Dir -> Path System Abs (Dir a)
fromPathAbsDir = Path Abs Dir -> Path System Abs (Dir a)
forall s b t. Path Abs Dir -> Path s b t
AbsDir

fromPathAbsFile :: Path Abs File -> Path System Abs (File f)
fromPathAbsFile = Path Abs File -> Path System Abs (File f)
forall s b t. Path Abs File -> Path s b t
AbsFile

---- Windows
fromPathRelDirW :: Path Rel Dir -> Path Windows (Rel a) (Dir b)
fromPathRelDirW Path Rel Dir
p = Path Rel Dir -> RelPathPrefix -> Path Windows (Rel a) (Dir b)
forall s b t. Path Rel Dir -> RelPathPrefix -> Path s b t
RelDirW Path Rel Dir
p RelPathPrefix
NoPrefix

fromPathRelFileW :: Path Rel File -> Path Windows (Rel a) (File f)
fromPathRelFileW Path Rel File
p = Path Rel File -> RelPathPrefix -> Path Windows (Rel a) (File f)
forall s b t. Path Rel File -> RelPathPrefix -> Path s b t
RelFileW Path Rel File
p RelPathPrefix
NoPrefix

fromPathAbsDirW :: Path Abs Dir -> Path Windows Abs (Dir a)
fromPathAbsDirW = Path Abs Dir -> Path Windows Abs (Dir a)
forall s b t. Path Abs Dir -> Path s b t
AbsDirW

fromPathAbsFileW :: Path Abs File -> Path Windows Abs (File f)
fromPathAbsFileW = Path Abs File -> Path Windows Abs (File f)
forall s b t. Path Abs File -> Path s b t
AbsFileW

---- Posix
fromPathRelDirP :: Path Rel Dir -> Path Posix (Rel a) (Dir b)
fromPathRelDirP Path Rel Dir
p = Path Rel Dir -> RelPathPrefix -> Path Posix (Rel a) (Dir b)
forall s b t. Path Rel Dir -> RelPathPrefix -> Path s b t
RelDirP Path Rel Dir
p RelPathPrefix
NoPrefix

fromPathRelFileP :: Path Rel File -> Path Posix (Rel a) (File f)
fromPathRelFileP Path Rel File
p = Path Rel File -> RelPathPrefix -> Path Posix (Rel a) (File f)
forall s b t. Path Rel File -> RelPathPrefix -> Path s b t
RelFileP Path Rel File
p RelPathPrefix
NoPrefix

fromPathAbsDirP :: Path Abs Dir -> Path Posix Abs (Dir a)
fromPathAbsDirP = Path Abs Dir -> Path Posix Abs (Dir a)
forall s b t. Path Abs Dir -> Path s b t
AbsDirP

fromPathAbsFileP :: Path Abs File -> Path Posix Abs (File f)
fromPathAbsFileP = Path Abs File -> Path Posix Abs (File f)
forall s b t. Path Abs File -> Path s b t
AbsFileP

-- $conversionPath
-- Functions for converting paths from "StrongPath" paths into "Path" paths.

-- TODO: Should I go with MonadThrow here instead of just throwing error? Probably!
--       I could, as error, return actual Path + info on how many ../ were there in StrongPath,
--       so user can recover from error and continue, if they wish.
-- Deconstructors
toPathRelDir :: Path System (Rel a) (Dir b) -> P.Path P.Rel P.Dir
toPathRelFile :: Path System (Rel a) (File f) -> P.Path P.Rel P.File
toPathAbsDir :: Path System Abs (Dir a) -> P.Path P.Abs P.Dir
toPathAbsFile :: Path System Abs (File f) -> P.Path P.Abs P.File
toPathRelDirW :: Path Windows (Rel a) (Dir b) -> PW.Path PW.Rel PW.Dir
toPathRelFileW :: Path Windows (Rel a) (File f) -> PW.Path PW.Rel PW.File
toPathAbsDirW :: Path Windows Abs (Dir a) -> PW.Path PW.Abs PW.Dir
toPathAbsFileW :: Path Windows Abs (File f) -> PW.Path PW.Abs PW.File
toPathRelDirP :: Path Posix (Rel a) (Dir b) -> PP.Path PP.Rel PP.Dir
toPathRelFileP :: Path Posix (Rel a) (File f) -> PP.Path PP.Rel PP.File
toPathAbsDirP :: Path Posix Abs (Dir a) -> PP.Path PP.Abs PP.Dir
toPathAbsFileP :: Path Posix Abs (File f) -> PP.Path PP.Abs PP.File
---- System
toPathRelDir :: Path System (Rel a) (Dir b) -> Path Rel Dir
toPathRelDir (RelDir Path Rel Dir
p RelPathPrefix
NoPrefix) = Path Rel Dir
p
toPathRelDir (RelDir Path Rel Dir
_ RelPathPrefix
_) = Path Rel Dir
forall a. a
relativeStrongPathWithPrefixToPathError
toPathRelDir Path System (Rel a) (Dir b)
_ = Path Rel Dir
forall a. a
impossible

toPathRelFile :: Path System (Rel a) (File f) -> Path Rel File
toPathRelFile (RelFile Path Rel File
p RelPathPrefix
NoPrefix) = Path Rel File
p
toPathRelFile (RelFile Path Rel File
_ RelPathPrefix
_) = Path Rel File
forall a. a
relativeStrongPathWithPrefixToPathError
toPathRelFile Path System (Rel a) (File f)
_ = Path Rel File
forall a. a
impossible

toPathAbsDir :: Path System Abs (Dir a) -> Path Abs Dir
toPathAbsDir (AbsDir Path Abs Dir
p) = Path Abs Dir
p
toPathAbsDir Path System Abs (Dir a)
_ = Path Abs Dir
forall a. a
impossible

toPathAbsFile :: Path System Abs (File f) -> Path Abs File
toPathAbsFile (AbsFile Path Abs File
p) = Path Abs File
p
toPathAbsFile Path System Abs (File f)
_ = Path Abs File
forall a. a
impossible

---- Windows
toPathRelDirW :: Path Windows (Rel a) (Dir b) -> Path Rel Dir
toPathRelDirW (RelDirW Path Rel Dir
p RelPathPrefix
NoPrefix) = Path Rel Dir
p
toPathRelDirW (RelDirW Path Rel Dir
_ RelPathPrefix
_) = Path Rel Dir
forall a. a
relativeStrongPathWithPrefixToPathError
toPathRelDirW Path Windows (Rel a) (Dir b)
_ = Path Rel Dir
forall a. a
impossible

toPathRelFileW :: Path Windows (Rel a) (File f) -> Path Rel File
toPathRelFileW (RelFileW Path Rel File
p RelPathPrefix
NoPrefix) = Path Rel File
p
toPathRelFileW (RelFileW Path Rel File
_ RelPathPrefix
_) = Path Rel File
forall a. a
relativeStrongPathWithPrefixToPathError
toPathRelFileW Path Windows (Rel a) (File f)
_ = Path Rel File
forall a. a
impossible

toPathAbsDirW :: Path Windows Abs (Dir a) -> Path Abs Dir
toPathAbsDirW (AbsDirW Path Abs Dir
p) = Path Abs Dir
p
toPathAbsDirW Path Windows Abs (Dir a)
_ = Path Abs Dir
forall a. a
impossible

toPathAbsFileW :: Path Windows Abs (File f) -> Path Abs File
toPathAbsFileW (AbsFileW Path Abs File
p) = Path Abs File
p
toPathAbsFileW Path Windows Abs (File f)
_ = Path Abs File
forall a. a
impossible

---- Posix
toPathRelDirP :: Path Posix (Rel a) (Dir b) -> Path Rel Dir
toPathRelDirP (RelDirP Path Rel Dir
p RelPathPrefix
NoPrefix) = Path Rel Dir
p
toPathRelDirP (RelDirP Path Rel Dir
_ RelPathPrefix
_) = Path Rel Dir
forall a. a
relativeStrongPathWithPrefixToPathError
toPathRelDirP Path Posix (Rel a) (Dir b)
_ = Path Rel Dir
forall a. a
impossible

toPathRelFileP :: Path Posix (Rel a) (File f) -> Path Rel File
toPathRelFileP (RelFileP Path Rel File
p RelPathPrefix
NoPrefix) = Path Rel File
p
toPathRelFileP (RelFileP Path Rel File
_ RelPathPrefix
_) = Path Rel File
forall a. a
relativeStrongPathWithPrefixToPathError
toPathRelFileP Path Posix (Rel a) (File f)
_ = Path Rel File
forall a. a
impossible

toPathAbsDirP :: Path Posix Abs (Dir a) -> Path Abs Dir
toPathAbsDirP (AbsDirP Path Abs Dir
p) = Path Abs Dir
p
toPathAbsDirP Path Posix Abs (Dir a)
_ = Path Abs Dir
forall a. a
impossible

toPathAbsFileP :: Path Posix Abs (File f) -> Path Abs File
toPathAbsFileP (AbsFileP Path Abs File
p) = Path Abs File
p
toPathAbsFileP Path Posix Abs (File f)
_ = Path Abs File
forall a. a
impossible

relativeStrongPathWithPrefixToPathError :: a
relativeStrongPathWithPrefixToPathError :: a
relativeStrongPathWithPrefixToPathError =
  [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"Relative StrongPath.Path with prefix can't be converted into Path.Path."