diff --git a/System/FilePath.hs b/System/FilePath.hs --- a/System/FilePath.hs +++ b/System/FilePath.hs @@ -51,13 +51,11 @@ ) where import Prelude hiding (FilePath, concat, null) -import qualified Prelude as P -import qualified Data.ByteString as B -import qualified Data.ByteString.Char8 as B8 import Data.List (foldl') import Data.Maybe (isNothing) import qualified Data.Monoid as M +import qualified Data.Text as T import System.FilePath.Internal @@ -84,11 +82,11 @@ directory p = empty { pathRoot = pathRoot p , pathDirectories = let - starts = map (Just . B8.pack) [".", ".."] - dot | safeHead (pathDirectories p) `elem` starts = [] - | isNothing (pathRoot p) = [B8.pack "."] - | otherwise = [] - in dot ++ pathDirectories p + starts = map Just [dot, dots] + dot' | safeHead (pathDirectories p) `elem` starts = [] + | isNothing (pathRoot p) = [dot] + | otherwise = [] + in dot' ++ pathDirectories p } -- | Retrieves the 'FilePath'’s parent directory. @@ -96,15 +94,15 @@ parent p = empty { pathRoot = pathRoot p , pathDirectories = let - starts = map (Just . B8.pack) [".", ".."] + starts = map Just [dot, dots] directories = if null (filename p) then safeInit (pathDirectories p) else pathDirectories p - dot | safeHead directories `elem` starts = [] - | isNothing (pathRoot p) = [B8.pack "."] - | otherwise = [] - in dot ++ directories + dot' | safeHead directories `elem` starts = [] + | isNothing (pathRoot p) = [dot] + | otherwise = [] + in dot' ++ directories } -- | Retrieve a 'FilePath'’s filename component. @@ -156,7 +154,7 @@ directories = xDirectories ++ pathDirectories y xDirectories = (pathDirectories x ++) $ if null (filename x) then [] - else [filenameBytes x] + else [filenameChunk x] -- | An alias for 'append'. () :: FilePath -> FilePath -> FilePath @@ -198,9 +196,6 @@ collapse p = p { pathDirectories = reverse newDirs } where (_, newDirs) = foldl' step (True, []) (pathDirectories p) - dot = B8.pack "." - dots = B8.pack ".." - step (True, acc) c = (False, c:acc) step (_, acc) c | c == dot = (False, acc) step (_, acc) c | c == dots = case acc of @@ -216,29 +211,31 @@ -- | Get a 'FilePath'’s last extension, or 'Nothing' if it has no -- extensions. -extension :: FilePath -> Maybe B.ByteString +extension :: FilePath -> Maybe T.Text extension p = case extensions p of [] -> Nothing es -> Just (last es) -- | Get a 'FilePath'’s full extension list. -extensions :: FilePath -> [B.ByteString] -extensions = pathExtensions +extensions :: FilePath -> [T.Text] +extensions = map chunkText . pathExtensions -- | Get whether a 'FilePath'’s last extension is the predicate. -hasExtension :: FilePath -> B.ByteString -> Bool +hasExtension :: FilePath -> T.Text -> Bool hasExtension p e = extension p == Just e -- | Append an extension to the end of a 'FilePath'. -addExtension :: FilePath -> B.ByteString -> FilePath +addExtension :: FilePath -> T.Text -> FilePath addExtension p ext = addExtensions p [ext] -- | Append many extensions to the end of a 'FilePath'. -addExtensions :: FilePath -> [B.ByteString] -> FilePath -addExtensions p exts = p { pathExtensions = pathExtensions p ++ exts } +addExtensions :: FilePath -> [T.Text] -> FilePath +addExtensions p exts = p { pathExtensions = newExtensions } where + newExtensions = pathExtensions p ++ chunks + chunks = map (\e -> Chunk e True) exts -- | An alias for 'addExtension'. -(<.>) :: FilePath -> B.ByteString -> FilePath +(<.>) :: FilePath -> T.Text -> FilePath (<.>) = addExtension -- | Remove a 'FilePath'’s last extension. @@ -250,20 +247,20 @@ dropExtensions p = p { pathExtensions = [] } -- | Replace a 'FilePath'’s last extension. -replaceExtension :: FilePath -> B.ByteString -> FilePath +replaceExtension :: FilePath -> T.Text -> FilePath replaceExtension = addExtension . dropExtension -- | Remove all extensions from a 'FilePath', and replace them with a new -- list. -replaceExtensions :: FilePath -> [B.ByteString] -> FilePath +replaceExtensions :: FilePath -> [T.Text] -> FilePath replaceExtensions = addExtensions . dropExtensions -- | @splitExtension p = ('dropExtension' p, 'extension' p)@ -splitExtension :: FilePath -> (FilePath, Maybe B.ByteString) +splitExtension :: FilePath -> (FilePath, Maybe T.Text) splitExtension p = (dropExtension p, extension p) -- | @splitExtensions p = ('dropExtensions' p, 'extensions' p)@ -splitExtensions :: FilePath -> (FilePath, [B.ByteString]) +splitExtensions :: FilePath -> (FilePath, [T.Text]) splitExtensions p = (dropExtensions p, extensions p) ------------------------------------------------------------------------------- diff --git a/System/FilePath/CurrentOS.hs b/System/FilePath/CurrentOS.hs --- a/System/FilePath/CurrentOS.hs +++ b/System/FilePath/CurrentOS.hs @@ -18,10 +18,10 @@ , currentOS -- * Type conversions - , toBytes - , fromBytes , toText , fromText + , encode + , decode -- * Rule‐specific path properties , valid @@ -36,8 +36,14 @@ import qualified System.FilePath as F import qualified System.FilePath.Rules as R -currentOS :: R.Rules -#if defined(mingw32_HOST_OS) || defined(__MINGW32__) +#if defined(CABAL_OS_WINDOWS) +#define PLATFORM_PATH_FORMAT T.Text +#else +#define PLATFORM_PATH_FORMAT B.ByteString +#endif + +currentOS :: R.Rules PLATFORM_PATH_FORMAT +#if defined(CABAL_OS_WINDOWS) currentOS = R.windows #else currentOS = R.posix @@ -47,18 +53,10 @@ fromString = R.fromText currentOS . T.pack instance Show F.FilePath where - showsPrec d path = showParen (d > 10) $ - showString "FilePath " . shows (toBytes path) - --- | Convert a 'FilePath' into a strict 'B.ByteString', suitable for passing --- to OS libraries. -toBytes :: F.FilePath -> B.ByteString -toBytes = R.toBytes currentOS - --- | Parse a strict 'B.ByteString', such as those received from OS libraries, --- into a 'FilePath'. -fromBytes :: B.ByteString -> F.FilePath -fromBytes = R.fromBytes currentOS + showsPrec d path = showParen (d > 10) (ss "FilePath " . s txt) where + s = shows + ss = showString + txt = either id id (toText path) -- | Attempt to convert a 'FilePath' to human‐readable text. -- @@ -96,5 +94,11 @@ -- | Split a search path, such as @$PATH@ or @$PYTHONPATH@, into a list -- of 'FilePath's. -splitSearchPath :: B.ByteString -> [F.FilePath] +splitSearchPath :: PLATFORM_PATH_FORMAT -> [F.FilePath] splitSearchPath = R.splitSearchPath currentOS + +encode :: F.FilePath -> PLATFORM_PATH_FORMAT +encode = R.encode currentOS + +decode :: PLATFORM_PATH_FORMAT -> F.FilePath +decode = R.decode currentOS diff --git a/System/FilePath/Internal.hs b/System/FilePath/Internal.hs --- a/System/FilePath/Internal.hs +++ b/System/FilePath/Internal.hs @@ -10,21 +10,27 @@ -- module System.FilePath.Internal where -import Prelude hiding (FilePath) +import Prelude hiding (FilePath) -import qualified Data.ByteString as B -import qualified Data.ByteString.Char8 as B8 import Data.Data (Data) +import Data.List (intersperse) +import qualified Data.Text as T import Data.Typeable (Typeable) ------------------------------------------------------------------------------- -- File Paths ------------------------------------------------------------------------------- -type Directory = B.ByteString -type Basename = B.ByteString -type Extension = B.ByteString +data Chunk = Chunk + { chunkText :: T.Text + , chunkGood :: Bool + } + deriving (Eq, Ord, Data, Typeable) +type Directory = Chunk +type Basename = Chunk +type Extension = Chunk + data Root = RootPosix | RootWindowsVolume Char @@ -43,35 +49,80 @@ empty :: FilePath empty = FilePath Nothing [] Nothing [] -filenameBytes :: FilePath -> B.ByteString -filenameBytes p = B.append name ext where - name = maybe B.empty id (pathBasename p) - ext = case pathExtensions p of - [] -> B.empty - exts -> B.intercalate (B8.pack ".") (B.empty:exts) +dot :: Chunk +dot = Chunk (T.pack ".") True +dots :: Chunk +dots = Chunk (T.pack "..") True + +filenameChunk :: FilePath -> Chunk +filenameChunk p = Chunk (T.concat texts) (and good) where + name = maybe (Chunk T.empty True) id (pathBasename p) + exts = case pathExtensions p of + [] -> [] + exts' -> intersperse dot ((Chunk T.empty True):exts') + chunks = name:exts + + texts = map chunkText chunks + good = map chunkGood chunks + ------------------------------------------------------------------------------- -- Rules ------------------------------------------------------------------------------- -data Rules = Rules - { rulesName :: String - , toByteChunks :: FilePath -> [B.ByteString] - - -- | Parse a strict 'B.ByteString', such as those received from - -- OS libraries, into a 'FilePath'. - , fromBytes :: B.ByteString -> FilePath +data Rules platformFormat = Rules + { 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'. + -- | Check if a 'FilePath' is valid; it must not contain any illegal + -- characters, and must have a root appropriate to the current + -- 'Rules'. , valid :: FilePath -> Bool -- | Split a search path, such as @$PATH@ or @$PYTHONPATH@, into -- a list of 'FilePath's. - , splitSearchPath :: B.ByteString -> [FilePath] + , splitSearchPath :: platformFormat -> [FilePath] + + -- | Attempt to convert a 'FilePath' to human‐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’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 'toBytes' and then decode + -- them manually. + -- + -- Since: 0.2 + , toText :: FilePath -> Either T.Text T.Text + + -- | Convert human‐readable text into a 'FilePath'. + -- + -- This function ignores the user’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 'fromBytes'. + -- + -- Since: 0.2 + , fromText :: T.Text -> FilePath + + -- | Convert a 'FilePath' to the platform’s underlying format. + -- + -- Since: 0.3 + , encode :: FilePath -> platformFormat + + -- | Convert the platform’s underlying format to a 'FilePath'. + -- + -- Since: 0.3 + , decode :: platformFormat -> FilePath } -instance Show Rules where - showsPrec d r = showParen (d > 10) $ - showString "Rules " . shows (rulesName r) +instance Show (Rules a) where + showsPrec d r = showParen (d > 10) + (showString "Rules " . shows (rulesName r)) diff --git a/System/FilePath/Rules.hs b/System/FilePath/Rules.hs --- a/System/FilePath/Rules.hs +++ b/System/FilePath/Rules.hs @@ -12,10 +12,10 @@ , windows -- * Type conversions - , toBytes - , fromBytes , toText , fromText + , encode + , decode -- * Rule‐specific path properties , valid @@ -35,68 +35,21 @@ import Data.Text.Encoding.Error (UnicodeException) import System.IO.Unsafe (unsafePerformIO) -import System.FilePath hiding (root, filename) +import System.FilePath hiding (root, filename, basename) import System.FilePath.Internal ------------------------------------------------------------------------------- --- Public helpers -------------------------------------------------------------------------------- - --- | Convert a 'FilePath' into a strict 'B.ByteString', suitable for passing --- to OS libraries. -toBytes :: Rules -> FilePath -> B.ByteString -toBytes r = B.concat . toByteChunks r - --- | Attempt to convert a 'FilePath' to human‐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’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 'toBytes' and then decode them manually. --- --- Since: 0.2 -toText :: Rules -> FilePath -> Either T.Text T.Text -toText r path = encoded where - bytes = toBytes r path - encoded = case maybeDecodeUtf8 bytes of - Just text -> Right text - Nothing -> Left (T.pack (B8.unpack bytes)) - --- | Convert human‐readable text into a 'FilePath'. --- --- This function ignores the user’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 'fromBytes'. --- --- Since: 0.2 -fromText :: Rules -> T.Text -> FilePath -fromText r text = fromBytes r (TE.encodeUtf8 text) - -------------------------------------------------------------------------------- -- Generic ------------------------------------------------------------------------------- -rootBytes :: Maybe Root -> B.ByteString -rootBytes r = B8.pack $ flip (maybe "") r $ \r' -> case r' of +rootText :: Maybe Root -> T.Text +rootText r = T.pack $ flip (maybe "") r $ \r' -> case r' of RootPosix -> "/" RootWindowsVolume c -> c : ":\\" RootWindowsCurrentVolume -> "\\" -byteDirectories :: FilePath -> [B.ByteString] -byteDirectories path = pathDirectories path ++ [filenameBytes path] - -upperBytes :: B.ByteString -> B.ByteString -upperBytes bytes = (`B.map` bytes) $ \b -> if b >= 0x41 && b <= 0x5A - then b + 0x20 - else b +directoryChunks :: FilePath -> [Chunk] +directoryChunks path = pathDirectories path ++ [filenameChunk path] maybeDecodeUtf8 :: B.ByteString -> Maybe T.Text maybeDecodeUtf8 = excToMaybe . TE.decodeUtf8 where @@ -113,49 +66,76 @@ ------------------------------------------------------------------------------- -- | Linux, BSD, OS X, and other UNIX or UNIX-like operating systems. -posix :: Rules +posix :: Rules B.ByteString posix = Rules - { rulesName = "POSIX" - , toByteChunks = posixToByteChunks - , fromBytes = posixFromBytes + { rulesName = T.pack "POSIX" , valid = posixValid , splitSearchPath = posixSplitSearch + , toText = posixToText + , fromText = posixFromText + , encode = posixToBytes + , decode = posixFromBytes } -posixToByteChunks :: FilePath -> [B.ByteString] -posixToByteChunks p = root : chunks where - root = rootBytes $ pathRoot p - chunks = intersperse (B8.pack "/") $ byteDirectories p - -posixFromBytes :: B.ByteString -> FilePath -posixFromBytes bytes = if B.null bytes then empty else path where - path = FilePath root directories basename exts - - split = B.split 0x2F bytes +posixToText :: FilePath -> Either T.Text T.Text +posixToText p = if good then Right text else Left text where + good = and (map chunkGood chunks) + text = T.concat (root : map chunkText chunks) - (root, pastRoot) = if B.null (head split) - then (Just RootPosix, tail split) - else (Nothing, split) + root = rootText (pathRoot p) + chunks = intersperse (Chunk (T.pack "/") True) (directoryChunks p) + +posixFromChunks :: [Chunk] -> FilePath +posixFromChunks chunks = FilePath root directories basename exts where + (root, pastRoot) = if T.null (chunkText (head chunks)) + then (Just RootPosix, tail chunks) + else (Nothing, chunks) (directories, filename) - | P.null pastRoot = ([], B.empty) + | P.null pastRoot = ([], Chunk T.empty True) | otherwise = case last pastRoot of - fn | fn == B8.pack "." -> (goodDirs pastRoot, B.empty) - fn | fn == B8.pack ".." -> (goodDirs pastRoot, B.empty) + fn | fn == dot -> (goodDirs pastRoot, Chunk T.empty True) + fn | fn == dots -> (goodDirs pastRoot, Chunk T.empty True) fn -> (goodDirs (init pastRoot), fn) - goodDirs = filter (not . B.null) + goodDirs = filter (not . T.null . chunkText) - (basename, exts) = if B.null filename + (basename, exts) = if T.null (chunkText filename) then (Nothing, []) - else case B.split 0x2E filename of + else case T.split (== '.') (chunkText filename) of [] -> (Nothing, []) - (name':exts') -> (Just name', exts') + (name':exts') -> if chunkGood filename + then (Just (Chunk name' True), map (\e -> Chunk e True) exts') + else (Just (checkChunk name'), map checkChunk exts') + + checkChunk raw = case maybeDecodeUtf8 (B8.pack (T.unpack raw)) of + Just text -> Chunk text True + Nothing -> Chunk raw False +posixFromText :: T.Text -> FilePath +posixFromText text = if T.null text + then empty + else posixFromChunks (map (\t -> Chunk t True) (T.split (== '/') text)) + +posixToBytes :: FilePath -> B.ByteString +posixToBytes p = B.concat (root : chunks) where + root = TE.encodeUtf8 (rootText (pathRoot p)) + chunks = intersperse (B8.pack "/") (map chunkBytes (directoryChunks p)) + chunkBytes c = if chunkGood c + then TE.encodeUtf8 (chunkText c) + else B8.pack (T.unpack (chunkText c)) + +posixFromBytes :: B.ByteString -> FilePath +posixFromBytes bytes = if B.null bytes + then empty + else posixFromChunks $ flip map (B.split 0x2F bytes) $ \b -> case maybeDecodeUtf8 b of + Just text -> Chunk text True + Nothing -> Chunk (T.pack (B8.unpack b)) False + posixValid :: FilePath -> Bool posixValid p = validRoot && validDirectories where - validDirectories = flip all (byteDirectories p) - $ not . B.any (\b -> b == 0 || b == 0x2F) + validDirectories = all validChunk (directoryChunks p) + validChunk ch = not (T.any (\c -> c == '\0' || c == '/') (chunkText ch)) validRoot = case pathRoot p of Nothing -> True Just RootPosix -> True @@ -170,57 +150,58 @@ ------------------------------------------------------------------------------- -- | Windows and DOS -windows :: Rules +windows :: Rules T.Text windows = Rules - { rulesName = "Windows" - , toByteChunks = winToByteChunks - , fromBytes = winFromBytes + { rulesName = T.pack "Windows" , valid = winValid - , splitSearchPath = map winFromBytes . filter (not . B.null) . B.split 0x3B + , splitSearchPath = winSplit + , toText = Right . winToText + , fromText = winFromText + , encode = winToText + , decode = winFromText } -winToByteChunks :: FilePath -> [B.ByteString] -winToByteChunks p = root : chunks where - root = rootBytes $ pathRoot p - chunks = intersperse (B8.pack "\\") $ byteDirectories p +winToText :: FilePath -> T.Text +winToText p = T.concat (root : chunks) where + root = rootText (pathRoot p) + chunks = intersperse (T.pack "\\") (map chunkText (directoryChunks p)) -winFromBytes :: B.ByteString -> FilePath -winFromBytes bytes = if B.null bytes then empty else path where +winFromText :: T.Text -> FilePath +winFromText text = if T.null text then empty else path where path = FilePath root directories basename exts - split = B.splitWith (\b -> b == 0x2F || b == 0x5C) bytes + split = T.split (\c -> c == '/' || c == '\\') text (root, pastRoot) = let head' = head split tail' = tail split - in if B.null head' + in if T.null head' then (Just RootWindowsCurrentVolume, tail') - else if B.elem 0x3A head' + else if T.any (== ':') head' then (Just (parseDrive head'), tail') else (Nothing, split) - parseDrive bytes' = RootWindowsVolume c where - c = (toUpper . chr . fromIntegral . B.head) bytes' + parseDrive = RootWindowsVolume . toUpper . T.head (directories, filename) - | P.null pastRoot = ([], B.empty) + | P.null pastRoot = ([], T.empty) | otherwise = case last pastRoot of - fn | fn == B8.pack "." -> (goodDirs pastRoot, B.empty) - fn | fn == B8.pack ".." -> (goodDirs pastRoot, B.empty) + fn | fn == chunkText dot -> (goodDirs pastRoot, T.empty) + fn | fn == chunkText dots -> (goodDirs pastRoot, T.empty) fn -> (goodDirs (init pastRoot), fn) - goodDirs = filter (not . B.null) + goodDirs = map (\t -> Chunk t True) . filter (not . T.null) - (basename, exts) = if B.null filename + (basename, exts) = if T.null filename then (Nothing, []) - else case B.split 0x2E filename of + else case T.split (== '.') filename of [] -> (Nothing, []) - (name':exts') -> (Just name', exts') + (name':exts') -> (Just (Chunk name' True), map (\e -> Chunk e True) exts') winValid :: FilePath -> Bool winValid p = validRoot && noReserved && validCharacters where - reservedChars = [0..0x1F] ++ [0x2F, 0x5C, 0x3F, 0x2A, 0x3A, 0x7C, 0x22, 0x3C, 0x3E] - reservedNames = map B8.pack + reservedChars = map chr [0..0x1F] ++ "/\\?*:|\"<>" + reservedNames = map T.pack [ "AUX", "CLOCK$", "COM1", "COM2", "COM3", "COM4" , "COM5", "COM6", "COM7", "COM8", "COM9", "CON" , "LPT1", "LPT2", "LPT3", "LPT4", "LPT5", "LPT6" @@ -230,12 +211,15 @@ validRoot = case pathRoot p of Nothing -> True Just RootWindowsCurrentVolume -> True - Just (RootWindowsVolume v) -> elem (toUpper v) ['A'..'Z'] + Just (RootWindowsVolume v) -> elem v ['A'..'Z'] _ -> False noExt = p { pathExtensions = [] } - noReserved = flip all (byteDirectories noExt) - $ \c -> notElem (upperBytes c) reservedNames + noReserved = flip all (directoryChunks noExt) + $ \fn -> notElem (T.toUpper (chunkText fn)) reservedNames - validCharacters = flip all (byteDirectories p) - $ not . B.any (`elem` reservedChars) + validCharacters = flip all (directoryChunks p) + $ not . T.any (`elem` reservedChars) . chunkText + +winSplit :: T.Text -> [FilePath] +winSplit = map winFromText . filter (not . T.null) . T.split (== ';') diff --git a/system-filepath.cabal b/system-filepath.cabal --- a/system-filepath.cabal +++ b/system-filepath.cabal @@ -1,5 +1,5 @@ name: system-filepath -version: 0.2 +version: 0.3 synopsis: High-level, byte-based file and directory path manipulations license: MIT license-file: license.txt @@ -25,6 +25,9 @@ base >= 3 && < 5 , bytestring >= 0.9 && < 0.10 , text >= 0.3 && < 0.12 + + if os(windows) + cpp-options: -DCABAL_OS_WINDOWS exposed-modules: System.FilePath