system-filepath 0.1.1 → 0.2
raw patch · 5 files changed
+253/−253 lines, 5 filesdep +text
Dependencies added: text
Files
- System/FilePath.hs +78/−55
- System/FilePath/CurrentOS.hs +52/−49
- System/FilePath/Internal.hs +14/−22
- System/FilePath/Rules.hs +102/−121
- system-filepath.cabal +7/−6
System/FilePath.hs view
@@ -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
System/FilePath/CurrentOS.hs view
@@ -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
System/FilePath/Internal.hs view
@@ -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
System/FilePath/Rules.hs view
@@ -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
system-filepath.cabal view
@@ -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