diff --git a/System/FilePath.hs b/System/FilePath.hs --- a/System/FilePath.hs +++ b/System/FilePath.hs @@ -1,4 +1,3 @@ ------------------------------------------------------------------------------ -- | -- Module: System.FilePath -- Copyright: 2010 John Millikin @@ -7,12 +6,11 @@ -- Maintainer: jmillikin@gmail.com -- Portability: portable -- --- High-level, byte-based file and directory path manipulations. You probably --- want to import "System.FilePath.CurrentOS" instead, since it handles --- detecting which rules to use in the current compilation. +-- High‐level, byte‐based file and directory path +-- manipulations. You probably want to import "System.FilePath.CurrentOS" +-- instead, since it handles detecting which rules to use in the current +-- compilation. -- ------------------------------------------------------------------------------ - module System.FilePath ( FilePath , empty @@ -32,6 +30,7 @@ , () , concat , commonPrefix + , collapse -- * Extensions , extension @@ -51,14 +50,17 @@ , splitExtensions ) where -import Prelude hiding (FilePath, concat, null) +import Prelude hiding (FilePath, concat, null) import qualified Prelude as P -import Data.Maybe (isNothing) -import qualified Data.Monoid as M -import System.FilePath.Internal + 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 System.FilePath.Internal + instance M.Monoid FilePath where mempty = empty mappend = append @@ -68,71 +70,72 @@ -- Basic properties ------------------------------------------------------------------------------- --- | @null p == (p == 'empty')@ +-- | @null p = (p == 'empty')@ null :: FilePath -> Bool null = (== empty) --- | Retrieves the 'FilePath''s root. +-- | Retrieves the 'FilePath'’s root. root :: FilePath -> FilePath root p = empty { pathRoot = pathRoot p } --- | Retrieves the 'FilePath''s directory. If the path is already a +-- | Retrieves the 'FilePath'’s directory. If the path is already a -- directory, it is returned unchanged. directory :: FilePath -> FilePath directory p = empty { pathRoot = pathRoot p - , pathComponents = let + , pathDirectories = let starts = map (Just . B8.pack) [".", ".."] - dot = if safeHead (pathComponents p) `elem` starts - then [] - else if isNothing (pathRoot p) - then [B8.pack "."] - else [] - in dot ++ pathComponents p + dot | safeHead (pathDirectories p) `elem` starts = [] + | isNothing (pathRoot p) = [B8.pack "."] + | otherwise = [] + in dot ++ pathDirectories p } --- | Retrieves the 'FilePath''s parent directory. +-- | Retrieves the 'FilePath'’s parent directory. parent :: FilePath -> FilePath parent p = empty { pathRoot = pathRoot p - , pathComponents = let + , pathDirectories = let starts = map (Just . B8.pack) [".", ".."] - components = if null (filename p) - then safeInit (pathComponents p) - else pathComponents p - - dot = if safeHead components `elem` starts - then [] - else if isNothing (pathRoot p) - then [B8.pack "."] - else [] + directories = if null (filename p) + then safeInit (pathDirectories p) + else pathDirectories p - in dot ++ components + dot | safeHead directories `elem` starts = [] + | isNothing (pathRoot p) = [B8.pack "."] + | otherwise = [] + in dot ++ directories } --- | Retrieve the filename component of a 'FilePath'. --- @filename \"foo/bar.txt\" == \"bar.txt\"@. +-- | Retrieve a 'FilePath'’s filename component. +-- +-- @ +-- filename \"foo/bar.txt\" == \"bar.txt\" +-- @ filename :: FilePath -> FilePath filename p = empty { pathBasename = pathBasename p , pathExtensions = pathExtensions p } --- | Retrieve the basename component of a 'FilePath'. --- @filename \"foo/bar.txt\" == \"bar\"@. +-- | Retrieve a 'FilePath'’s basename component. +-- +-- @ +-- basename \"foo/bar.txt\" == \"bar\" +-- @ basename :: FilePath -> FilePath basename p = empty { pathBasename = pathBasename p } --- | Return whether the path is absolute. +-- | Test whether a path is absolute. absolute :: FilePath -> Bool absolute p = case pathRoot p of Just RootPosix -> True Just (RootWindowsVolume _) -> True _ -> False --- | Return whether the path is relative. +-- | Test whether a path is relative. relative :: FilePath -> Bool relative p = case pathRoot p of Just _ -> False @@ -148,10 +151,10 @@ append x y = if absolute y then y else xy where xy = y { pathRoot = pathRoot x - , pathComponents = components + , pathDirectories = directories } - components = xComponents ++ pathComponents y - xComponents = (pathComponents x ++) $ if null (filename x) + directories = xDirectories ++ pathDirectories y + xDirectories = (pathDirectories x ++) $ if null (filename x) then [] else [filenameBytes x] @@ -164,21 +167,19 @@ concat [] = empty concat ps = foldr1 append ps --- | Find the greatest common prefix between two 'FilePath's. +-- | Find the greatest common prefix between a list of 'FilePath's. commonPrefix :: [FilePath] -> FilePath commonPrefix [] = empty commonPrefix ps = foldr1 step ps where step x y = if pathRoot x /= pathRoot y then empty - else let cs = commonComponents x y in - if cs /= pathComponents x - then empty { pathRoot = pathRoot x, pathComponents = cs } - else if pathBasename x /= pathBasename y - then empty { pathRoot = pathRoot x, pathComponents = cs } - else let exts = commonExtensions x y in - x { pathExtensions = exts } + else let cs = commonDirectories x y in + if cs /= pathDirectories x || pathBasename x /= pathBasename y + then empty { pathRoot = pathRoot x, pathDirectories = cs } + else let exts = commonExtensions x y in + x { pathExtensions = exts } - commonComponents x y = common (pathComponents x) (pathComponents y) + commonDirectories x y = common (pathDirectories x) (pathDirectories y) commonExtensions x y = common (pathExtensions x) (pathExtensions y) common [] _ = [] @@ -187,22 +188,44 @@ then x : common xs ys else [] +-- | Remove @\".\"@ and @\"..\"@ directories from a path. +-- +-- Note that if any of the elements are symbolic links, 'collapse' may change +-- which file the path resolves to. +-- +-- Since: 0.2 +collapse :: FilePath -> FilePath +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 + [] -> (False, c:acc) + (h:ts) | h == dot -> (False, c:ts) + | h == dots -> (False, c:acc) + | otherwise -> (False, ts) + step (_, acc) c = (False, c:acc) + ------------------------------------------------------------------------------- -- Extensions ------------------------------------------------------------------------------- --- | Get a 'FilePath''s last extension, or 'Nothing' if it has no +-- | Get a 'FilePath'’s last extension, or 'Nothing' if it has no -- extensions. extension :: FilePath -> Maybe B.ByteString extension p = case extensions p of [] -> Nothing es -> Just (last es) --- | Get a 'FilePath''s full extension list. +-- | Get a 'FilePath'’s full extension list. extensions :: FilePath -> [B.ByteString] extensions = pathExtensions --- | Get whether a 'FilePath''s last extension is the predicate. +-- | Get whether a 'FilePath'’s last extension is the predicate. hasExtension :: FilePath -> B.ByteString -> Bool hasExtension p e = extension p == Just e @@ -218,7 +241,7 @@ (<.>) :: FilePath -> B.ByteString -> FilePath (<.>) = addExtension --- | Remove a 'FilePath''s last extension. +-- | Remove a 'FilePath'’s last extension. dropExtension :: FilePath -> FilePath dropExtension p = p { pathExtensions = safeInit (pathExtensions p) } @@ -226,7 +249,7 @@ dropExtensions :: FilePath -> FilePath dropExtensions p = p { pathExtensions = [] } --- | Replace a 'FilePath''s last extension. +-- | Replace a 'FilePath'’s last extension. replaceExtension :: FilePath -> B.ByteString -> FilePath replaceExtension = addExtension . dropExtension diff --git a/System/FilePath/CurrentOS.hs b/System/FilePath/CurrentOS.hs --- a/System/FilePath/CurrentOS.hs +++ b/System/FilePath/CurrentOS.hs @@ -1,4 +1,5 @@ ------------------------------------------------------------------------------ +{-# LANGUAGE CPP #-} + -- | -- Module: System.FilePath.CurrentOS -- Copyright: 2010 John Millikin @@ -7,38 +8,31 @@ -- Maintainer: jmillikin@gmail.com -- Portability: portable -- --- Re-exports contents of "System.FilePath.Rules", defaulting to the --- current OS's rules when needed. +-- Re‐exports contents of "System.FilePath.Rules", defaulting to the +-- current OS’s rules when needed. -- -- Also enables 'Show' and 'S.IsString' instances for 'F.FilePath'. -- ------------------------------------------------------------------------------ - -{-# LANGUAGE CPP #-} module System.FilePath.CurrentOS ( module System.FilePath , currentOS - -- * Rule-specific path properties - , valid - , normalise - , equivalent - - -- * Parsing file paths + -- * Type conversions , toBytes - , toLazyBytes - , toString , fromBytes - , fromLazyBytes - , fromString + , toText + , fromText - -- * Search paths + -- * Rule‐specific path properties + , valid , splitSearchPath ) where + import qualified Data.ByteString as B -import qualified Data.ByteString.Lazy as BL import qualified Data.String as S -import System.FilePath +import qualified Data.Text as T + +import System.FilePath import qualified System.FilePath as F import qualified System.FilePath.Rules as R @@ -50,48 +44,57 @@ #endif instance S.IsString F.FilePath where - fromString = R.fromString currentOS + fromString = R.fromText currentOS . T.pack instance Show F.FilePath where showsPrec d path = showParen (d > 10) $ showString "FilePath " . shows (toBytes path) --- | See 'R.valid' -valid :: F.FilePath -> Bool -valid = R.valid currentOS - --- | See 'R.normalise' -normalise :: F.FilePath -> F.FilePath -normalise = R.normalise currentOS - --- | See 'R.equivalent' -equivalent :: F.FilePath -> F.FilePath -> Bool -equivalent = R.equivalent currentOS - --- | See 'R.toBytes' +-- | Convert a 'FilePath' into a strict 'B.ByteString', suitable for passing +-- to OS libraries. toBytes :: F.FilePath -> B.ByteString toBytes = R.toBytes currentOS --- | See 'R.toLazyBytes' -toLazyBytes :: F.FilePath -> BL.ByteString -toLazyBytes = R.toLazyBytes currentOS - --- | See 'R.toString' -toString :: F.FilePath -> String -toString = R.toString currentOS - --- | See 'R.fromBytes' +-- | Parse a strict 'B.ByteString', such as those received from OS libraries, +-- into a 'FilePath'. fromBytes :: B.ByteString -> F.FilePath fromBytes = R.fromBytes currentOS --- | See 'R.fromLazyBytes' -fromLazyBytes :: BL.ByteString -> F.FilePath -fromLazyBytes = R.fromLazyBytes currentOS +-- | 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 :: F.FilePath -> Either T.Text T.Text +toText = R.toText currentOS --- | See 'R.fromString' -fromString :: String -> F.FilePath -fromString = R.fromString currentOS +-- | 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 -> F.FilePath +fromText = R.fromText currentOS --- | See 'R.splitSearchPath' +-- | Check if a 'FilePath' is valid; it must not contain any illegal +-- characters, and must have a root appropriate to the current 'R.Rules'. +valid :: F.FilePath -> Bool +valid = R.valid currentOS + +-- | Split a search path, such as @$PATH@ or @$PYTHONPATH@, into a list +-- of 'FilePath's. splitSearchPath :: B.ByteString -> [F.FilePath] splitSearchPath = R.splitSearchPath currentOS diff --git a/System/FilePath/Internal.hs b/System/FilePath/Internal.hs --- a/System/FilePath/Internal.hs +++ b/System/FilePath/Internal.hs @@ -1,4 +1,5 @@ ------------------------------------------------------------------------------ +{-# LANGUAGE DeriveDataTypeable #-} + -- | -- Module: System.FilePath.Internal -- Copyright: 2010 John Millikin @@ -7,22 +8,20 @@ -- Maintainer: jmillikin@gmail.com -- Portability: portable -- ------------------------------------------------------------------------------ - -{-# LANGUAGE DeriveDataTypeable #-} module System.FilePath.Internal where import Prelude hiding (FilePath) -import Data.Data (Data) -import Data.Typeable (Typeable) + import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as B8 +import Data.Data (Data) +import Data.Typeable (Typeable) ------------------------------------------------------------------------------- -- File Paths ------------------------------------------------------------------------------- -type Component = B.ByteString +type Directory = B.ByteString type Basename = B.ByteString type Extension = B.ByteString @@ -30,25 +29,23 @@ = RootPosix | RootWindowsVolume Char | RootWindowsCurrentVolume - deriving (Eq, Data, Typeable) + deriving (Eq, Ord, Data, Typeable) data FilePath = FilePath - { pathRoot :: (Maybe Root) - , pathComponents :: [Component] - , pathBasename :: (Maybe Basename) + { pathRoot :: Maybe Root + , pathDirectories :: [Directory] + , pathBasename :: Maybe Basename , pathExtensions :: [Extension] } - deriving (Eq, Data, Typeable) + deriving (Eq, Ord, Data, Typeable) --- | A file path with no root, components, or filename +-- | A file path with no root, directory, or filename empty :: FilePath empty = FilePath Nothing [] Nothing [] filenameBytes :: FilePath -> B.ByteString filenameBytes p = B.append name ext where - name = case pathBasename p of - Nothing -> B.empty - Just name' -> name' + name = maybe B.empty id (pathBasename p) ext = case pathExtensions p of [] -> B.empty exts -> B.intercalate (B8.pack ".") (B.empty:exts) @@ -64,9 +61,8 @@ -- | Parse a strict 'B.ByteString', such as those received from -- OS libraries, into a 'FilePath'. , fromBytes :: B.ByteString -> FilePath - , caseSensitive :: Bool - -- | Check if a 'FilePath' is valid; that is, it must not contain + -- | 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 @@ -74,10 +70,6 @@ -- | Split a search path, such as @$PATH@ or @$PYTHONPATH@, into -- a list of 'FilePath's. , splitSearchPath :: B.ByteString -> [FilePath] - - -- | Remove redundant characters. On case-insensitive platforms, - -- also lowercases any ASCII uppercase characters. - , normalise :: FilePath -> FilePath } instance Show Rules where diff --git a/System/FilePath/Rules.hs b/System/FilePath/Rules.hs --- a/System/FilePath/Rules.hs +++ b/System/FilePath/Rules.hs @@ -1,4 +1,3 @@ ------------------------------------------------------------------------------ -- | -- Module: System.FilePath.Rules -- Copyright: 2010 John Millikin @@ -7,63 +6,37 @@ -- Maintainer: jmillikin@gmail.com -- Portability: portable -- ------------------------------------------------------------------------------ - module System.FilePath.Rules ( Rules , posix , windows - -- * Rule-specific path properties - , valid - , normalise - , equivalent - - -- * Parsing file paths + -- * Type conversions , toBytes - , toLazyBytes - , toString , fromBytes - , fromLazyBytes - , fromString + , toText + , fromText - -- * Parsing search paths + -- * Rule‐specific path properties + , valid , splitSearchPath ) where -import Prelude hiding (FilePath, null) +import Prelude hiding (FilePath, null) import qualified Prelude as P -import Data.Char (toUpper, chr) -import Data.List (intersperse) + +import qualified Control.Exception as Exc import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as B8 -import qualified Data.ByteString.Lazy as BL -import qualified Data.ByteString.Lazy.Char8 as BL8 - -import System.FilePath hiding (root, filename) -import System.FilePath.Internal - -------------------------------------------------------------------------------- --- Rule-specific path properties -------------------------------------------------------------------------------- +import Data.Char (toUpper, chr) +import Data.List (intersperse) +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE +import Data.Text.Encoding.Error (UnicodeException) +import System.IO.Unsafe (unsafePerformIO) --- | Check if two different 'FilePath's refer to the same file. This does --- not perform any link resolution, so some equivalent files might be --- missed. -equivalent :: Rules -> FilePath -> FilePath -> Bool -equivalent r x y = n x == n y where - n p = if caseSensitive r - then normalise r p - else casefold (normalise r p) - - -- TODO: use proper unicode case folding here? I'm not sure there's - -- any way to do correct case-insensitive comparison without knowing - -- the filename's encoding. - casefold p = p - { pathComponents = map upperBytes $ pathComponents p - , pathBasename = fmap upperBytes $ pathBasename p - , pathExtensions = map upperBytes $ pathExtensions p - } +import System.FilePath hiding (root, filename) +import System.FilePath.Internal ------------------------------------------------------------------------------- -- Public helpers @@ -74,28 +47,38 @@ toBytes :: Rules -> FilePath -> B.ByteString toBytes r = B.concat . toByteChunks r --- | Convert a 'FilePath' into a lazy 'BL.ByteString'. -toLazyBytes :: Rules -> FilePath -> BL.ByteString -toLazyBytes r = BL.fromChunks . toByteChunks r - --- | Parse a lazy 'BL.ByteString' into a 'FilePath'. -fromLazyBytes :: Rules -> BL.ByteString -> FilePath -fromLazyBytes r = fromBytes r . B.concat . BL.toChunks - --- | Convert a 'FilePath' into a lazy 'String'. This is useful for --- interoperating with legacy libraries. No decoding is performed; the --- string's character ordinals are equal to the path's original bytes. If you --- need to display a 'FilePath' to the user, use 'toLazyBytes' and an --- appropriate decoding function. -toString :: Rules -> FilePath -> String -toString r = BL8.unpack . toLazyBytes 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)) --- | Parse a lazy 'String' into a 'FilePath'. This is useful for --- interoperating with legacy libraries. No encoding is performed; --- characters are truncated to 8 bits. If you need to accept a 'FilePath' --- from the user, use 'fromLazyBytes' and an appropriate encoding function. -fromString :: Rules -> String -> FilePath -fromString r = fromBytes r . B8.pack +-- | 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 @@ -107,59 +90,71 @@ RootWindowsVolume c -> c : ":\\" RootWindowsCurrentVolume -> "\\" -byteComponents :: FilePath -> [B.ByteString] -byteComponents path = pathComponents path ++ [filenameBytes path] +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 +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 + ------------------------------------------------------------------------------- -- POSIX ------------------------------------------------------------------------------- +-- | Linux, BSD, OS X, and other UNIX or UNIX-like operating systems. posix :: Rules posix = Rules { rulesName = "POSIX" , toByteChunks = posixToByteChunks , fromBytes = posixFromBytes - , caseSensitive = True , valid = posixValid , splitSearchPath = posixSplitSearch - , normalise = posixNormalise } posixToByteChunks :: FilePath -> [B.ByteString] posixToByteChunks p = root : chunks where root = rootBytes $ pathRoot p - chunks = intersperse (B8.pack "/") $ byteComponents 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 cs name exts - split' = B.split 0x2F bytes + path = FilePath root directories basename exts - (root, pastRoot) = if B.null (head split') - then (Just RootPosix, tail split') - else (Nothing, split') + split = B.split 0x2F bytes - cs = if P.null pastRoot - then [] - else filter (not . B.null) $ if B.null (last pastRoot) - then pastRoot - else init pastRoot + (root, pastRoot) = if B.null (head split) + then (Just RootPosix, tail split) + else (Nothing, split) - filename = last split' - (name, exts) = if elem filename [B8.pack ".", B8.pack ".."] - then (Just filename, []) - else case B.split 0x2E (last split') of + (directories, filename) + | P.null pastRoot = ([], B.empty) + | otherwise = case last pastRoot of + fn | fn == B8.pack "." -> (goodDirs pastRoot, B.empty) + fn | fn == B8.pack ".." -> (goodDirs pastRoot, B.empty) + fn -> (goodDirs (init pastRoot), fn) + + goodDirs = filter (not . B.null) + + (basename, exts) = if B.null filename + then (Nothing, []) + else case B.split 0x2E filename of [] -> (Nothing, []) (name':exts') -> (Just name', exts') posixValid :: FilePath -> Bool -posixValid p = validRoot && validComponents where - validComponents = flip all (byteComponents p) +posixValid p = validRoot && validDirectories where + validDirectories = flip all (byteDirectories p) $ not . B.any (\b -> b == 0 || b == 0x2F) validRoot = case pathRoot p of Nothing -> True @@ -170,58 +165,55 @@ posixSplitSearch = map (posixFromBytes . normSearch) . B.split 0x3A where normSearch bytes = if B.null bytes then B8.pack "." else bytes -posixNormalise :: FilePath -> FilePath -posixNormalise p = p { pathComponents = components } where - components = filter (/= B8.pack ".") $ pathComponents p - ------------------------------------------------------------------------------- -- Windows ------------------------------------------------------------------------------- +-- | Windows and DOS windows :: Rules windows = Rules { rulesName = "Windows" , toByteChunks = winToByteChunks , fromBytes = winFromBytes - , caseSensitive = False , valid = winValid , splitSearchPath = map winFromBytes . filter (not . B.null) . B.split 0x3B - , normalise = winNormalise } winToByteChunks :: FilePath -> [B.ByteString] winToByteChunks p = root : chunks where root = rootBytes $ pathRoot p - chunks = intersperse (B8.pack "\\") $ byteComponents p + chunks = intersperse (B8.pack "\\") $ byteDirectories p winFromBytes :: B.ByteString -> FilePath winFromBytes bytes = if B.null bytes then empty else path where - path = FilePath root cs name exts - split' = B.splitWith isSep bytes - isSep b = b == 0x2F || b == 0x5C + path = FilePath root directories basename exts + split = B.splitWith (\b -> b == 0x2F || b == 0x5C) bytes + (root, pastRoot) = let - head' = head split' - tail' = tail split' + head' = head split + tail' = tail split in if B.null head' then (Just RootWindowsCurrentVolume, tail') else if B.elem 0x3A head' then (Just (parseDrive head'), tail') - else (Nothing, split') + else (Nothing, split) parseDrive bytes' = RootWindowsVolume c where - c = chr . fromIntegral . B.head $ bytes' + c = (toUpper . chr . fromIntegral . B.head) bytes' - cs = if P.null pastRoot - then [] - else filter (not . B.null) $ if B.null (last pastRoot) - then pastRoot - else init pastRoot + (directories, filename) + | P.null pastRoot = ([], B.empty) + | otherwise = case last pastRoot of + fn | fn == B8.pack "." -> (goodDirs pastRoot, B.empty) + fn | fn == B8.pack ".." -> (goodDirs pastRoot, B.empty) + fn -> (goodDirs (init pastRoot), fn) - filename = last split' - (name, exts) = if elem filename [B8.pack ".", B8.pack ".."] - then (Just filename, []) - else case B.split 0x2E (last split') of + goodDirs = filter (not . B.null) + + (basename, exts) = if B.null filename + then (Nothing, []) + else case B.split 0x2E filename of [] -> (Nothing, []) (name':exts') -> (Just name', exts') @@ -242,19 +234,8 @@ _ -> False noExt = p { pathExtensions = [] } - noReserved = flip all (byteComponents noExt) + noReserved = flip all (byteDirectories noExt) $ \c -> notElem (upperBytes c) reservedNames - validCharacters = flip all (byteComponents p) + validCharacters = flip all (byteDirectories p) $ not . B.any (`elem` reservedChars) - -winNormalise :: FilePath -> FilePath -winNormalise p = p' where - p' = p - { pathComponents = components - , pathRoot = root - } - components = filter (/= B8.pack ".") $ pathComponents p - root = case pathRoot p of - Just (RootWindowsVolume c) -> Just (RootWindowsVolume (toUpper c)) - r -> r 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.1.1 +version: 0.2 synopsis: High-level, byte-based file and directory path manipulations license: MIT license-file: license.txt @@ -10,20 +10,21 @@ cabal-version: >=1.6 category: System stability: experimental -homepage: http://ianen.org/haskell/system-filepath/ +homepage: http://john-millikin.com/software/system-filepath/ bug-reports: mailto:jmillikin@gmail.com tested-with: GHC==6.12.1 source-repository head - type: darcs - location: http://ianen.org/haskell/system-filepath/ + type: bzr + location: http://john-millikin.com/software/system-filepath/ library - ghc-options: -Wall -fno-warn-unused-do-bind -fno-warn-orphans + ghc-options: -Wall -O2 build-depends: - base >=3 && < 5 + base >= 3 && < 5 , bytestring >= 0.9 && < 0.10 + , text >= 0.3 && < 0.12 exposed-modules: System.FilePath