{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}

-- |
-- Module: Filesystem.Path.Internal
-- Copyright: 2010 John Millikin
-- License: MIT
--
-- Maintainer:  jmillikin@gmail.com
-- Portability:  portable
--
module Filesystem.Path.Internal where

import           Prelude hiding (FilePath)

import           Control.DeepSeq (NFData, rnf)
import qualified Control.Exception as Exc
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as B8
import           Data.Char (chr, ord)
import           Data.Data (Data)
import           Data.List (intersperse)
import           Data.Ord (comparing)
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import           Data.Text.Encoding.Error (UnicodeException)
import           Data.Typeable (Typeable)

-------------------------------------------------------------------------------
-- File Paths
-------------------------------------------------------------------------------

type Chunk = String
type Directory = Chunk
type Basename = Chunk
type Extension = Chunk

data Root
	= RootPosix
	| RootWindowsVolume Char Bool
	| RootWindowsCurrentVolume
	| RootWindowsUnc String String Bool
	| RootWindowsDoubleQMark
	deriving (Root -> Root -> Bool
(Root -> Root -> Bool) -> (Root -> Root -> Bool) -> Eq Root
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Root -> Root -> Bool
$c/= :: Root -> Root -> Bool
== :: Root -> Root -> Bool
$c== :: Root -> Root -> Bool
Eq, Eq Root
Eq Root =>
(Root -> Root -> Ordering)
-> (Root -> Root -> Bool)
-> (Root -> Root -> Bool)
-> (Root -> Root -> Bool)
-> (Root -> Root -> Bool)
-> (Root -> Root -> Root)
-> (Root -> Root -> Root)
-> Ord Root
Root -> Root -> Bool
Root -> Root -> Ordering
Root -> Root -> Root
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Root -> Root -> Root
$cmin :: Root -> Root -> Root
max :: Root -> Root -> Root
$cmax :: Root -> Root -> Root
>= :: Root -> Root -> Bool
$c>= :: Root -> Root -> Bool
> :: Root -> Root -> Bool
$c> :: Root -> Root -> Bool
<= :: Root -> Root -> Bool
$c<= :: Root -> Root -> Bool
< :: Root -> Root -> Bool
$c< :: Root -> Root -> Bool
compare :: Root -> Root -> Ordering
$ccompare :: Root -> Root -> Ordering
$cp1Ord :: Eq Root
Ord, Typeable Root
Constr
DataType
Typeable Root =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Root -> c Root)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Root)
-> (Root -> Constr)
-> (Root -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Root))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Root))
-> ((forall b. Data b => b -> b) -> Root -> Root)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Root -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Root -> r)
-> (forall u. (forall d. Data d => d -> u) -> Root -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Root -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Root -> m Root)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Root -> m Root)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Root -> m Root)
-> Data Root
Root -> Constr
Root -> DataType
(forall b. Data b => b -> b) -> Root -> Root
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Root -> c Root
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Root
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Root -> u
forall u. (forall d. Data d => d -> u) -> Root -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Root -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Root -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Root -> m Root
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Root -> m Root
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Root
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Root -> c Root
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Root)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Root)
$cRootWindowsDoubleQMark :: Constr
$cRootWindowsUnc :: Constr
$cRootWindowsCurrentVolume :: Constr
$cRootWindowsVolume :: Constr
$cRootPosix :: Constr
$tRoot :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Root -> m Root
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Root -> m Root
gmapMp :: (forall d. Data d => d -> m d) -> Root -> m Root
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Root -> m Root
gmapM :: (forall d. Data d => d -> m d) -> Root -> m Root
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Root -> m Root
gmapQi :: Int -> (forall d. Data d => d -> u) -> Root -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Root -> u
gmapQ :: (forall d. Data d => d -> u) -> Root -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Root -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Root -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Root -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Root -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Root -> r
gmapT :: (forall b. Data b => b -> b) -> Root -> Root
$cgmapT :: (forall b. Data b => b -> b) -> Root -> Root
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Root)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Root)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Root)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Root)
dataTypeOf :: Root -> DataType
$cdataTypeOf :: Root -> DataType
toConstr :: Root -> Constr
$ctoConstr :: Root -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Root
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Root
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Root -> c Root
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Root -> c Root
$cp1Data :: Typeable Root
Data, Typeable, Int -> Root -> ShowS
[Root] -> ShowS
Root -> String
(Int -> Root -> ShowS)
-> (Root -> String) -> ([Root] -> ShowS) -> Show Root
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Root] -> ShowS
$cshowList :: [Root] -> ShowS
show :: Root -> String
$cshow :: Root -> String
showsPrec :: Int -> Root -> ShowS
$cshowsPrec :: Int -> Root -> ShowS
Show)

data FilePath = FilePath
	{ FilePath -> Maybe Root
pathRoot :: Maybe Root
	, FilePath -> [String]
pathDirectories :: [Directory]
	, FilePath -> Maybe String
pathBasename :: Maybe Basename
	, FilePath -> [String]
pathExtensions :: [Extension]
	}
	deriving (Typeable FilePath
Constr
DataType
Typeable FilePath =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> FilePath -> c FilePath)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c FilePath)
-> (FilePath -> Constr)
-> (FilePath -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c FilePath))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FilePath))
-> ((forall b. Data b => b -> b) -> FilePath -> FilePath)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> FilePath -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> FilePath -> r)
-> (forall u. (forall d. Data d => d -> u) -> FilePath -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> FilePath -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> FilePath -> m FilePath)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> FilePath -> m FilePath)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> FilePath -> m FilePath)
-> Data FilePath
FilePath -> Constr
FilePath -> DataType
(forall b. Data b => b -> b) -> FilePath -> FilePath
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FilePath -> c FilePath
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FilePath
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> FilePath -> u
forall u. (forall d. Data d => d -> u) -> FilePath -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FilePath -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FilePath -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FilePath -> m FilePath
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FilePath -> m FilePath
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FilePath
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FilePath -> c FilePath
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FilePath)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FilePath)
$cFilePath :: Constr
$tFilePath :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> FilePath -> m FilePath
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FilePath -> m FilePath
gmapMp :: (forall d. Data d => d -> m d) -> FilePath -> m FilePath
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FilePath -> m FilePath
gmapM :: (forall d. Data d => d -> m d) -> FilePath -> m FilePath
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FilePath -> m FilePath
gmapQi :: Int -> (forall d. Data d => d -> u) -> FilePath -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> FilePath -> u
gmapQ :: (forall d. Data d => d -> u) -> FilePath -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> FilePath -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FilePath -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FilePath -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FilePath -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FilePath -> r
gmapT :: (forall b. Data b => b -> b) -> FilePath -> FilePath
$cgmapT :: (forall b. Data b => b -> b) -> FilePath -> FilePath
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FilePath)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FilePath)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c FilePath)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FilePath)
dataTypeOf :: FilePath -> DataType
$cdataTypeOf :: FilePath -> DataType
toConstr :: FilePath -> Constr
$ctoConstr :: FilePath -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FilePath
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FilePath
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FilePath -> c FilePath
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FilePath -> c FilePath
$cp1Data :: Typeable FilePath
Data, Typeable)

instance Eq FilePath where
	x :: FilePath
x == :: FilePath -> FilePath -> Bool
== y :: FilePath
y = FilePath -> FilePath -> Ordering
forall a. Ord a => a -> a -> Ordering
compare FilePath
x FilePath
y Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ

instance Ord FilePath where
	compare :: FilePath -> FilePath -> Ordering
compare = (FilePath -> (Maybe Root, [Text], Maybe Text, [Text]))
-> FilePath -> FilePath -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (\p :: FilePath
p ->
		(FilePath -> Maybe Root
pathRoot FilePath
p
		, (String -> Text) -> [String] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
unescape' (FilePath -> [String]
pathDirectories FilePath
p)
		, (String -> Text) -> Maybe String -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
unescape' (FilePath -> Maybe String
pathBasename FilePath
p)
		, (String -> Text) -> [String] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
unescape' (FilePath -> [String]
pathExtensions FilePath
p)
		))

instance NFData Root where
	rnf :: Root -> ()
rnf (RootWindowsVolume c :: Char
c extended :: Bool
extended) = Char -> ()
forall a. NFData a => a -> ()
rnf Char
c () -> () -> ()
forall a b. a -> b -> b
`seq` Bool -> ()
forall a. NFData a => a -> ()
rnf Bool
extended
	rnf (RootWindowsUnc host :: String
host share :: String
share extended :: Bool
extended) = String -> ()
forall a. NFData a => a -> ()
rnf String
host () -> () -> ()
forall a b. a -> b -> b
`seq` String -> ()
forall a. NFData a => a -> ()
rnf String
share () -> () -> ()
forall a b. a -> b -> b
`seq` Bool -> ()
forall a. NFData a => a -> ()
rnf Bool
extended
	rnf _ = ()

instance NFData FilePath where
	rnf :: FilePath -> ()
rnf p :: FilePath
p = Maybe Root -> ()
forall a. NFData a => a -> ()
rnf (FilePath -> Maybe Root
pathRoot FilePath
p) () -> () -> ()
forall a b. a -> b -> b
`seq` [String] -> ()
forall a. NFData a => a -> ()
rnf (FilePath -> [String]
pathDirectories FilePath
p) () -> () -> ()
forall a b. a -> b -> b
`seq` Maybe String -> ()
forall a. NFData a => a -> ()
rnf (FilePath -> Maybe String
pathBasename FilePath
p) () -> () -> ()
forall a b. a -> b -> b
`seq` [String] -> ()
forall a. NFData a => a -> ()
rnf (FilePath -> [String]
pathExtensions FilePath
p)

-- | A file path with no root, directory, or filename
empty :: FilePath
empty :: FilePath
empty = Maybe Root -> [String] -> Maybe String -> [String] -> FilePath
FilePath Maybe Root
forall a. Maybe a
Nothing [] Maybe String
forall a. Maybe a
Nothing []

dot :: Chunk
dot :: String
dot = "."

dots :: Chunk
dots :: String
dots = ".."

filenameChunk :: FilePath -> Chunk
filenameChunk :: FilePath -> String
filenameChunk p :: FilePath
p = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (String
nameString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
exts) where
	name :: String
name = String -> ShowS -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" ShowS
forall a. a -> a
id (FilePath -> Maybe String
pathBasename FilePath
p)
	exts :: [String]
exts = case FilePath -> [String]
pathExtensions FilePath
p of
		[] -> []
		exts' :: [String]
exts' -> String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
dot (""String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
exts')

rootChunk :: Maybe Root -> Chunk
rootChunk :: Maybe Root -> String
rootChunk r :: Maybe Root
r = ((Root -> String) -> Maybe Root -> String)
-> Maybe Root -> (Root -> String) -> String
forall a b c. (a -> b -> c) -> b -> a -> c
flip (String -> (Root -> String) -> Maybe Root -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "") Maybe Root
r ((Root -> String) -> String) -> (Root -> String) -> String
forall a b. (a -> b) -> a -> b
$ \r' :: Root
r' -> case Root
r' of
	RootPosix -> "/"
	RootWindowsVolume c :: Char
c False -> Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: ":\\"
	RootWindowsVolume c :: Char
c True -> "\\\\?\\" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: ":\\")
	RootWindowsCurrentVolume -> "\\"
	RootWindowsUnc host :: String
host share :: String
share False -> "\\\\" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
host String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\\" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
share
	RootWindowsUnc host :: String
host share :: String
share True -> "\\\\?\\UNC\\" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
host String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\\" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
share
	RootWindowsDoubleQMark -> "\\??\\"

rootText :: Maybe Root -> T.Text
rootText :: Maybe Root -> Text
rootText = String -> Text
T.pack (String -> Text) -> (Maybe Root -> String) -> Maybe Root -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Root -> String
rootChunk

directoryChunks :: FilePath -> [Chunk]
directoryChunks :: FilePath -> [String]
directoryChunks path :: FilePath
path = FilePath -> [String]
pathDirectories FilePath
path [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [FilePath -> String
filenameChunk FilePath
path]

-------------------------------------------------------------------------------
-- Rules
-------------------------------------------------------------------------------

-- | The type of @platformFormat@ for 'Rules' is conditionally selected at 
-- compilation time. As such it is only intended for direct use with external OS
-- functions and code that expects @platformFormat@ to be stable across platforms
-- may fail to subsequently compile on a differing platform.
--
-- For example: on Windows or OSX @platformFormat@ will be 'T.Text',
-- and on Linux it will be 'B.ByteString'.
--
-- If portability is a concern, restrict usage to functions which do not expose
-- @platformFormat@ directly.
data Rules platformFormat = Rules
	{ Rules platformFormat -> Text
rulesName :: T.Text
	
	-- | Check if a 'FilePath' is valid; it must not contain any illegal
	-- characters, and must have a root appropriate to the current
	-- 'Rules'.
	, Rules platformFormat -> FilePath -> Bool
valid :: FilePath -> Bool
	
	-- | Split a search path, such as @$PATH@ or @$PYTHONPATH@, into
	-- a list of 'FilePath's.
	--
	-- Note: The type of @platformTextFormat@ can change depending upon the
	-- underlying compilation platform. Consider using 'splitSearchPathString'
	-- instead. See 'Rules' for more information.
	, Rules platformFormat -> platformFormat -> [FilePath]
splitSearchPath :: platformFormat -> [FilePath]
	
	-- | splitSearchPathString is like 'splitSearchPath', but takes a string
	-- encoded in the format used by @System.IO@.
	, Rules platformFormat -> String -> [FilePath]
splitSearchPathString :: String -> [FilePath]
	
	-- | Attempt to convert a 'FilePath' to human&#x2010;readable text.
	--
	-- If the path is decoded successfully, the result is a 'Right'
	-- containing the decoded text. Successfully decoded text can be
	-- converted back to the original path using 'fromText'.
	--
	-- If the path cannot be decoded, the result is a 'Left' containing an
	-- approximation of the original path. If displayed to the user, this
	-- value should be accompanied by some warning that the path has an
	-- invalid encoding. Approximated text cannot be converted back to the
	-- original path.
	--
	-- This function ignores the user&#x2019;s locale, and assumes all
	-- file paths are encoded in UTF8. If you need to display file paths
	-- with an unusual or obscure encoding, use 'encode' and then decode
	-- them manually.
	--
	-- Since: 0.2
	, Rules platformFormat -> FilePath -> Either Text Text
toText :: FilePath -> Either T.Text T.Text
	
	-- | Convert human&#x2010;readable text into a 'FilePath'.
	--
	-- This function ignores the user&#x2019;s locale, and assumes all
	-- file paths are encoded in UTF8. If you need to create file paths
	-- with an unusual or obscure encoding, encode them manually and then
	-- use 'decode'.
	--
	-- Since: 0.2
	, Rules platformFormat -> Text -> FilePath
fromText :: T.Text -> FilePath
	
	-- | Convert a 'FilePath' to a platform&#x2010;specific format,
	-- suitable for use with external OS functions.
	--
	-- Note: The type of @platformTextFormat@ can change depending upon the
	-- underlying compilation platform. Consider using 'toText' or
	-- 'encodeString' instead. See 'Rules' for more information.
        --
	-- Since: 0.3
	, Rules platformFormat -> FilePath -> platformFormat
encode :: FilePath -> platformFormat
	
	-- | Convert a 'FilePath' from a platform&#x2010;specific format,
	-- suitable for use with external OS functions.
	--
	-- Note: The type of @platformTextFormat@ can change depending upon the
	-- underlying compilation platform. Consider using 'fromText' or
	-- 'decodeString' instead. See 'Rules' for more information.
        --
	-- Since: 0.3
	, Rules platformFormat -> platformFormat -> FilePath
decode :: platformFormat -> FilePath
	
	-- | Attempt to convert a 'FilePath' to a string suitable for use with
	-- functions in @System.IO@. The contents of this string are
	-- platform&#x2010;dependent, and are not guaranteed to be
	-- human&#x2010;readable. For converting 'FilePath's to a
	-- human&#x2010;readable format, use 'toText'.
	--
	-- Since: 0.3.1
	, Rules platformFormat -> FilePath -> String
encodeString :: FilePath -> String
	
	-- | Attempt to parse a 'FilePath' from a string suitable for use
	-- with functions in @System.IO@. Do not use this function for parsing
	-- human&#x2010;readable paths, as the character set decoding is
	-- platform&#x2010;dependent. For converting human&#x2010;readable
	-- text to a 'FilePath', use 'fromText'.
	--
	-- Since: 0.3.1
	, Rules platformFormat -> String -> FilePath
decodeString :: String -> FilePath
	}

instance Show (Rules a) where
	showsPrec :: Int -> Rules a -> ShowS
showsPrec d :: Int
d r :: Rules a
r = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 10)
		(String -> ShowS
showString "Rules " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ShowS
forall a. Show a => a -> ShowS
shows (Rules a -> Text
forall platformFormat. Rules platformFormat -> Text
rulesName Rules a
r))

escape :: T.Text -> Chunk
escape :: Text -> String
escape t :: Text
t = Text -> String
T.unpack Text
t

unescape :: Chunk -> (T.Text, Bool)
unescape :: String -> (Text, Bool)
unescape cs :: String
cs = if (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\c :: Char
c -> Char -> Int
ord Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 0xDC80 Bool -> Bool -> Bool
&& Char -> Int
ord Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0xDCFF) String
cs
	then (String -> Text
T.pack ((Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map (\c :: Char
c -> if Char -> Int
ord Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 0xDC80 Bool -> Bool -> Bool
&& Char -> Int
ord Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0xDCFF
		then Int -> Char
chr (Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- 0xDC00)
		else Char
c) String
cs), Bool
False)
	else (String -> Text
T.pack String
cs, Bool
True)

unescape' :: Chunk -> T.Text
unescape' :: String -> Text
unescape' = (Text, Bool) -> Text
forall a b. (a, b) -> a
fst ((Text, Bool) -> Text)
-> (String -> (Text, Bool)) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (Text, Bool)
unescape

unescapeBytes' :: Chunk -> B.ByteString
unescapeBytes' :: String -> ByteString
unescapeBytes' cs :: String
cs = if (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\c :: Char
c -> Char -> Int
ord Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 0xDC80 Bool -> Bool -> Bool
&& Char -> Int
ord Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0xDCFF) String
cs
	then [ByteString] -> ByteString
B8.concat ((Char -> ByteString) -> String -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (\c :: Char
c -> if Char -> Int
ord Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 0xDC80 Bool -> Bool -> Bool
&& Char -> Int
ord Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0xDCFF
		then Char -> ByteString
B8.singleton (Int -> Char
chr (Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- 0xDC00))
		else Text -> ByteString
TE.encodeUtf8 (Char -> Text
T.singleton Char
c)) String
cs)
	else Text -> ByteString
TE.encodeUtf8 (String -> Text
T.pack String
cs)

splitBy :: (a -> Bool) -> [a] -> [[a]]
splitBy :: (a -> Bool) -> [a] -> [[a]]
splitBy p :: a -> Bool
p = [a] -> [[a]]
loop where
	loop :: [a] -> [[a]]
loop xs :: [a]
xs = let
		(chunk :: [a]
chunk, rest :: [a]
rest) = (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break a -> Bool
p [a]
xs
		cont :: [[a]]
cont = [a]
chunk [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [a] -> [[a]]
loop ([a] -> [a]
forall a. [a] -> [a]
tail [a]
rest)
		in if [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
rest then [[a]
chunk] else [[a]]
cont

textSplitBy :: (Char -> Bool) -> T.Text -> [T.Text]
#if MIN_VERSION_text(0,11,0)
textSplitBy :: (Char -> Bool) -> Text -> [Text]
textSplitBy = (Char -> Bool) -> Text -> [Text]
T.split
#else
textSplitBy = T.splitBy
#endif

parseFilename :: Chunk -> (Maybe Basename, [Extension])
parseFilename :: String -> (Maybe String, [String])
parseFilename filename :: String
filename = (Maybe String, [String])
parsed where
	parsed :: (Maybe String, [String])
parsed = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
filename
		then (Maybe String
forall a. Maybe a
Nothing, [])
		else case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '.') String
filename of
			(leadingDots :: String
leadingDots, baseAndExts :: String
baseAndExts) -> case (Char -> Bool) -> String -> [String]
forall a. (a -> Bool) -> [a] -> [[a]]
splitBy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '.') String
baseAndExts of
				[] -> (String -> String -> Maybe String
forall a. [a] -> [a] -> Maybe [a]
joinDots String
leadingDots "", [])
				(name' :: String
name':exts' :: [String]
exts') -> (String -> String -> Maybe String
forall a. [a] -> [a] -> Maybe [a]
joinDots String
leadingDots String
name', [String]
exts')
	joinDots :: [a] -> [a] -> Maybe [a]
joinDots leadingDots :: [a]
leadingDots base :: [a]
base = case [a]
leadingDots [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
base of
		[] -> Maybe [a]
forall a. Maybe a
Nothing
		joined :: [a]
joined -> [a] -> Maybe [a]
forall a. a -> Maybe a
Just [a]
joined

maybeDecodeUtf8 :: B.ByteString -> Maybe T.Text
maybeDecodeUtf8 :: ByteString -> Maybe Text
maybeDecodeUtf8 bytes :: ByteString
bytes = case ByteString -> Either UnicodeException Text
TE.decodeUtf8' ByteString
bytes of
	Left _ -> Maybe Text
forall a. Maybe a
Nothing
	Right text :: Text
text -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
text