system-filepath 0.2 → 0.3
raw patch · 5 files changed
+222/−183 lines, 5 files
Files
- System/FilePath.hs +26/−29
- System/FilePath/CurrentOS.hs +21/−17
- System/FilePath/Internal.hs +77/−26
- System/FilePath/Rules.hs +94/−110
- system-filepath.cabal +4/−1
System/FilePath.hs view
@@ -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) -------------------------------------------------------------------------------
System/FilePath/CurrentOS.hs view
@@ -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
System/FilePath/Internal.hs view
@@ -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))
System/FilePath/Rules.hs view
@@ -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 (== ';')
system-filepath.cabal view
@@ -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