{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
-- | This module provides type-safe access to filepath manipulations.
--
--   Normally you would import 'System.Path' (which will use the
--   default implementation for the host platform) instead of this.
--   However, importing this explicitly allows for manipulation of
--   non-native paths.
--
module System.Path.Posix (
    Path,
    AbsFile, RelFile, AbsDir, RelDir,
    Abs, Rel, File, Dir,
    AbsRelFile, AbsRelDir, AbsFileDir, RelFileDir,
    AbsRel, FileDir, AbsRelFileDir,
    AbsPath, RelPath, FilePath, DirPath,
    AbsRelPath, FileDirPath,
    asPath,
    asRelFile, asRelDir, asAbsFile, asAbsDir,
    asRelPath, asAbsPath, asFilePath, asDirPath,
    path, maybe, maybePath, parse, parsePath,
    relFile, relDir, absFile, absDir,
    abs, rel, absRel, file, dir, fileDir,
    relPath, absPath, filePath, dirPath,
    rootDir, currentDir, emptyFile,
    toString,
    isAbsoluteString, isRelativeString, equalFilePath,
    pathSeparator, pathSeparators, isPathSeparator,
    Core.extSeparator, Core.isExtSeparator,
    Core.searchPathSeparator, Core.isSearchPathSeparator,
    addTrailingPathSeparator, dropTrailingPathSeparator,
    hasTrailingPathSeparator,
    testAll,
    ) where

import qualified System.Path.RegularExpression as RegEx
import qualified System.Path.Internal.PartClass as Class
import qualified System.Path.Internal as Core

import Data.Tagged (Tagged(Tagged), untag)

import qualified Test.DocTest.Driver as DocTest

import Prelude hiding (FilePath, maybe, abs)


data Posix = Posix

_osDummy :: Posix
_osDummy :: Posix
_osDummy = Posix
Posix

type System = Posix

type Path = Core.Path System

type AbsFile = Core.AbsFile System
type RelFile = Core.RelFile System
type AbsDir  = Core.AbsDir  System
type RelDir  = Core.RelDir  System
type AbsRelFile = Core.AbsRelFile System
type AbsRelDir  = Core.AbsRelDir  System
type AbsFileDir = Core.AbsFileDir System
type RelFileDir = Core.RelFileDir System
type AbsRelFileDir = Core.AbsRelFileDir System

type Abs  fd = Core.Abs  System fd
type Rel  fd = Core.Rel  System fd
type File ar = Core.File System ar
type Dir  ar = Core.Dir  System ar
type AbsRel  fd = Core.AbsRel  System fd
type FileDir ar = Core.FileDir System ar

type AbsPath  fd = Core.AbsPath  System fd
type RelPath  fd = Core.RelPath  System fd
type FilePath ar = Core.FilePath System ar
type DirPath  ar = Core.DirPath  System ar
type AbsRelPath  fd = Core.AbsRelPath  System fd
type FileDirPath ar = Core.FileDirPath System ar

{-# DEPRECATED asPath "Use 'maybePath', 'parsePath' or 'path' instead." #-}
asPath :: (Class.AbsOrRel ar, Class.FileOrDir fd) => String -> Path ar fd
asPath :: forall ar fd. (AbsOrRel ar, FileOrDir fd) => String -> Path ar fd
asPath = String -> Path Posix ar fd
forall os ar fd.
(System os, AbsRel ar, FileDir fd) =>
String -> Path os ar fd
Core.asPath

{-# DEPRECATED asRelFile "Use 'relFile' instead." #-}
asRelFile :: String -> RelFile
asRelFile :: String -> RelFile
asRelFile = String -> RelFile
forall os. System os => String -> RelFile os
Core.asRelFile

{-# DEPRECATED asRelDir "Use 'relDir' instead." #-}
asRelDir :: String -> RelDir
asRelDir :: String -> RelDir
asRelDir = String -> RelDir
forall os. System os => String -> RelDir os
Core.asRelDir

{-# DEPRECATED asAbsFile "Use 'absFile' instead." #-}
asAbsFile :: String -> AbsFile
asAbsFile :: String -> AbsFile
asAbsFile = String -> AbsFile
forall os. System os => String -> AbsFile os
Core.asAbsFile

{-# DEPRECATED asAbsDir "Use 'absDir' instead." #-}
asAbsDir :: String -> AbsDir
asAbsDir :: String -> AbsDir
asAbsDir = String -> AbsDir
forall os. System os => String -> AbsDir os
Core.asAbsDir

{-# DEPRECATED asRelPath "Use 'relPath' instead." #-}
asRelPath :: (Class.FileOrDir fd) => String -> RelPath fd
asRelPath :: forall fd. FileOrDir fd => String -> RelPath fd
asRelPath = String -> RelPath Posix fd
forall os fd. (System os, FileDir fd) => String -> RelPath os fd
Core.asRelPath

{-# DEPRECATED asAbsPath "Use 'absPath' instead." #-}
asAbsPath :: (Class.FileOrDir fd) => String -> AbsPath fd
asAbsPath :: forall fd. FileOrDir fd => String -> AbsPath fd
asAbsPath = String -> AbsPath Posix fd
forall os fd. (System os, FileDir fd) => String -> AbsPath os fd
Core.asAbsPath

{-# DEPRECATED asFilePath "Use 'filePath' instead." #-}
asFilePath :: (Class.AbsOrRel ar) => String -> FilePath ar
asFilePath :: forall ar. AbsOrRel ar => String -> FilePath ar
asFilePath = String -> FilePath Posix ar
forall os ar. (System os, AbsRel ar) => String -> FilePath os ar
Core.asFilePath

{-# DEPRECATED asDirPath "Use 'dirPath' instead." #-}
asDirPath :: (Class.AbsOrRel ar) => String -> DirPath ar
asDirPath :: forall ar. AbsOrRel ar => String -> DirPath ar
asDirPath = String -> DirPath Posix ar
forall os ar. (System os, AbsRel ar) => String -> DirPath os ar
Core.asDirPath


{-# DEPRECATED maybePath "Use Path.maybe instead." #-}
{-# DEPRECATED parsePath "Use Path.parse instead." #-}

maybe, maybePath ::
    (Class.AbsRel ar, Class.FileDir fd) => String -> Maybe (Path ar fd)
maybe :: forall ar fd.
(AbsRel ar, FileDir fd) =>
String -> Maybe (Path ar fd)
maybe = String -> Maybe (Path Posix ar fd)
forall os ar fd.
(System os, AbsRel ar, FileDir fd) =>
String -> Maybe (Path os ar fd)
Core.maybe
maybePath :: forall ar fd.
(AbsRel ar, FileDir fd) =>
String -> Maybe (Path ar fd)
maybePath = String -> Maybe (Path Posix ar fd)
forall os ar fd.
(System os, AbsRel ar, FileDir fd) =>
String -> Maybe (Path os ar fd)
Core.maybe

parse, parsePath ::
    (Class.AbsRel ar, Class.FileDir fd) => String -> Either String (Path ar fd)
parse :: forall ar fd.
(AbsRel ar, FileDir fd) =>
String -> Either String (Path ar fd)
parse = String -> Either String (Path Posix ar fd)
forall os ar fd.
(System os, AbsRel ar, FileDir fd) =>
String -> Either String (Path os ar fd)
Core.parse
parsePath :: forall ar fd.
(AbsRel ar, FileDir fd) =>
String -> Either String (Path ar fd)
parsePath = String -> Either String (Path Posix ar fd)
forall os ar fd.
(System os, AbsRel ar, FileDir fd) =>
String -> Either String (Path os ar fd)
Core.parse


path :: (Class.AbsRel ar, Class.FileDir fd) => String -> Path ar fd
path :: forall ar fd. (AbsRel ar, FileDir fd) => String -> Path ar fd
path = String -> Path Posix ar fd
forall os ar fd.
(System os, AbsRel ar, FileDir fd) =>
String -> Path os ar fd
Core.path

relFile :: String -> RelFile
relFile :: String -> RelFile
relFile = String -> RelFile
forall os. System os => String -> RelFile os
Core.relFile

relDir :: String -> RelDir
relDir :: String -> RelDir
relDir = String -> RelDir
forall os. System os => String -> RelDir os
Core.relDir

absFile :: String -> AbsFile
absFile :: String -> AbsFile
absFile = String -> AbsFile
forall os. System os => String -> AbsFile os
Core.absFile

absDir :: String -> AbsDir
absDir :: String -> AbsDir
absDir = String -> AbsDir
forall os. System os => String -> AbsDir os
Core.absDir


rel :: (Class.FileDir fd) => String -> Rel fd
rel :: forall fd. FileDir fd => String -> Rel fd
rel = String -> Rel Posix fd
forall os fd. (System os, FileDir fd) => String -> RelPath os fd
Core.rel

abs :: (Class.FileDir fd) => String -> Abs fd
abs :: forall fd. FileDir fd => String -> Abs fd
abs = String -> Abs Posix fd
forall os fd. (System os, FileDir fd) => String -> AbsPath os fd
Core.abs

absRel :: (Class.FileDir fd) => String -> AbsRel fd
absRel :: forall fd. FileDir fd => String -> AbsRel fd
absRel = String -> AbsRel Posix fd
forall os fd. (System os, FileDir fd) => String -> AbsRel os fd
Core.absRel

file :: (Class.AbsRel ar) => String -> File ar
file :: forall ar. AbsRel ar => String -> File ar
file = String -> File Posix ar
forall os ar. (System os, AbsRel ar) => String -> FilePath os ar
Core.file

dir :: (Class.AbsRel ar) => String -> Dir ar
dir :: forall ar. AbsRel ar => String -> Dir ar
dir = String -> Dir Posix ar
forall os ar. (System os, AbsRel ar) => String -> DirPath os ar
Core.dir

fileDir :: (Class.AbsRel ar) => String -> FileDir ar
fileDir :: forall ar. AbsRel ar => String -> FileDir ar
fileDir = String -> FileDir Posix ar
forall os ar. (System os, AbsRel ar) => String -> FileDir os ar
Core.fileDir


relPath :: (Class.FileDir fd) => String -> RelPath fd
relPath :: forall fd. FileDir fd => String -> Rel fd
relPath = String -> RelPath Posix fd
forall os fd. (System os, FileDir fd) => String -> RelPath os fd
Core.relPath

absPath :: (Class.FileDir fd) => String -> AbsPath fd
absPath :: forall fd. FileDir fd => String -> Abs fd
absPath = String -> AbsPath Posix fd
forall os fd. (System os, FileDir fd) => String -> AbsPath os fd
Core.absPath

filePath :: (Class.AbsRel ar) => String -> FilePath ar
filePath :: forall ar. AbsRel ar => String -> File ar
filePath = String -> FilePath Posix ar
forall os ar. (System os, AbsRel ar) => String -> FilePath os ar
Core.filePath

dirPath :: (Class.AbsRel ar) => String -> DirPath ar
dirPath :: forall ar. AbsRel ar => String -> Dir ar
dirPath = String -> DirPath Posix ar
forall os ar. (System os, AbsRel ar) => String -> DirPath os ar
Core.dirPath


rootDir :: AbsDir
rootDir :: AbsDir
rootDir = AbsDir
forall os. System os => AbsDir os
Core.rootDir

currentDir :: RelDir
currentDir :: RelDir
currentDir = RelDir
forall os. System os => RelDir os
Core.currentDir

emptyFile :: RelFile
emptyFile :: RelFile
emptyFile = RelFile
forall os. System os => RelFile os
Core.emptyFile


toString :: (Class.AbsRel ar, Class.FileDir fd) => Path ar fd -> String
toString :: forall ar fd. (AbsRel ar, FileDir fd) => Path ar fd -> String
toString = Path Posix ar fd -> String
forall os ar fd.
(System os, AbsRel ar, FileDir fd) =>
Path os ar fd -> String
Core.toString


instance Core.System Posix where
   pathSeparator :: Tagged Posix Char
pathSeparator = Char -> Tagged Posix Char
forall {k} (s :: k) b. b -> Tagged s b
Tagged Char
pathSeparator
   splitAbsolute :: Tagged Posix (State String String)
splitAbsolute = State String String -> Tagged Posix (State String String)
forall {k} (s :: k) b. b -> Tagged s b
Tagged (State String String -> Tagged Posix (State String String))
-> State String String -> Tagged Posix (State String String)
forall a b. (a -> b) -> a -> b
$ Parser Char -> State String String
forall a. Parser a -> State [a] [a]
RegEx.run (Parser Char -> State String String)
-> Parser Char -> State String String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Parser Char
forall a. (a -> Bool) -> Parser a
RegEx.single Char -> Bool
isPathSeparator
   canonicalize :: Tagged Posix (String -> String)
canonicalize = (String -> String) -> Tagged Posix (String -> String)
forall {k} (s :: k) b. b -> Tagged s b
Tagged String -> String
forall a. a -> a
id
   splitDrive :: Tagged Posix (State String String)
splitDrive = State String String -> Tagged Posix (State String String)
forall {k} (s :: k) b. b -> Tagged s b
Tagged (State String String -> Tagged Posix (State String String))
-> State String String -> Tagged Posix (State String String)
forall a b. (a -> b) -> a -> b
$ String -> State String String
forall a. a -> StateT String Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
   genDrive :: Tagged Posix (Gen String)
genDrive = Gen String -> Tagged Posix (Gen String)
forall {k} (s :: k) b. b -> Tagged s b
Tagged (Gen String -> Tagged Posix (Gen String))
-> Gen String -> Tagged Posix (Gen String)
forall a b. (a -> b) -> a -> b
$ String -> Gen String
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return String
""

withOS :: Tagged System a -> a
withOS :: forall a. Tagged Posix a -> a
withOS = Tagged Posix a -> a
forall {k} (s :: k) b. Tagged s b -> b
untag


{-# DEPRECATED equalFilePath "Use System.FilePath.equalFilePath instead." #-}
{-# DEPRECATED isAbsoluteString "Use System.FilePath.isAbsolute instead." #-}
{-# DEPRECATED isRelativeString "Use System.FilePath.isRelative instead." #-}

equalFilePath :: String -> String -> Bool
equalFilePath :: String -> String -> Bool
equalFilePath = Tagged Posix (String -> String -> Bool) -> String -> String -> Bool
forall a. Tagged Posix a -> a
withOS Tagged Posix (String -> String -> Bool)
forall os. System os => Tagged os (String -> String -> Bool)
Core.equalFilePath

isAbsoluteString :: String -> Bool
isAbsoluteString :: String -> Bool
isAbsoluteString = Tagged Posix (String -> Bool) -> String -> Bool
forall a. Tagged Posix a -> a
withOS Tagged Posix (String -> Bool)
forall os. System os => Tagged os (String -> Bool)
Core.isAbsoluteString

isRelativeString :: String -> Bool
isRelativeString :: String -> Bool
isRelativeString = Tagged Posix (String -> Bool) -> String -> Bool
forall a. Tagged Posix a -> a
withOS Tagged Posix (String -> Bool)
forall os. System os => Tagged os (String -> Bool)
Core.isRelativeString


pathSeparator :: Char
pathSeparator :: Char
pathSeparator = Char
'/'

pathSeparators :: [Char]
pathSeparators :: String
pathSeparators = Tagged Posix String -> String
forall a. Tagged Posix a -> a
withOS Tagged Posix String
forall os. System os => Tagged os String
Core.pathSeparators

isPathSeparator :: Char -> Bool
isPathSeparator :: Char -> Bool
isPathSeparator = Tagged Posix (Char -> Bool) -> Char -> Bool
forall a. Tagged Posix a -> a
withOS Tagged Posix (Char -> Bool)
forall os. System os => Tagged os (Char -> Bool)
Core.isPathSeparator


{-# DEPRECATED addTrailingPathSeparator "Use System.FilePath.addTrailingPathSeparator instead." #-}
{-# DEPRECATED dropTrailingPathSeparator "Use System.FilePath.dropTrailingPathSeparator instead." #-}
{-# DEPRECATED hasTrailingPathSeparator "Use System.FilePath.hasTrailingPathSeparator instead." #-}

-- | This is largely for 'System.FilePath' compatibility
addTrailingPathSeparator :: String -> String
addTrailingPathSeparator :: String -> String
addTrailingPathSeparator = (String -> String -> String
forall a. [a] -> [a] -> [a]
++[Char
pathSeparator])

-- | This is largely for 'System.FilePath' compatibility
dropTrailingPathSeparator :: String -> String
dropTrailingPathSeparator :: String -> String
dropTrailingPathSeparator = String -> String
forall a. HasCallStack => [a] -> [a]
init

-- | This is largely for 'System.FilePath' compatibility
hasTrailingPathSeparator :: String -> Bool
hasTrailingPathSeparator :: String -> Bool
hasTrailingPathSeparator = Char -> Bool
isPathSeparator (Char -> Bool) -> (String -> Char) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Char
forall a. HasCallStack => [a] -> a
last


testAll :: [(String, DocTest.T ())]
testAll :: [(String, T ())]
testAll = Posix -> [(String, T ())]
forall os. System os => os -> [(String, T ())]
Core.testAll Posix
Posix