{-# 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.Windows (
    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 System.Path.RegularExpression ((-|-))

import Data.Tagged (Tagged(Tagged), untag)
import Data.Char (isAlpha, toLower)
import Data.Monoid (mempty, (<>))

import qualified Test.DocTest.Driver as DocTest
import qualified Test.QuickCheck as QC

import Prelude hiding (FilePath, maybe, abs)


data Windows = Windows

_osDummy :: Windows
_osDummy :: Windows
_osDummy = Windows
Windows

type System = Windows

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 Windows 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 Windows 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 Windows 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 Windows 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 Windows 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 Windows 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 Windows 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 Windows 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 Windows 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 Windows 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 Windows 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 Windows 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 Windows 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 Windows 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 Windows 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 Windows 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 Windows 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 Windows 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 Windows 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 Windows 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 Windows ar fd -> String
forall os ar fd.
(System os, AbsRel ar, FileDir fd) =>
Path os ar fd -> String
Core.toString


instance Core.System Windows where
   pathSeparator :: Tagged Windows Char
pathSeparator = Char -> Tagged Windows Char
forall {k} (s :: k) b. b -> Tagged s b
Tagged Char
pathSeparator
   splitAbsolute :: Tagged Windows (State String String)
splitAbsolute = State String String -> Tagged Windows (State String String)
forall {k} (s :: k) b. b -> Tagged s b
Tagged (State String String -> Tagged Windows (State String String))
-> State String String -> Tagged Windows (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
       Parser Char -> Parser Char -> Parser Char
forall a. Parser a -> Parser a -> Parser a
-|-
       Parser Char
driveRegEx Parser Char -> Parser Char -> Parser Char
forall a. Semigroup a => a -> a -> a
<> ((Char -> Bool) -> Parser Char
forall a. (a -> Bool) -> Parser a
RegEx.single Char -> Bool
isPathSeparator Parser Char -> Parser Char -> Parser Char
forall a. Parser a -> Parser a -> Parser a
-|- Parser Char
forall a. Monoid a => a
mempty)
   canonicalize :: Tagged Windows (String -> String)
canonicalize = (String -> String) -> Tagged Windows (String -> String)
forall {k} (s :: k) b. b -> Tagged s b
Tagged ((String -> String) -> Tagged Windows (String -> String))
-> (String -> String) -> Tagged Windows (String -> String)
forall a b. (a -> b) -> a -> b
$ (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower
   splitDrive :: Tagged Windows (State String String)
splitDrive = State String String -> Tagged Windows (State String String)
forall {k} (s :: k) b. b -> Tagged s b
Tagged (State String String -> Tagged Windows (State String String))
-> State String String -> Tagged Windows (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
driveRegEx
   genDrive :: Tagged Windows (Gen String)
genDrive = Gen String -> Tagged Windows (Gen String)
forall {k} (s :: k) b. b -> Tagged s b
Tagged (Gen String -> Tagged Windows (Gen String))
-> Gen String -> Tagged Windows (Gen String)
forall a b. (a -> b) -> a -> b
$ (Char -> String) -> Gen Char -> Gen String
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Char -> String -> String
forall a. a -> [a] -> [a]
:String
":") (Gen Char -> Gen String) -> Gen Char -> Gen String
forall a b. (a -> b) -> a -> b
$ (Char, Char) -> Gen Char
forall a. Random a => (a, a) -> Gen a
QC.choose (Char
'a', Char
'z')

driveRegEx :: RegEx.Parser Char
driveRegEx :: Parser Char
driveRegEx = (Char -> Bool) -> Parser Char
forall a. (a -> Bool) -> Parser a
RegEx.single Char -> Bool
isAlpha Parser Char -> Parser Char -> Parser Char
forall a. Semigroup a => a -> a -> a
<> (Char -> Bool) -> Parser Char
forall a. (a -> Bool) -> Parser a
RegEx.single (Char
':'Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==)

withOS :: Tagged System a -> a
withOS :: forall a. Tagged Windows a -> a
withOS = Tagged Windows 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 Windows (String -> String -> Bool)
-> String -> String -> Bool
forall a. Tagged Windows a -> a
withOS Tagged Windows (String -> String -> Bool)
forall os. System os => Tagged os (String -> String -> Bool)
Core.equalFilePath

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

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


pathSeparator :: Char
pathSeparator :: Char
pathSeparator = Char
'\\'

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

isPathSeparator :: Char -> Bool
isPathSeparator :: Char -> Bool
isPathSeparator = Tagged Windows (Char -> Bool) -> Char -> Bool
forall a. Tagged Windows a -> a
withOS Tagged Windows (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 = Windows -> [(String, T ())]
forall os. System os => os -> [(String, T ())]
Core.testAll Windows
Windows