-- |
-- 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
';')