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)
import System.IO.Unsafe (unsafePerformIO)
type Directory = T.Text
type Basename = T.Text
type Extension = T.Text
data Root
= RootPosix
| RootWindowsVolume Char
| RootWindowsCurrentVolume
deriving (Eq, Ord, Data, Typeable)
data FilePath = FilePath
{ pathRoot :: Maybe Root
, pathDirectories :: [Directory]
, pathBasename :: Maybe Basename
, pathExtensions :: [Extension]
}
deriving (Data, Typeable)
instance Eq FilePath where
x == y = compare x y == EQ
instance Ord FilePath where
compare = comparing (\p ->
(pathRoot p
, fmap unescape' (pathDirectories p)
, fmap unescape' (pathBasename p)
, fmap unescape' (pathExtensions p)
))
instance NFData Root where
rnf (RootWindowsVolume c) = rnf c
rnf _ = ()
instance NFData FilePath where
rnf p = rnf (pathRoot p) `seq` rnf (pathDirectories p) `seq` rnf (pathBasename p) `seq` rnf (pathExtensions p)
empty :: FilePath
empty = FilePath Nothing [] Nothing []
dot :: T.Text
dot = T.pack "."
dots :: T.Text
dots = T.pack ".."
filenameText :: FilePath -> T.Text
filenameText p = T.concat (name:exts) where
name = maybe T.empty id (pathBasename p)
exts = case pathExtensions p of
[] -> []
exts' -> intersperse dot (T.empty:exts')
data Rules platformFormat = Rules
{ rulesName :: T.Text
, valid :: FilePath -> Bool
, splitSearchPath :: platformFormat -> [FilePath]
, toText :: FilePath -> Either T.Text T.Text
, fromText :: T.Text -> FilePath
, encode :: FilePath -> platformFormat
, decode :: platformFormat -> FilePath
, encodeString :: FilePath -> String
, decodeString :: String -> FilePath
}
instance Show (Rules a) where
showsPrec d r = showParen (d > 10)
(showString "Rules " . shows (rulesName r))
textSplitBy :: (Char -> Bool) -> T.Text -> [T.Text]
#if MIN_VERSION_text(0,11,0)
textSplitBy = T.split
#else
textSplitBy = T.splitBy
#endif
unescape :: T.Text -> (T.Text, Bool)
unescape t = if T.any (\c -> ord c >= 0xEF00 && ord c <= 0xEFFF) t
then (T.map (\c -> if ord c >= 0xEF00 && ord c <= 0xEFFF
then chr (ord c 0xEF00)
else c) t, False)
else (t, True)
unescape' :: T.Text -> T.Text
unescape' = fst . unescape
unescapeBytes' :: T.Text -> B8.ByteString
unescapeBytes' t = B8.concat (map (\c -> if ord c >= 0xEF00 && ord c <= 0xEFFF
then B8.singleton (chr (ord c 0xEF00))
else TE.encodeUtf8 (T.singleton c)) (T.unpack t))
parseFilename :: T.Text -> (Maybe Basename, [Extension])
parseFilename filename = parsed where
parsed = if T.null filename
then (Nothing, [])
else case textSplitBy (== '.') filename of
[] -> (Nothing, [])
(name':exts') -> (Just (checkChunk name'), map checkChunk exts')
checkChunk t = if chunkGood t
then t
else case maybeDecodeUtf8 (unescapeBytes' t) of
Just text -> text
Nothing -> t
chunkGood t = not (T.any (\c -> ord c >= 0xEF00 && ord c <= 0xEFFF) t)
maybeDecodeUtf8 :: B.ByteString -> Maybe T.Text
maybeDecodeUtf8 = excToMaybe . TE.decodeUtf8 where
excToMaybe :: a -> Maybe a
excToMaybe x = unsafePerformIO $ Exc.catch
(fmap Just (Exc.evaluate x))
unicodeError
unicodeError :: UnicodeException -> IO (Maybe a)
unicodeError _ = return Nothing