{-# 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,
    AbsPath, RelPath, FilePath, DirPath,
    AbsOrRelFile, AbsOrRelDir, AbsFileOrDir, RelFileOrDir,
    AbsOrRelPath, FileOrDirPath, AbsOrRelFileOrDir,
    asPath,
    asRelFile, asRelDir, asAbsFile, asAbsDir,
    asRelPath, asAbsPath, asFilePath, asDirPath,
    path, maybePath,
    relFile, relDir, absFile, absDir,
    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 as Core
import System.Path.RegularExpression ((-|-))
import System.Path.Internal (
    Abs, Rel, AbsOrRel, File, Dir, FileOrDir,
    AbsRelClass, FileDirClass,
    AbsOrRelClass, FileOrDirClass,
    )

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

import qualified Test.QuickCheck as QC

import Prelude hiding (FilePath)


data Windows = Windows

_osDummy :: Windows
_osDummy = Windows

type Path = Core.Path Windows

type AbsFile = Path Abs File
type RelFile = Path Rel File
type AbsDir  = Path Abs Dir
type RelDir  = Path Rel Dir
type AbsOrRelFile = Path AbsOrRel File
type AbsOrRelDir  = Path AbsOrRel Dir
type AbsFileOrDir = Path Abs FileOrDir
type RelFileOrDir = Path Rel FileOrDir
type AbsOrRelFileOrDir = Path AbsOrRel FileOrDir

type AbsPath  fd = Path Abs fd
type RelPath  fd = Path Rel fd
type FilePath ar = Path ar File
type DirPath  ar = Path ar Dir
type AbsOrRelPath  fd = Path AbsOrRel fd
type FileOrDirPath ar = Path ar FileOrDir

{-# DEPRECATED asPath "Use 'maybePath', 'parsePath' or 'path' instead." #-}
asPath :: (AbsRelClass ar, FileDirClass fd) => String -> Path ar fd
asPath = Core.asPath

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

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

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

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

{-# DEPRECATED asRelPath "Use 'relPath' instead." #-}
asRelPath :: (FileDirClass fd) => String -> RelPath fd
asRelPath = Core.asRelPath

{-# DEPRECATED asAbsPath "Use 'absPath' instead." #-}
asAbsPath :: (FileDirClass fd) => String -> AbsPath fd
asAbsPath = Core.asAbsPath

{-# DEPRECATED asFilePath "Use 'filePath' instead." #-}
asFilePath :: (AbsRelClass ar) => String -> FilePath ar
asFilePath = Core.asFilePath

{-# DEPRECATED asDirPath "Use 'dirPath' instead." #-}
asDirPath :: (AbsRelClass ar) => String -> DirPath ar
asDirPath = Core.asDirPath


maybePath ::
    (AbsOrRelClass ar, FileOrDirClass fd) => String -> Maybe (Path ar fd)
maybePath = Core.maybePath


path :: (AbsOrRelClass ar, FileOrDirClass fd) => String -> Path ar fd
path = Core.path

relFile :: String -> RelFile
relFile = Core.relFile

relDir :: String -> RelDir
relDir = Core.relDir

absFile :: String -> AbsFile
absFile = Core.absFile

absDir :: String -> AbsDir
absDir = Core.absDir

relPath :: (FileOrDirClass fd) => String -> RelPath fd
relPath = Core.relPath

absPath :: (FileOrDirClass fd) => String -> AbsPath fd
absPath = Core.absPath

filePath :: (AbsOrRelClass ar) => String -> FilePath ar
filePath = Core.filePath

dirPath :: (AbsOrRelClass ar) => String -> DirPath ar
dirPath = Core.dirPath


rootDir :: AbsDir
rootDir = Core.rootDir

currentDir :: RelDir
currentDir = Core.currentDir

emptyFile :: RelFile
emptyFile = Core.emptyFile


toString :: (AbsOrRelClass ar, FileOrDirClass fd) => Path ar fd -> String
toString = Core.toString


instance Core.System Windows where
   pathSeparator = Tagged pathSeparator
   splitAbsolute = Tagged $ RegEx.run $
       RegEx.single isPathSeparator
       -|-
       driveRegEx <> (RegEx.single isPathSeparator -|- mempty)
   canonicalize = Tagged $ map toLower
   splitDrive = Tagged $ RegEx.run driveRegEx
   genDrive = Tagged $ fmap (:":") $ QC.choose ('a', 'z')

driveRegEx :: RegEx.Parser Char
driveRegEx = RegEx.single isAlpha <> RegEx.single (':'==)

withOS :: Tagged Windows a -> a
withOS = untag

equalFilePath :: String -> String -> Bool
equalFilePath = withOS Core.equalFilePath

isAbsoluteString :: String -> Bool
isAbsoluteString = withOS Core.isAbsoluteString

isRelativeString :: String -> Bool
isRelativeString = withOS Core.isRelativeString


pathSeparator :: Char
pathSeparator = '\\'

pathSeparators :: [Char]
pathSeparators = withOS Core.pathSeparators

isPathSeparator :: Char -> Bool
isPathSeparator = withOS 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 = (++[pathSeparator])

-- | This is largely for 'System.FilePath' compatibility
dropTrailingPathSeparator :: String -> String
dropTrailingPathSeparator = init

-- | This is largely for 'System.FilePath' compatibility
hasTrailingPathSeparator :: String -> Bool
hasTrailingPathSeparator = isPathSeparator . last


testAll :: [(String, IO ())]
testAll = Core.testAll Windows