-- |
-- Module: Filesystem.Path.Rules
-- Copyright: 2010 John Millikin
-- License: MIT
--
-- Maintainer:  jmillikin@gmail.com
-- Portability:  portable
--
module Filesystem.Path.Rules
	( Rules
	, posix
	, posix_ghc702
	, posix_ghc704
	, windows
	, darwin
	, darwin_ghc702
	
	-- * Type conversions
	, toText
	, fromText
	, encode
	, decode
	, encodeString
	, decodeString
	
	-- * Rule‐specific path properties
	, valid
	, splitSearchPath
	, splitSearchPathString
	) where

import           Prelude hiding (FilePath, null)
import qualified Prelude as P

import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as B8
import           Data.Char (toUpper, chr, ord)
import           Data.List (intersperse, intercalate)
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import           System.IO ()

import           Filesystem.Path hiding (root, filename, basename)
import           Filesystem.Path.Internal

-------------------------------------------------------------------------------
-- POSIX
-------------------------------------------------------------------------------

-- | Linux, BSD, and other UNIX or UNIX-like operating systems.
posix :: Rules B.ByteString
posix :: Rules ByteString
posix = Rules
	{ rulesName :: Text
rulesName = String -> Text
T.pack String
"POSIX"
	, valid :: FilePath -> Bool
valid = FilePath -> Bool
posixValid
	, splitSearchPath :: ByteString -> [FilePath]
splitSearchPath = ByteString -> [FilePath]
posixSplitSearch
	, splitSearchPathString :: String -> [FilePath]
splitSearchPathString = ByteString -> [FilePath]
posixSplitSearch (ByteString -> [FilePath])
-> (String -> ByteString) -> String -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
B8.pack
	, toText :: FilePath -> Either Text Text
toText = FilePath -> Either Text Text
posixToText
	, fromText :: Text -> FilePath
fromText = Text -> FilePath
posixFromText
	, encode :: FilePath -> ByteString
encode = FilePath -> ByteString
posixToBytes
	, decode :: ByteString -> FilePath
decode = ByteString -> FilePath
posixFromBytes
	, encodeString :: FilePath -> String
encodeString = ByteString -> String
B8.unpack (ByteString -> String)
-> (FilePath -> ByteString) -> FilePath -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ByteString
posixToBytes
	, decodeString :: String -> FilePath
decodeString = ByteString -> FilePath
posixFromBytes (ByteString -> FilePath)
-> (String -> ByteString) -> String -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
B8.pack
	}

-- | Linux, BSD, and other UNIX or UNIX-like operating systems.
--
-- This is a variant of 'posix' for use with GHC 7.2, which tries to decode
-- file paths in its IO computations.
--
-- Since: 0.3.3 / 0.4.2
posix_ghc702 :: Rules B.ByteString
posix_ghc702 :: Rules ByteString
posix_ghc702 = Rules ByteString
posix
	{ rulesName = T.pack "POSIX (GHC 7.2)"
	, splitSearchPathString = posixSplitSearchString posixFromGhc702String
	, encodeString = posixToGhc702String
	, decodeString = posixFromGhc702String
	}

-- | Linux, BSD, and other UNIX or UNIX-like operating systems.
--
-- This is a variant of 'posix' for use with GHC 7.4 or later, which tries to
-- decode file paths in its IO computations.
--
-- Since: 0.3.7 / 0.4.6
posix_ghc704 :: Rules B.ByteString
posix_ghc704 :: Rules ByteString
posix_ghc704 = Rules ByteString
posix
	{ rulesName = T.pack "POSIX (GHC 7.4)"
	, splitSearchPathString = posixSplitSearchString posixFromGhc704String
	, encodeString = posixToGhc704String
	, decodeString = posixFromGhc704String
	}

posixToText :: FilePath -> Either T.Text T.Text
posixToText :: FilePath -> Either Text Text
posixToText FilePath
p = if Bool
good then Text -> Either Text Text
forall a b. b -> Either a b
Right Text
text else Text -> Either Text Text
forall a b. a -> Either a b
Left Text
text where
	good :: Bool
good = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and (((Text, Bool) -> Bool) -> [(Text, Bool)] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Bool) -> Bool
forall a b. (a, b) -> b
snd [(Text, Bool)]
chunks)
	text :: Text
text = [Text] -> Text
T.concat (Text
root Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: ((Text, Bool) -> Text) -> [(Text, Bool)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Bool) -> Text
forall a b. (a, b) -> a
fst [(Text, Bool)]
chunks)
	
	root :: Text
root = Maybe Root -> Text
rootText (FilePath -> Maybe Root
pathRoot FilePath
p)
	chunks :: [(Text, Bool)]
chunks = (Text, Bool) -> [(Text, Bool)] -> [(Text, Bool)]
forall a. a -> [a] -> [a]
intersperse (String -> Text
T.pack String
"/", Bool
True) ((String -> (Text, Bool)) -> [String] -> [(Text, Bool)]
forall a b. (a -> b) -> [a] -> [b]
map String -> (Text, Bool)
unescape (FilePath -> [String]
directoryChunks FilePath
p))

posixFromChunks :: [Chunk] -> FilePath
posixFromChunks :: [String] -> FilePath
posixFromChunks [String]
chunks = Maybe Root -> [String] -> Maybe String -> [String] -> FilePath
FilePath Maybe Root
root [String]
directories Maybe String
basename [String]
exts where
	(Maybe Root
root, [String]
pastRoot) = if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
P.null ([String] -> String
forall a. HasCallStack => [a] -> a
head [String]
chunks)
		then (Root -> Maybe Root
forall a. a -> Maybe a
Just Root
RootPosix, [String] -> [String]
forall a. HasCallStack => [a] -> [a]
tail [String]
chunks)
		else (Maybe Root
forall a. Maybe a
Nothing, [String]
chunks)
	
	([String]
directories, String
filename)
		| [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
P.null [String]
pastRoot = ([], String
"")
		| Bool
otherwise = case [String] -> String
forall a. HasCallStack => [a] -> a
last [String]
pastRoot of
			String
fn | String
fn String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
dot -> ([String] -> [String]
forall {a}. [[a]] -> [[a]]
goodDirs [String]
pastRoot, String
"")
			String
fn | String
fn String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
dots -> ([String] -> [String]
forall {a}. [[a]] -> [[a]]
goodDirs [String]
pastRoot, String
"")
			String
fn -> ([String] -> [String]
forall {a}. [[a]] -> [[a]]
goodDirs ([String] -> [String]
forall a. HasCallStack => [a] -> [a]
init [String]
pastRoot), String
fn)
	
	goodDirs :: [[a]] -> [[a]]
goodDirs = ([a] -> Bool) -> [[a]] -> [[a]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([a] -> Bool) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
P.null)
	
	(Maybe String
basename, [String]
exts) = String -> (Maybe String, [String])
parseFilename String
filename

posixFromText :: T.Text -> FilePath
posixFromText :: Text -> FilePath
posixFromText Text
text = if Text -> Bool
T.null Text
text
	then FilePath
empty
	else [String] -> FilePath
posixFromChunks ((Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Text -> String
escape ((Char -> Bool) -> Text -> [Text]
textSplitBy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') Text
text))

posixToBytes :: FilePath -> B.ByteString
posixToBytes :: FilePath -> ByteString
posixToBytes FilePath
p = [ByteString] -> ByteString
B.concat (ByteString
root ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
chunks) where
	root :: ByteString
root = String -> ByteString
B8.pack (Maybe Root -> String
rootChunk (FilePath -> Maybe Root
pathRoot FilePath
p))
	chunks :: [ByteString]
chunks = ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
intersperse (String -> ByteString
B8.pack String
"/") ((String -> ByteString) -> [String] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map String -> ByteString
chunkBytes (FilePath -> [String]
directoryChunks FilePath
p))
	chunkBytes :: String -> ByteString
chunkBytes String
c = String -> ByteString
unescapeBytes' String
c

posixFromBytes :: B.ByteString -> FilePath
posixFromBytes :: ByteString -> FilePath
posixFromBytes ByteString
bytes = if ByteString -> Bool
B.null ByteString
bytes
	then FilePath
empty
	else [String] -> FilePath
posixFromChunks ([String] -> FilePath) -> [String] -> FilePath
forall a b. (a -> b) -> a -> b
$ ((ByteString -> String) -> [ByteString] -> [String])
-> [ByteString] -> (ByteString -> String) -> [String]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (ByteString -> String) -> [ByteString] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Word8 -> ByteString -> [ByteString]
B.split Word8
0x2F ByteString
bytes) ((ByteString -> String) -> [String])
-> (ByteString -> String) -> [String]
forall a b. (a -> b) -> a -> b
$ \ByteString
b -> case ByteString -> Maybe Text
maybeDecodeUtf8 ByteString
b of
		Just Text
text -> Text -> String
escape Text
text
		Maybe Text
Nothing -> ByteString -> String
processInvalidUtf8 ByteString
b

processInvalidUtf8 :: B.ByteString -> Chunk
processInvalidUtf8 :: ByteString -> String
processInvalidUtf8 ByteString
bytes = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"." [String]
textChunks where
	byteChunks :: [ByteString]
byteChunks = Word8 -> ByteString -> [ByteString]
B.split Word8
0x2E ByteString
bytes
	textChunks :: [String]
textChunks = (ByteString -> String) -> [ByteString] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> String
unicodeDammit [ByteString]
byteChunks
	unicodeDammit :: ByteString -> String
unicodeDammit ByteString
b = case ByteString -> Maybe Text
maybeDecodeUtf8 ByteString
b of
		Just Text
t -> Text -> String
escape Text
t
		Maybe Text
Nothing -> (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map (\Char
c -> if Char -> Int
ord Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0x80
			then Int -> Char
chr (Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0xDC00)
			else Char
c) (ByteString -> String
B8.unpack ByteString
b)

posixToGhc702String :: FilePath -> String
posixToGhc702String :: FilePath -> String
posixToGhc702String FilePath
p = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
P.concat (String
root String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
chunks) where
	root :: String
root = Maybe Root -> String
rootChunk (FilePath -> Maybe Root
pathRoot FilePath
p)
	chunks :: [String]
chunks = String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
"/" ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
escapeToGhc702 (FilePath -> [String]
directoryChunks FilePath
p))

escapeToGhc702 :: Chunk -> String
escapeToGhc702 :: String -> String
escapeToGhc702 = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map (\Char
c -> if Char -> Int
ord Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0xDC80 Bool -> Bool -> Bool
&& Char -> Int
ord Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xDCFF
	then Int -> Char
chr (Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
0xDC00 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0xEF00)
	else Char
c)

posixFromGhc702String :: String -> FilePath
posixFromGhc702String :: String -> FilePath
posixFromGhc702String String
cs = if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
P.null String
cs
	then FilePath
empty
	else [String] -> FilePath
posixFromChunks ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
escapeFromGhc702 ((Char -> Bool) -> String -> [String]
forall a. (a -> Bool) -> [a] -> [[a]]
splitBy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') String
cs))

escapeFromGhc702 :: String -> String
escapeFromGhc702 :: String -> String
escapeFromGhc702 = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map (\Char
c -> if Char -> Int
ord Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0xEF80 Bool -> Bool -> Bool
&& Char -> Int
ord Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xEFFF
	-- hopefully this isn't a valid UTF8 filename decoding to these
	-- codepoints, but there's no way to tell here.
	then Int -> Char
chr (Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
0xEF00 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0xDC00)
	else Char
c)

posixToGhc704String :: FilePath -> String
posixToGhc704String :: FilePath -> String
posixToGhc704String FilePath
p = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
P.concat (String
root String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
chunks) where
	root :: String
root = Maybe Root -> String
rootChunk (FilePath -> Maybe Root
pathRoot FilePath
p)
	chunks :: [String]
chunks = String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
"/" (FilePath -> [String]
directoryChunks FilePath
p)

posixFromGhc704String :: String -> FilePath
posixFromGhc704String :: String -> FilePath
posixFromGhc704String String
cs = if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
P.null String
cs
	then FilePath
empty
	else [String] -> FilePath
posixFromChunks ((Char -> Bool) -> String -> [String]
forall a. (a -> Bool) -> [a] -> [[a]]
splitBy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') String
cs)

posixValid :: FilePath -> Bool
posixValid :: FilePath -> Bool
posixValid FilePath
p = Bool
validRoot Bool -> Bool -> Bool
&& Bool
validDirectories where
	validDirectories :: Bool
validDirectories = (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all String -> Bool
forall {t :: * -> *}. Foldable t => t Char -> Bool
validChunk (FilePath -> [String]
directoryChunks FilePath
p)
	validChunk :: t Char -> Bool
validChunk t Char
ch = Bool -> Bool
not ((Char -> Bool) -> t Char -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\0' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') t Char
ch)
	validRoot :: Bool
validRoot = case FilePath -> Maybe Root
pathRoot FilePath
p of
		Maybe Root
Nothing -> Bool
True
		Just Root
RootPosix -> Bool
True
		Maybe Root
_ -> Bool
False

posixSplitSearch :: B.ByteString -> [FilePath]
posixSplitSearch :: ByteString -> [FilePath]
posixSplitSearch = (ByteString -> FilePath) -> [ByteString] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> FilePath
posixFromBytes (ByteString -> FilePath)
-> (ByteString -> ByteString) -> ByteString -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
normSearch) ([ByteString] -> [FilePath])
-> (ByteString -> [ByteString]) -> ByteString -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> ByteString -> [ByteString]
B.split Word8
0x3A where
	normSearch :: ByteString -> ByteString
normSearch ByteString
bytes = if ByteString -> Bool
B.null ByteString
bytes then String -> ByteString
B8.pack String
"." else ByteString
bytes

posixSplitSearchString :: (String -> FilePath) -> String -> [FilePath]
posixSplitSearchString :: (String -> FilePath) -> String -> [FilePath]
posixSplitSearchString String -> FilePath
toPath = (String -> FilePath) -> [String] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (String -> FilePath
toPath (String -> FilePath) -> (String -> String) -> String -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
normSearch) ([String] -> [FilePath])
-> (String -> [String]) -> String -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> [String]
forall a. (a -> Bool) -> [a] -> [[a]]
splitBy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':') where
	normSearch :: String -> String
normSearch String
s = if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
P.null String
s then String
"." else String
s

-------------------------------------------------------------------------------
-- Darwin
-------------------------------------------------------------------------------

-- | Darwin and Mac OS X.
--
-- This is almost identical to 'posix', but with a native path type of 'T.Text'
-- rather than 'B.ByteString'.
--
-- Since: 0.3.4 / 0.4.3
darwin :: Rules T.Text
darwin :: Rules Text
darwin = Rules
	{ rulesName :: Text
rulesName = String -> Text
T.pack String
"Darwin"
	, valid :: FilePath -> Bool
valid = FilePath -> Bool
posixValid
	, splitSearchPath :: Text -> [FilePath]
splitSearchPath = Text -> [FilePath]
darwinSplitSearch
	, splitSearchPathString :: String -> [FilePath]
splitSearchPathString = Text -> [FilePath]
darwinSplitSearch (Text -> [FilePath]) -> (String -> Text) -> String -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
TE.decodeUtf8 (ByteString -> Text) -> (String -> ByteString) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
B8.pack
	, toText :: FilePath -> Either Text Text
toText = Text -> Either Text Text
forall a b. b -> Either a b
Right (Text -> Either Text Text)
-> (FilePath -> Text) -> FilePath -> Either Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
darwinToText
	, fromText :: Text -> FilePath
fromText = Text -> FilePath
posixFromText
	, encode :: FilePath -> Text
encode = FilePath -> Text
darwinToText
	, decode :: Text -> FilePath
decode = Text -> FilePath
posixFromText
	, encodeString :: FilePath -> String
encodeString = FilePath -> String
darwinToString
	, decodeString :: String -> FilePath
decodeString = String -> FilePath
darwinFromString
	}

-- | Darwin and Mac OS X.
--
-- This is a variant of 'darwin' for use with GHC 7.2 or later, which tries to
-- decode file paths in its IO computations.
--
-- Since: 0.3.4 / 0.4.3
darwin_ghc702 :: Rules T.Text
darwin_ghc702 :: Rules Text
darwin_ghc702 = Rules Text
darwin
	{ rulesName = T.pack "Darwin (GHC 7.2)"
	, splitSearchPathString = darwinSplitSearch . T.pack
	, encodeString = T.unpack . darwinToText
	, decodeString = posixFromText . T.pack
	}

darwinToText :: FilePath -> T.Text
darwinToText :: FilePath -> Text
darwinToText FilePath
p = [Text] -> Text
T.concat (Text
root Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
chunks) where
	root :: Text
root = Maybe Root -> Text
rootText (FilePath -> Maybe Root
pathRoot FilePath
p)
	chunks :: [Text]
chunks = Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
intersperse (String -> Text
T.pack String
"/") ((String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
unescape' (FilePath -> [String]
directoryChunks FilePath
p))

darwinToString :: FilePath -> String
darwinToString :: FilePath -> String
darwinToString = ByteString -> String
B8.unpack (ByteString -> String)
-> (FilePath -> ByteString) -> FilePath -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TE.encodeUtf8 (Text -> ByteString)
-> (FilePath -> Text) -> FilePath -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
darwinToText

darwinFromString :: String -> FilePath
darwinFromString :: String -> FilePath
darwinFromString = Text -> FilePath
posixFromText (Text -> FilePath) -> (String -> Text) -> String -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
TE.decodeUtf8 (ByteString -> Text) -> (String -> ByteString) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
B8.pack

darwinSplitSearch :: T.Text -> [FilePath]
darwinSplitSearch :: Text -> [FilePath]
darwinSplitSearch = (Text -> FilePath) -> [Text] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> FilePath
posixFromText (Text -> FilePath) -> (Text -> Text) -> Text -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
normSearch) ([Text] -> [FilePath]) -> (Text -> [Text]) -> Text -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> [Text]
textSplitBy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':') where
	normSearch :: Text -> Text
normSearch Text
text = if Text -> Bool
T.null Text
text then String -> Text
T.pack String
"." else Text
text

-------------------------------------------------------------------------------
-- Windows
-------------------------------------------------------------------------------

-- | Windows and DOS
windows :: Rules T.Text
windows :: Rules Text
windows = Rules
	{ rulesName :: Text
rulesName = String -> Text
T.pack String
"Windows"
	, valid :: FilePath -> Bool
valid = FilePath -> Bool
winValid
	, splitSearchPath :: Text -> [FilePath]
splitSearchPath = Text -> [FilePath]
winSplit
	, splitSearchPathString :: String -> [FilePath]
splitSearchPathString = Text -> [FilePath]
winSplit (Text -> [FilePath]) -> (String -> Text) -> String -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
	, toText :: FilePath -> Either Text Text
toText = Text -> Either Text Text
forall a b. b -> Either a b
Right (Text -> Either Text Text)
-> (FilePath -> Text) -> FilePath -> Either Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
winToText
	, fromText :: Text -> FilePath
fromText = Text -> FilePath
winFromText
	, encode :: FilePath -> Text
encode = FilePath -> Text
winToText
	, decode :: Text -> FilePath
decode = Text -> FilePath
winFromText
	, encodeString :: FilePath -> String
encodeString = Text -> String
T.unpack (Text -> String) -> (FilePath -> Text) -> FilePath -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
winToText
	, decodeString :: String -> FilePath
decodeString = Text -> FilePath
winFromText (Text -> FilePath) -> (String -> Text) -> String -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
	}

winToText :: FilePath -> T.Text
winToText :: FilePath -> Text
winToText FilePath
p = case FilePath -> Maybe Root
pathRoot FilePath
p of
	Just RootWindowsUnc{} -> FilePath -> Text
uncToText FilePath
p
	Maybe Root
_ -> FilePath -> Text
dosToText FilePath
p

dosToText :: FilePath -> T.Text
dosToText :: FilePath -> Text
dosToText FilePath
p = [Text] -> Text
T.concat (Text
root Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
chunks) where
	root :: Text
root = Maybe Root -> Text
rootText (FilePath -> Maybe Root
pathRoot FilePath
p)
	chunks :: [Text]
chunks = Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
intersperse (String -> Text
T.pack String
"\\") ((String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
unescape' (FilePath -> [String]
directoryChunks FilePath
p))

uncToText :: FilePath -> T.Text
uncToText :: FilePath -> Text
uncToText FilePath
p = [Text] -> Text
T.concat (Text
root Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
chunks) where
	root :: Text
root = if (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Text -> Bool
T.null [Text]
chunks
		then Maybe Root -> Text
rootText (FilePath -> Maybe Root
pathRoot FilePath
p)
		else Maybe Root -> Text
rootText (FilePath -> Maybe Root
pathRoot FilePath
p) Text -> Text -> Text
`T.append` String -> Text
T.pack String
"\\"
	chunks :: [Text]
chunks = Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
intersperse (String -> Text
T.pack String
"\\") ((Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) ((String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
unescape' (FilePath -> [String]
directoryChunks FilePath
p)))

winFromText :: T.Text -> FilePath
winFromText :: Text -> FilePath
winFromText Text
text = if Text -> Bool
T.null Text
text then FilePath
empty else FilePath
path where
	path :: FilePath
path = Maybe Root -> [String] -> Maybe String -> [String] -> FilePath
FilePath Maybe Root
root [String]
directories Maybe String
basename [String]
exts
	
	-- Windows has various types of absolute paths:
	--
	-- * C:\foo\bar -> DOS-style absolute path
	-- * \\?\C:\foo\bar -> extended-length absolute path
	-- * \\host\share\foo\bar -> UNC path
	-- * \\?\UNC\host\share\foo\bar -> extended-length UNC path
	--
	-- \foo\bar looks like an absolute path, but is actually a path
	-- relative to the current DOS drive.
	--
	-- http://msdn.microsoft.com/en-us/library/windows/desktop/aa365247(v=vs.85).aspx
	(Maybe Root
root, [Text]
pastRoot) = if Text -> Text -> Bool
T.isPrefixOf (String -> Text
T.pack String
"\\\\") Text
text
		then case Text -> Text -> Maybe Text
stripUncasedPrefix (String -> Text
T.pack String
"\\\\?\\UNC\\") Text
text of
			Just Text
stripped -> Text -> Bool -> (Maybe Root, [Text])
parseUncRoot Text
stripped Bool
True
			Maybe Text
Nothing -> case Text -> Text -> Maybe Text
T.stripPrefix (String -> Text
T.pack String
"\\\\?\\") Text
text of
				Just Text
stripped -> Text -> Bool -> (Maybe Root, [Text])
parseDosRoot Text
stripped Bool
True
				Maybe Text
Nothing -> case Text -> Text -> Maybe Text
T.stripPrefix (String -> Text
T.pack String
"\\\\") Text
text of
					Just Text
stripped -> Text -> Bool -> (Maybe Root, [Text])
parseUncRoot Text
stripped Bool
False
					Maybe Text
Nothing -> Text -> Bool -> (Maybe Root, [Text])
parseDosRoot Text
text Bool
False
		else case Text -> Text -> Maybe Text
T.stripPrefix (String -> Text
T.pack String
"\\??\\") Text
text of
			Just Text
stripped -> Text -> (Maybe Root, [Text])
parseDoubleQmark Text
stripped
			Maybe Text
Nothing -> Text -> Bool -> (Maybe Root, [Text])
parseDosRoot Text
text Bool
False
	
	([String]
directories, Maybe String
filename)
		| [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
P.null [Text]
pastRoot = ([], Maybe String
forall a. Maybe a
Nothing)
		| Bool
otherwise = case [Text] -> Text
forall a. HasCallStack => [a] -> a
last [Text]
pastRoot of
			Text
fn | Text
fn Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Text
T.pack String
"." -> ([Text] -> [String]
goodDirs [Text]
pastRoot, String -> Maybe String
forall a. a -> Maybe a
Just String
"")
			Text
fn | Text
fn Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Text
T.pack String
".." -> ([Text] -> [String]
goodDirs [Text]
pastRoot, String -> Maybe String
forall a. a -> Maybe a
Just String
"")
			Text
fn -> ([Text] -> [String]
goodDirs ([Text] -> [Text]
forall a. HasCallStack => [a] -> [a]
init [Text]
pastRoot), String -> Maybe String
forall a. a -> Maybe a
Just (Text -> String
escape Text
fn))
	
	goodDirs :: [T.Text] -> [Chunk]
	goodDirs :: [Text] -> [String]
goodDirs = (Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Text -> String
escape ([Text] -> [String]) -> ([Text] -> [Text]) -> [Text] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null)
	
	(Maybe String
basename, [String]
exts) = case Maybe String
filename of
		Just String
fn -> String -> (Maybe String, [String])
parseFilename String
fn
		Maybe String
Nothing -> (Maybe String
forall a. Maybe a
Nothing, [])

stripUncasedPrefix :: T.Text -> T.Text -> Maybe T.Text
stripUncasedPrefix :: Text -> Text -> Maybe Text
stripUncasedPrefix Text
prefix Text
text = if Text -> Text
T.toCaseFold Text
prefix Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Text
T.toCaseFold (Int -> Text -> Text
T.take (Text -> Int
T.length Text
prefix) Text
text)
	then Text -> Maybe Text
forall a. a -> Maybe a
Just (Int -> Text -> Text
T.drop (Text -> Int
T.length Text
prefix) Text
text)
	else Maybe Text
forall a. Maybe a
Nothing

parseDosRoot :: T.Text -> Bool -> (Maybe Root, [T.Text])
parseDosRoot :: Text -> Bool -> (Maybe Root, [Text])
parseDosRoot Text
text Bool
extended = (Maybe Root, [Text])
parsed where
	split :: [Text]
split = (Char -> Bool) -> Text -> [Text]
textSplitBy (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\') Text
text
	
	head' :: Text
head' = [Text] -> Text
forall a. HasCallStack => [a] -> a
head [Text]
split
	tail' :: [Text]
tail' = [Text] -> [Text]
forall a. HasCallStack => [a] -> [a]
tail [Text]
split
	parsed :: (Maybe Root, [Text])
parsed = if Text -> Bool
T.null Text
head'
		then (Root -> Maybe Root
forall a. a -> Maybe a
Just Root
RootWindowsCurrentVolume, [Text]
tail')
		else if (Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':') Text
head'
			then (Root -> Maybe Root
forall a. a -> Maybe a
Just (Text -> Root
parseDrive Text
head'), [Text]
tail')
				else (Maybe Root
forall a. Maybe a
Nothing, [Text]
split)
	
	parseDrive :: Text -> Root
parseDrive Text
c = Char -> Bool -> Root
RootWindowsVolume (Char -> Char
toUpper (HasCallStack => Text -> Char
Text -> Char
T.head Text
c)) Bool
extended

parseDoubleQmark :: T.Text -> (Maybe Root, [T.Text])
parseDoubleQmark :: Text -> (Maybe Root, [Text])
parseDoubleQmark Text
text = (Root -> Maybe Root
forall a. a -> Maybe a
Just Root
RootWindowsDoubleQMark, [Text]
components) where
	components :: [Text]
components = (Char -> Bool) -> Text -> [Text]
textSplitBy (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\') Text
text

parseUncRoot :: T.Text -> Bool -> (Maybe Root, [T.Text])
parseUncRoot :: Text -> Bool -> (Maybe Root, [Text])
parseUncRoot Text
text Bool
extended = (Maybe Root, [Text])
parsed where
	(Text
host, Text
pastHost) = (Char -> Bool) -> Text -> (Text, Text)
T.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\') Text
text
	(Text
share, Text
pastShare) = (Char -> Bool) -> Text -> (Text, Text)
T.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\') (Int -> Text -> Text
T.drop Int
1 Text
pastHost)
	split :: [Text]
split = if Text -> Bool
T.null Text
pastShare
		then []
		else (Char -> Bool) -> Text -> [Text]
textSplitBy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\') Text
pastShare
	parsed :: (Maybe Root, [Text])
parsed = (Root -> Maybe Root
forall a. a -> Maybe a
Just (String -> String -> Bool -> Root
RootWindowsUnc (Text -> String
T.unpack Text
host) (Text -> String
T.unpack Text
share) Bool
extended), [Text]
split)

winValid :: FilePath -> Bool
winValid :: FilePath -> Bool
winValid FilePath
p = case FilePath -> Maybe Root
pathRoot FilePath
p of
	Maybe Root
Nothing -> FilePath -> Bool
dosValid FilePath
p
	Just Root
RootWindowsCurrentVolume -> FilePath -> Bool
dosValid FilePath
p
	Just (RootWindowsVolume Char
v Bool
_) -> Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Char
v [Char
'A'..Char
'Z'] Bool -> Bool -> Bool
&& FilePath -> Bool
dosValid FilePath
p
	Just (RootWindowsUnc String
host String
share Bool
_) -> FilePath -> String -> String -> Bool
uncValid FilePath
p String
host String
share
	-- don't even try to validate \??\ paths
	Just Root
RootWindowsDoubleQMark -> Bool
True
	Just Root
RootPosix -> Bool
False

dosValid :: FilePath -> Bool
dosValid :: FilePath -> Bool
dosValid FilePath
p = Bool
noReserved Bool -> Bool -> Bool
&& Bool
validCharacters where
	reservedChars :: String
reservedChars = (Int -> Char) -> [Int] -> String
forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
chr [Int
0..Int
0x1F] String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/\\?*:|\"<>"
	reservedNames :: [String]
reservedNames =
		[ String
"AUX", String
"CLOCK$", String
"COM1", String
"COM2", String
"COM3", String
"COM4"
		, String
"COM5", String
"COM6", String
"COM7", String
"COM8", String
"COM9", String
"CON"
		, String
"LPT1", String
"LPT2", String
"LPT3", String
"LPT4", String
"LPT5", String
"LPT6"
		, String
"LPT7", String
"LPT8", String
"LPT9", String
"NUL", String
"PRN"
		]
	
	noExt :: FilePath
noExt = FilePath
p { pathExtensions = [] }
	noReserved :: Bool
noReserved = ((String -> Bool) -> [String] -> Bool)
-> [String] -> (String -> Bool) -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (FilePath -> [String]
directoryChunks FilePath
noExt)
		((String -> Bool) -> Bool) -> (String -> Bool) -> Bool
forall a b. (a -> b) -> a -> b
$ \String
fn -> String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem ((Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper String
fn) [String]
reservedNames
	
	validCharacters :: Bool
validCharacters = ((String -> Bool) -> [String] -> Bool)
-> [String] -> (String -> Bool) -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (FilePath -> [String]
directoryChunks FilePath
p)
		((String -> Bool) -> Bool) -> (String -> Bool) -> Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
reservedChars)

uncValid :: FilePath -> String -> String -> Bool
uncValid :: FilePath -> String -> String -> Bool
uncValid FilePath
_ String
"" String
_ = Bool
False
uncValid FilePath
_ String
_ String
"" = Bool
False
uncValid FilePath
p String
host String
share = String -> Bool
ok String
host Bool -> Bool -> Bool
&& String -> Bool
ok String
share Bool -> Bool -> Bool
&& (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all String -> Bool
ok ((String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
P.null (FilePath -> [String]
directoryChunks FilePath
p)) where
	ok :: String -> Bool
ok String
""  = Bool
False
	ok String
c = Bool -> Bool
not ((Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
invalidChar String
c)
	invalidChar :: Char -> Bool
invalidChar Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x00' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\'

dropWhileEnd :: (a -> Bool) -> [a] -> [a]
dropWhileEnd :: forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd a -> Bool
p = (a -> [a] -> [a]) -> [a] -> [a] -> [a]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
x [a]
xs -> if a -> Bool
p a
x Bool -> Bool -> Bool
&& [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
P.null [a]
xs then [] else a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs) []

winSplit :: T.Text -> [FilePath]
winSplit :: Text -> [FilePath]
winSplit = (Text -> FilePath) -> [Text] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Text -> FilePath
winFromText ([Text] -> [FilePath]) -> (Text -> [Text]) -> Text -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> [Text]
textSplitBy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
';')