system-filepath 0.4 → 0.4.1
raw patch · 9 files changed
+878/−803 lines, 9 files
Files
- Filesystem/Path.hs +0/−277
- Filesystem/Path/CurrentOS.hs +0/−134
- Filesystem/Path/Internal.hs +0/−156
- Filesystem/Path/Rules.hs +0/−232
- src/Filesystem/Path.hs +344/−0
- src/Filesystem/Path/CurrentOS.hs +137/−0
- src/Filesystem/Path/Internal.hs +156/−0
- src/Filesystem/Path/Rules.hs +232/−0
- system-filepath.cabal +9/−4
− Filesystem/Path.hs
@@ -1,277 +0,0 @@--- |--- Module: Filesystem.Path--- Copyright: 2010 John Millikin--- License: MIT------ Maintainer: jmillikin@gmail.com--- Portability: portable------ High‐level, byte‐based file and directory path--- manipulations. You probably want to import "Filesystem.Path.CurrentOS"--- instead, since it handles detecting which rules to use in the current--- compilation.----module Filesystem.Path- ( FilePath- , empty- - -- * Basic properties- , null- , root- , directory- , parent- , filename- , basename- , absolute- , relative- - -- * Basic operations- , append- , (</>)- , concat- , commonPrefix- , collapse- - -- * Extensions- , extension- , extensions- , hasExtension- - , addExtension- , (<.>)- , dropExtension- , replaceExtension- - , addExtensions- , dropExtensions- , replaceExtensions- - , splitExtension- , splitExtensions- ) where--import Prelude hiding (FilePath, concat, null)--import Data.List (foldl')-import Data.Maybe (isNothing)-import qualified Data.Monoid as M-import qualified Data.Text as T--import Filesystem.Path.Internal--instance M.Monoid FilePath where- mempty = empty- mappend = append- mconcat = concat------------------------------------------------------------------------------------ Basic properties------------------------------------------------------------------------------------ | @null p = (p == 'empty')@-null :: FilePath -> Bool-null = (== empty)---- | 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--- directory, it is returned unchanged.-directory :: FilePath -> FilePath-directory p = empty- { pathRoot = pathRoot p- , pathDirectories = let- 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.-parent :: FilePath -> FilePath-parent p = empty- { pathRoot = pathRoot p- , pathDirectories = let- 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) = [dot]- | otherwise = []- in dot' ++ directories- }---- | 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 a 'FilePath'’s basename component.------ @--- basename \"foo/bar.txt\" == \"bar\"--- @-basename :: FilePath -> FilePath-basename p = empty- { pathBasename = pathBasename p- }---- | Test whether a path is absolute.-absolute :: FilePath -> Bool-absolute p = case pathRoot p of- Just RootPosix -> True- Just (RootWindowsVolume _) -> True- _ -> False---- | Test whether a path is relative.-relative :: FilePath -> Bool-relative p = case pathRoot p of- Just _ -> False- _ -> True------------------------------------------------------------------------------------ Basic operations------------------------------------------------------------------------------------ | Appends two 'FilePath's. If the second path is absolute, it is returned--- unchanged.-append :: FilePath -> FilePath -> FilePath-append x y = if absolute y then y else xy where- xy = y- { pathRoot = pathRoot x- , pathDirectories = directories- }- directories = xDirectories ++ pathDirectories y- xDirectories = (pathDirectories x ++) $ if null (filename x)- then []- else [filenameChunk True x]---- | An alias for 'append'.-(</>) :: FilePath -> FilePath -> FilePath-(</>) = append---- | A fold over 'append'.-concat :: [FilePath] -> FilePath-concat [] = empty-concat ps = foldr1 append ps---- | 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 = 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 }- - commonDirectories x y = common (pathDirectories x) (pathDirectories y)- commonExtensions x y = common (pathExtensions x) (pathExtensions y)- - common [] _ = []- common _ [] = []- common (x:xs) (y:ys) = if x == y- 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)- - 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--- extensions.-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 -> [T.Text]-extensions = map chunkText . pathExtensions---- | Get whether a 'FilePath'’s last extension is the predicate.-hasExtension :: FilePath -> T.Text -> Bool-hasExtension p e = extension p == Just e---- | Append an extension to the end of a 'FilePath'.-addExtension :: FilePath -> T.Text -> FilePath-addExtension p ext = addExtensions p [ext]---- | Append many extensions to the end of a 'FilePath'.-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 -> T.Text -> FilePath-(<.>) = addExtension---- | Remove a 'FilePath'’s last extension.-dropExtension :: FilePath -> FilePath-dropExtension p = p { pathExtensions = safeInit (pathExtensions p) }---- | Remove all extensions from a 'FilePath'.-dropExtensions :: FilePath -> FilePath-dropExtensions p = p { pathExtensions = [] }---- | Replace a 'FilePath'’s last extension.-replaceExtension :: FilePath -> T.Text -> FilePath-replaceExtension = addExtension . dropExtension---- | Remove all extensions from a 'FilePath', and replace them with a new--- list.-replaceExtensions :: FilePath -> [T.Text] -> FilePath-replaceExtensions = addExtensions . dropExtensions---- | @splitExtension p = ('dropExtension' p, 'extension' p)@-splitExtension :: FilePath -> (FilePath, Maybe T.Text)-splitExtension p = (dropExtension p, extension p)---- | @splitExtensions p = ('dropExtensions' p, 'extensions' p)@-splitExtensions :: FilePath -> (FilePath, [T.Text])-splitExtensions p = (dropExtensions p, extensions p)------------------------------------------------------------------------------------ Utils----------------------------------------------------------------------------------safeInit :: [a] -> [a]-safeInit xs = case xs of- [] -> []- _ -> init xs--safeHead :: [a] -> Maybe a-safeHead [] = Nothing-safeHead (x:_) = Just x
− Filesystem/Path/CurrentOS.hs
@@ -1,134 +0,0 @@-{-# LANGUAGE CPP #-}---- |--- Module: Filesystem.Path.CurrentOS--- Copyright: 2010 John Millikin--- License: MIT------ Maintainer: jmillikin@gmail.com--- Portability: portable------ Re‐exports contents of "Filesystem.Path.Rules", defaulting to the--- current OS’s rules when needed.------ Also enables 'Show' and 'S.IsString' instances for 'F.FilePath'.----module Filesystem.Path.CurrentOS- ( module Filesystem.Path- , currentOS- - -- * Type conversions- , toText- , fromText- , encode- , decode- , encodeString- , decodeString- - -- * Rule‐specific path properties- , valid- , splitSearchPath- ) where--import qualified Data.ByteString as B-import qualified Data.String as S-import qualified Data.Text as T--import Filesystem.Path-import qualified Filesystem.Path as F-import qualified Filesystem.Path.Rules as R--#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-#endif--instance S.IsString F.FilePath where- fromString = R.fromText currentOS . T.pack--instance Show F.FilePath where- 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 'F.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 'encode' and then decode them manually.------ Since: 0.2-toText :: F.FilePath -> Either T.Text T.Text-toText = R.toText 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 'decode'.------ Since: 0.2-fromText :: T.Text -> F.FilePath-fromText = R.fromText currentOS---- | 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 :: PLATFORM_PATH_FORMAT -> [F.FilePath]-splitSearchPath = R.splitSearchPath currentOS---- | Convert a 'F.FilePath' to a platform‐specific format, suitable--- for use with external OS functions.------ Since: 0.3-encode :: F.FilePath -> PLATFORM_PATH_FORMAT-encode = R.encode currentOS---- | Convert a 'F.FilePath' from a platform‐specific format, suitable--- for use with external OS functions.------ Since: 0.3-decode :: PLATFORM_PATH_FORMAT -> F.FilePath-decode = R.decode currentOS---- | Attempt to convert a 'F.FilePath' to a string suitable for use with--- functions in @System.IO@. The contents of this string are--- platform‐dependent, and are not guaranteed to be--- human‐readable. For converting 'F.FilePath's to a--- human‐readable format, use 'toText'.------ Since: 0.3.1-encodeString :: F.FilePath -> String-encodeString = R.encodeString currentOS---- | Attempt to parse a 'F.FilePath' from a string suitable for use with--- functions in @System.IO@. Do not use this function for parsing--- human‐readable paths, as the character set decoding is--- platform‐dependent. For converting human‐readable text to a--- 'F.FilePath', use 'fromText'.------ Since: 0.3.1-decodeString :: String -> F.FilePath-decodeString = R.decodeString currentOS
− Filesystem/Path/Internal.hs
@@ -1,156 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}---- |--- Module: Filesystem.Path.Internal--- Copyright: 2010 John Millikin--- License: MIT------ Maintainer: jmillikin@gmail.com--- Portability: portable----module Filesystem.Path.Internal where--import Prelude hiding (FilePath)--import qualified Data.ByteString.Char8 as B8-import Data.Data (Data)-import Data.List (intersperse)-import qualified Data.Text as T-import qualified Data.Text.Encoding as TE-import Data.Typeable (Typeable)------------------------------------------------------------------------------------ File Paths----------------------------------------------------------------------------------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- | RootWindowsCurrentVolume- deriving (Eq, Ord, Data, Typeable)--data FilePath = FilePath- { pathRoot :: Maybe Root- , pathDirectories :: [Directory]- , pathBasename :: Maybe Basename- , pathExtensions :: [Extension]- }- deriving (Eq, Ord, Data, Typeable)---- | A file path with no root, directory, or filename-empty :: FilePath-empty = FilePath Nothing [] Nothing []--dot :: Chunk-dot = Chunk (T.pack ".") True--dots :: Chunk-dots = Chunk (T.pack "..") True--filenameChunk :: Bool -> FilePath -> Chunk-filenameChunk strict p = Chunk (T.concat texts) allGood 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- allGood = and (map chunkGood chunks)- - chunkText' c = if chunkGood c- then if allGood || not strict- then chunkText c- else T.pack (B8.unpack (TE.encodeUtf8 (chunkText c)))- else chunkText c------------------------------------------------------------------------------------ Rules----------------------------------------------------------------------------------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'.- , valid :: FilePath -> Bool- - -- | Split a search path, such as @$PATH@ or @$PYTHONPATH@, into- -- a list of 'FilePath's.- , 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 'encode' 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 'decode'.- --- -- Since: 0.2- , fromText :: T.Text -> FilePath- - -- | Convert a 'FilePath' to a platform‐specific format,- -- suitable for use with external OS functions.- --- -- Since: 0.3- , encode :: FilePath -> platformFormat- - -- | Convert a 'FilePath' from a platform‐specific format,- -- suitable for use with external OS functions.- --- -- Since: 0.3- , decode :: platformFormat -> FilePath- - -- | Attempt to convert a 'FilePath' to a string suitable for use with- -- functions in @System.IO@. The contents of this string are- -- platform‐dependent, and are not guaranteed to be- -- human‐readable. For converting 'FilePath's to a- -- human‐readable format, use 'toText'.- --- -- Since: 0.3.1- , encodeString :: FilePath -> String- - -- | Attempt to parse a 'FilePath' from a string suitable for use- -- with functions in @System.IO@. Do not use this function for parsing- -- human‐readable paths, as the character set decoding is- -- platform‐dependent. For converting human‐readable- -- text to a 'FilePath', use 'fromText'.- --- -- Since: 0.3.1- , decodeString :: String -> FilePath- }--instance Show (Rules a) where- showsPrec d r = showParen (d > 10)- (showString "Rules " . shows (rulesName r))
− Filesystem/Path/Rules.hs
@@ -1,232 +0,0 @@--- |--- Module: Filesystem.Path.Rules--- Copyright: 2010 John Millikin--- License: MIT------ Maintainer: jmillikin@gmail.com--- Portability: portable----module Filesystem.Path.Rules- ( Rules- , posix- , windows- - -- * Type conversions- , toText- , fromText- , encode- , decode- , encodeString- , decodeString- - -- * Rule‐specific path properties- , valid- , splitSearchPath- ) where--import Prelude hiding (FilePath, null)-import qualified Prelude as P--import qualified Control.Exception as Exc-import qualified Data.ByteString as B-import qualified Data.ByteString.Char8 as B8-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 ()-import System.IO.Unsafe (unsafePerformIO)--import Filesystem.Path hiding (root, filename, basename)-import Filesystem.Path.Internal------------------------------------------------------------------------------------ Generic----------------------------------------------------------------------------------rootText :: Maybe Root -> T.Text-rootText r = T.pack $ flip (maybe "") r $ \r' -> case r' of- RootPosix -> "/"- RootWindowsVolume c -> c : ":\\"- RootWindowsCurrentVolume -> "\\"--directoryChunks :: Bool -> FilePath -> [Chunk]-directoryChunks strict path = pathDirectories path ++ [filenameChunk strict path]--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 B.ByteString-posix = Rules- { rulesName = T.pack "POSIX"- , valid = posixValid- , splitSearchPath = posixSplitSearch- , toText = posixToText- , fromText = posixFromText- , encode = posixToBytes- , decode = posixFromBytes- , encodeString = B8.unpack . posixToBytes- , decodeString = posixFromBytes . B8.pack- }--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 = rootText (pathRoot p)- chunks = intersperse (Chunk (T.pack "/") True) (directoryChunks False 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 = ([], Chunk T.empty True)- | otherwise = case last pastRoot of- 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 . T.null . chunkText)- - (basename, exts) = if T.null (chunkText filename)- then (Nothing, [])- else case T.split (== '.') (chunkText filename) of- [] -> (Nothing, [])- (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 True 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 = all validChunk (directoryChunks True p)- validChunk ch = not (T.any (\c -> c == '\0' || c == '/') (chunkText ch))- validRoot = case pathRoot p of- Nothing -> True- Just RootPosix -> True- _ -> False--posixSplitSearch :: B.ByteString -> [FilePath]-posixSplitSearch = map (posixFromBytes . normSearch) . B.split 0x3A where- normSearch bytes = if B.null bytes then B8.pack "." else bytes------------------------------------------------------------------------------------ Windows------------------------------------------------------------------------------------ | Windows and DOS-windows :: Rules T.Text-windows = Rules- { rulesName = T.pack "Windows"- , valid = winValid- , splitSearchPath = winSplit- , toText = Right . winToText- , fromText = winFromText- , encode = winToText- , decode = winFromText- , encodeString = T.unpack . winToText- , decodeString = winFromText . T.pack- }--winToText :: FilePath -> T.Text-winToText p = T.concat (root : chunks) where- root = rootText (pathRoot p)- chunks = intersperse (T.pack "\\") (map chunkText (directoryChunks False p))--winFromText :: T.Text -> FilePath-winFromText text = if T.null text then empty else path where- path = FilePath root directories basename exts- - split = T.split (\c -> c == '/' || c == '\\') text- - (root, pastRoot) = let- head' = head split- tail' = tail split- in if T.null head'- then (Just RootWindowsCurrentVolume, tail')- else if T.any (== ':') head'- then (Just (parseDrive head'), tail')- else (Nothing, split)- - parseDrive = RootWindowsVolume . toUpper . T.head- - (directories, filename)- | P.null pastRoot = ([], T.empty)- | otherwise = case last pastRoot of- fn | fn == chunkText dot -> (goodDirs pastRoot, T.empty)- fn | fn == chunkText dots -> (goodDirs pastRoot, T.empty)- fn -> (goodDirs (init pastRoot), fn)- - goodDirs = map (\t -> Chunk t True) . filter (not . T.null)- - (basename, exts) = if T.null filename- then (Nothing, [])- else case T.split (== '.') filename of- [] -> (Nothing, [])- (name':exts') -> (Just (Chunk name' True), map (\e -> Chunk e True) exts')--winValid :: FilePath -> Bool-winValid p = validRoot && noReserved && validCharacters where- 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"- , "LPT7", "LPT8", "LPT9", "NUL", "PRN"- ]- - validRoot = case pathRoot p of- Nothing -> True- Just RootWindowsCurrentVolume -> True- Just (RootWindowsVolume v) -> elem v ['A'..'Z']- _ -> False- - noExt = p { pathExtensions = [] }- noReserved = flip all (directoryChunks False noExt)- $ \fn -> notElem (T.toUpper (chunkText fn)) reservedNames- - validCharacters = flip all (directoryChunks False p)- $ not . T.any (`elem` reservedChars) . chunkText--winSplit :: T.Text -> [FilePath]-winSplit = map winFromText . filter (not . T.null) . T.split (== ';')
+ src/Filesystem/Path.hs view
@@ -0,0 +1,344 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}++-- |+-- Module: Filesystem.Path+-- Copyright: 2010 John Millikin+-- License: MIT+--+-- Maintainer: jmillikin@gmail.com+-- Portability: portable+--+-- High‐level, byte‐based file and directory path+-- manipulations. You probably want to import "Filesystem.Path.CurrentOS"+-- instead, since it handles detecting which rules to use in the current+-- compilation.+--+module Filesystem.Path+ ( FilePath+ , empty+ + -- * Basic properties+ , null+ , root+ , directory+ , parent+ , filename+ , dirname+ , basename+ , absolute+ , relative+ + -- * Basic operations+ , append+ , (</>)+ , concat+ , commonPrefix+ , stripPrefix+ , collapse+ + -- * Extensions+ , extension+ , extensions+ , hasExtension+ + , addExtension+ , (<.>)+ , dropExtension+ , replaceExtension+ + , addExtensions+ , dropExtensions+ , replaceExtensions+ + , splitExtension+ , splitExtensions+ ) where++import Prelude hiding (FilePath, concat, null)++import Data.List (foldl')+import Data.Maybe (isNothing)+import qualified Data.Monoid as M+import qualified Data.Text as T++import Filesystem.Path.Internal++instance M.Monoid FilePath where+ mempty = empty+ mappend = append+ mconcat = concat++-------------------------------------------------------------------------------+-- Basic properties+-------------------------------------------------------------------------------++-- | @null p = (p == 'empty')@+null :: FilePath -> Bool+null = (== empty)++-- | 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+-- directory, it is returned unchanged.+directory :: FilePath -> FilePath+directory p = empty+ { pathRoot = pathRoot p+ , pathDirectories = let+ 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.+parent :: FilePath -> FilePath+parent p = empty+ { pathRoot = pathRoot p+ , pathDirectories = let+ 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) = [dot]+ | otherwise = []+ in dot' ++ directories+ }++-- | 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 a 'FilePath'’s directory name. This is only the+-- /file name/ of the directory, not its full path.+--+-- @+-- dirname \"foo/bar/baz.txt\" == \"bar\"+-- dirname \"/\" == \"\"+-- @+--+-- Since: 0.4.1+dirname :: FilePath -> FilePath+dirname p = case reverse (pathDirectories p) of+ [] -> FilePath Nothing [] Nothing []+ (d:_) -> let+ d':exts = T.split (== '.') (chunkText d)+ chunk txt = d { chunkText = txt }+ in FilePath Nothing [] (Just (chunk d')) (map chunk exts)+++-- | Retrieve a 'FilePath'’s basename component.+--+-- @+-- basename \"foo/bar.txt\" == \"bar\"+-- @+basename :: FilePath -> FilePath+basename p = empty+ { pathBasename = pathBasename p+ }++-- | Test whether a path is absolute.+absolute :: FilePath -> Bool+absolute p = case pathRoot p of+ Just RootPosix -> True+ Just (RootWindowsVolume _) -> True+ _ -> False++-- | Test whether a path is relative.+relative :: FilePath -> Bool+relative p = case pathRoot p of+ Just _ -> False+ _ -> True++-------------------------------------------------------------------------------+-- Basic operations+-------------------------------------------------------------------------------++-- | Appends two 'FilePath's. If the second path is absolute, it is returned+-- unchanged.+append :: FilePath -> FilePath -> FilePath+append x y = cased where+ cased = case pathRoot y of+ Just RootPosix -> y+ Just (RootWindowsVolume _) -> y+ Just RootWindowsCurrentVolume -> case pathRoot x of+ Just (RootWindowsVolume _) -> y { pathRoot = pathRoot x }+ _ -> y+ Nothing -> xy+ xy = y+ { pathRoot = pathRoot x+ , pathDirectories = directories+ }+ directories = xDirectories ++ pathDirectories y+ xDirectories = (pathDirectories x ++) $ if null (filename x)+ then []+ else [filenameChunk True x]++-- | An alias for 'append'.+(</>) :: FilePath -> FilePath -> FilePath+(</>) = append++-- | A fold over 'append'.+concat :: [FilePath] -> FilePath+concat [] = empty+concat ps = foldr1 append ps++-- | 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 = 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 }+ + commonDirectories x y = common (pathDirectories x) (pathDirectories y)+ commonExtensions x y = common (pathExtensions x) (pathExtensions y)+ + common [] _ = []+ common _ [] = []+ common (x:xs) (y:ys) = if x == y+ then x : common xs ys+ else []++-- Remove a prefix from a path.+--+-- @+-- stripPrefix "/foo/" "/foo/bar/baz.txt" == Just "bar/baz.txt"+-- stripPrefix "/foo/" "/bar/baz.txt" == Nothing+-- @+--+-- Since: 0.4.1+stripPrefix :: FilePath -> FilePath -> Maybe FilePath+stripPrefix x y = if pathRoot x /= pathRoot y+ then case pathRoot x of+ Nothing -> Just y+ Just _ -> Nothing+ else do+ dirs <- strip (pathDirectories x) (pathDirectories y)+ case dirs of+ [] -> case (pathBasename x, pathBasename y) of+ (Nothing, Nothing) -> do+ exts <- strip (pathExtensions x) (pathExtensions y)+ return (y { pathRoot = Nothing, pathDirectories = dirs, pathExtensions = exts })+ (Nothing, Just _) -> case pathExtensions x of+ [] -> Just (y { pathRoot = Nothing, pathDirectories = dirs })+ _ -> Nothing+ (Just x_b, Just y_b) | x_b == y_b -> do+ exts <- strip (pathExtensions x) (pathExtensions y)+ return (empty { pathExtensions = exts })+ _ -> Nothing+ _ -> case (pathBasename x, pathExtensions x) of+ (Nothing, []) -> Just (y { pathRoot = Nothing, pathDirectories = dirs })+ _ -> Nothing++strip :: Eq a => [a] -> [a] -> Maybe [a]+strip [] ys = Just ys+strip _ [] = Nothing+strip (x:xs) (y:ys) = if x == y+ then strip xs ys+ else Nothing++-- | 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)+ + 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+-- extensions.+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 -> [T.Text]+extensions = map chunkText . pathExtensions++-- | Get whether a 'FilePath'’s last extension is the predicate.+hasExtension :: FilePath -> T.Text -> Bool+hasExtension p e = extension p == Just e++-- | Append an extension to the end of a 'FilePath'.+addExtension :: FilePath -> T.Text -> FilePath+addExtension p ext = addExtensions p [ext]++-- | Append many extensions to the end of a 'FilePath'.+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 -> T.Text -> FilePath+(<.>) = addExtension++-- | Remove a 'FilePath'’s last extension.+dropExtension :: FilePath -> FilePath+dropExtension p = p { pathExtensions = safeInit (pathExtensions p) }++-- | Remove all extensions from a 'FilePath'.+dropExtensions :: FilePath -> FilePath+dropExtensions p = p { pathExtensions = [] }++-- | Replace a 'FilePath'’s last extension.+replaceExtension :: FilePath -> T.Text -> FilePath+replaceExtension = addExtension . dropExtension++-- | Remove all extensions from a 'FilePath', and replace them with a new+-- list.+replaceExtensions :: FilePath -> [T.Text] -> FilePath+replaceExtensions = addExtensions . dropExtensions++-- | @splitExtension p = ('dropExtension' p, 'extension' p)@+splitExtension :: FilePath -> (FilePath, Maybe T.Text)+splitExtension p = (dropExtension p, extension p)++-- | @splitExtensions p = ('dropExtensions' p, 'extensions' p)@+splitExtensions :: FilePath -> (FilePath, [T.Text])+splitExtensions p = (dropExtensions p, extensions p)++-------------------------------------------------------------------------------+-- Utils+-------------------------------------------------------------------------------++safeInit :: [a] -> [a]+safeInit xs = case xs of+ [] -> []+ _ -> init xs++safeHead :: [a] -> Maybe a+safeHead [] = Nothing+safeHead (x:_) = Just x
+ src/Filesystem/Path/CurrentOS.hs view
@@ -0,0 +1,137 @@+{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++-- |+-- Module: Filesystem.Path.CurrentOS+-- Copyright: 2010 John Millikin+-- License: MIT+--+-- Maintainer: jmillikin@gmail.com+-- Portability: portable+--+-- Re‐exports contents of "Filesystem.Path.Rules", defaulting to the+-- current OS’s rules when needed.+--+-- Also enables 'Show' and 'S.IsString' instances for 'F.FilePath'.+--+module Filesystem.Path.CurrentOS+ ( module Filesystem.Path+ , currentOS+ + -- * Type conversions+ , toText+ , fromText+ , encode+ , decode+ , encodeString+ , decodeString+ + -- * Rule‐specific path properties+ , valid+ , splitSearchPath+ ) where++import Prelude hiding (FilePath)++import qualified Data.ByteString as B+import qualified Data.String as S+import qualified Data.Text as T++import Filesystem.Path+import qualified Filesystem.Path as F+import qualified Filesystem.Path.Rules as R++#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+#endif++instance S.IsString F.FilePath where+ fromString = R.fromText currentOS . T.pack++instance Show F.FilePath where+ 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 'F.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 'encode' and then decode them manually.+--+-- Since: 0.2+toText :: F.FilePath -> Either T.Text T.Text+toText = R.toText 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 'decode'.+--+-- Since: 0.2+fromText :: T.Text -> F.FilePath+fromText = R.fromText currentOS++-- | 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 :: PLATFORM_PATH_FORMAT -> [F.FilePath]+splitSearchPath = R.splitSearchPath currentOS++-- | Convert a 'F.FilePath' to a platform‐specific format, suitable+-- for use with external OS functions.+--+-- Since: 0.3+encode :: F.FilePath -> PLATFORM_PATH_FORMAT+encode = R.encode currentOS++-- | Convert a 'F.FilePath' from a platform‐specific format, suitable+-- for use with external OS functions.+--+-- Since: 0.3+decode :: PLATFORM_PATH_FORMAT -> F.FilePath+decode = R.decode currentOS++-- | Attempt to convert a 'F.FilePath' to a string suitable for use with+-- functions in @System.IO@. The contents of this string are+-- platform‐dependent, and are not guaranteed to be+-- human‐readable. For converting 'F.FilePath's to a+-- human‐readable format, use 'toText'.+--+-- Since: 0.3.1+encodeString :: F.FilePath -> String+encodeString = R.encodeString currentOS++-- | Attempt to parse a 'F.FilePath' from a string suitable for use with+-- functions in @System.IO@. Do not use this function for parsing+-- human‐readable paths, as the character set decoding is+-- platform‐dependent. For converting human‐readable text to a+-- 'F.FilePath', use 'fromText'.+--+-- Since: 0.3.1+decodeString :: String -> F.FilePath+decodeString = R.decodeString currentOS
+ src/Filesystem/Path/Internal.hs view
@@ -0,0 +1,156 @@+{-# LANGUAGE DeriveDataTypeable #-}++-- |+-- Module: Filesystem.Path.Internal+-- Copyright: 2010 John Millikin+-- License: MIT+--+-- Maintainer: jmillikin@gmail.com+-- Portability: portable+--+module Filesystem.Path.Internal where++import Prelude hiding (FilePath)++import qualified Data.ByteString.Char8 as B8+import Data.Data (Data)+import Data.List (intersperse)+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import Data.Typeable (Typeable)++-------------------------------------------------------------------------------+-- File Paths+-------------------------------------------------------------------------------++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+ | RootWindowsCurrentVolume+ deriving (Eq, Ord, Data, Typeable)++data FilePath = FilePath+ { pathRoot :: Maybe Root+ , pathDirectories :: [Directory]+ , pathBasename :: Maybe Basename+ , pathExtensions :: [Extension]+ }+ deriving (Eq, Ord, Data, Typeable)++-- | A file path with no root, directory, or filename+empty :: FilePath+empty = FilePath Nothing [] Nothing []++dot :: Chunk+dot = Chunk (T.pack ".") True++dots :: Chunk+dots = Chunk (T.pack "..") True++filenameChunk :: Bool -> FilePath -> Chunk+filenameChunk strict p = Chunk (T.concat texts) allGood 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+ allGood = and (map chunkGood chunks)+ + chunkText' c = if chunkGood c+ then if allGood || not strict+ then chunkText c+ else T.pack (B8.unpack (TE.encodeUtf8 (chunkText c)))+ else chunkText c++-------------------------------------------------------------------------------+-- Rules+-------------------------------------------------------------------------------++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'.+ , valid :: FilePath -> Bool+ + -- | Split a search path, such as @$PATH@ or @$PYTHONPATH@, into+ -- a list of 'FilePath's.+ , 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 'encode' 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 'decode'.+ --+ -- Since: 0.2+ , fromText :: T.Text -> FilePath+ + -- | Convert a 'FilePath' to a platform‐specific format,+ -- suitable for use with external OS functions.+ --+ -- Since: 0.3+ , encode :: FilePath -> platformFormat+ + -- | Convert a 'FilePath' from a platform‐specific format,+ -- suitable for use with external OS functions.+ --+ -- Since: 0.3+ , decode :: platformFormat -> FilePath+ + -- | Attempt to convert a 'FilePath' to a string suitable for use with+ -- functions in @System.IO@. The contents of this string are+ -- platform‐dependent, and are not guaranteed to be+ -- human‐readable. For converting 'FilePath's to a+ -- human‐readable format, use 'toText'.+ --+ -- Since: 0.3.1+ , encodeString :: FilePath -> String+ + -- | Attempt to parse a 'FilePath' from a string suitable for use+ -- with functions in @System.IO@. Do not use this function for parsing+ -- human‐readable paths, as the character set decoding is+ -- platform‐dependent. For converting human‐readable+ -- text to a 'FilePath', use 'fromText'.+ --+ -- Since: 0.3.1+ , decodeString :: String -> FilePath+ }++instance Show (Rules a) where+ showsPrec d r = showParen (d > 10)+ (showString "Rules " . shows (rulesName r))
+ src/Filesystem/Path/Rules.hs view
@@ -0,0 +1,232 @@+-- |+-- Module: Filesystem.Path.Rules+-- Copyright: 2010 John Millikin+-- License: MIT+--+-- Maintainer: jmillikin@gmail.com+-- Portability: portable+--+module Filesystem.Path.Rules+ ( Rules+ , posix+ , windows+ + -- * Type conversions+ , toText+ , fromText+ , encode+ , decode+ , encodeString+ , decodeString+ + -- * Rule‐specific path properties+ , valid+ , splitSearchPath+ ) where++import Prelude hiding (FilePath, null)+import qualified Prelude as P++import qualified Control.Exception as Exc+import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as B8+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 ()+import System.IO.Unsafe (unsafePerformIO)++import Filesystem.Path hiding (root, filename, basename)+import Filesystem.Path.Internal++-------------------------------------------------------------------------------+-- Generic+-------------------------------------------------------------------------------++rootText :: Maybe Root -> T.Text+rootText r = T.pack $ flip (maybe "") r $ \r' -> case r' of+ RootPosix -> "/"+ RootWindowsVolume c -> c : ":\\"+ RootWindowsCurrentVolume -> "\\"++directoryChunks :: Bool -> FilePath -> [Chunk]+directoryChunks strict path = pathDirectories path ++ [filenameChunk strict path]++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 B.ByteString+posix = Rules+ { rulesName = T.pack "POSIX"+ , valid = posixValid+ , splitSearchPath = posixSplitSearch+ , toText = posixToText+ , fromText = posixFromText+ , encode = posixToBytes+ , decode = posixFromBytes+ , encodeString = B8.unpack . posixToBytes+ , decodeString = posixFromBytes . B8.pack+ }++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 = rootText (pathRoot p)+ chunks = intersperse (Chunk (T.pack "/") True) (directoryChunks False 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 = ([], Chunk T.empty True)+ | otherwise = case last pastRoot of+ 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 . T.null . chunkText)+ + (basename, exts) = if T.null (chunkText filename)+ then (Nothing, [])+ else case T.split (== '.') (chunkText filename) of+ [] -> (Nothing, [])+ (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 True 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 = all validChunk (directoryChunks True p)+ validChunk ch = not (T.any (\c -> c == '\0' || c == '/') (chunkText ch))+ validRoot = case pathRoot p of+ Nothing -> True+ Just RootPosix -> True+ _ -> False++posixSplitSearch :: B.ByteString -> [FilePath]+posixSplitSearch = map (posixFromBytes . normSearch) . B.split 0x3A where+ normSearch bytes = if B.null bytes then B8.pack "." else bytes++-------------------------------------------------------------------------------+-- Windows+-------------------------------------------------------------------------------++-- | Windows and DOS+windows :: Rules T.Text+windows = Rules+ { rulesName = T.pack "Windows"+ , valid = winValid+ , splitSearchPath = winSplit+ , toText = Right . winToText+ , fromText = winFromText+ , encode = winToText+ , decode = winFromText+ , encodeString = T.unpack . winToText+ , decodeString = winFromText . T.pack+ }++winToText :: FilePath -> T.Text+winToText p = T.concat (root : chunks) where+ root = rootText (pathRoot p)+ chunks = intersperse (T.pack "\\") (map chunkText (directoryChunks False p))++winFromText :: T.Text -> FilePath+winFromText text = if T.null text then empty else path where+ path = FilePath root directories basename exts+ + split = T.split (\c -> c == '/' || c == '\\') text+ + (root, pastRoot) = let+ head' = head split+ tail' = tail split+ in if T.null head'+ then (Just RootWindowsCurrentVolume, tail')+ else if T.any (== ':') head'+ then (Just (parseDrive head'), tail')+ else (Nothing, split)+ + parseDrive = RootWindowsVolume . toUpper . T.head+ + (directories, filename)+ | P.null pastRoot = ([], T.empty)+ | otherwise = case last pastRoot of+ fn | fn == chunkText dot -> (goodDirs pastRoot, T.empty)+ fn | fn == chunkText dots -> (goodDirs pastRoot, T.empty)+ fn -> (goodDirs (init pastRoot), fn)+ + goodDirs = map (\t -> Chunk t True) . filter (not . T.null)+ + (basename, exts) = if T.null filename+ then (Nothing, [])+ else case T.split (== '.') filename of+ [] -> (Nothing, [])+ (name':exts') -> (Just (Chunk name' True), map (\e -> Chunk e True) exts')++winValid :: FilePath -> Bool+winValid p = validRoot && noReserved && validCharacters where+ 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"+ , "LPT7", "LPT8", "LPT9", "NUL", "PRN"+ ]+ + validRoot = case pathRoot p of+ Nothing -> True+ Just RootWindowsCurrentVolume -> True+ Just (RootWindowsVolume v) -> elem v ['A'..'Z']+ _ -> False+ + noExt = p { pathExtensions = [] }+ noReserved = flip all (directoryChunks False noExt)+ $ \fn -> notElem (T.toUpper (chunkText fn)) reservedNames+ + validCharacters = flip all (directoryChunks False 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,25 +1,30 @@ name: system-filepath-version: 0.4+version: 0.4.1 synopsis: High-level, byte-based file and directory path manipulations license: MIT license-file: license.txt author: John Millikin <jmillikin@gmail.com>-maintainer: jmillikin@gmail.com-copyright: Copyright (c) John Millikin 2010+maintainer: John Millikin <jmillikin@gmail.com>+copyright: John Millikin 2010-2011 build-type: Simple cabal-version: >= 1.6 category: System stability: experimental homepage: https://john-millikin.com/software/hs-filepath/ bug-reports: mailto:jmillikin@gmail.com-tested-with: GHC == 6.12.1 source-repository head type: bzr location: https://john-millikin.com/software/hs-filepath/ +source-repository this+ type: bzr+ location: https://john-millikin.com/branches/hs-filepath/0.4/+ tag: system-filepath_0.4.1+ library ghc-options: -Wall -O2+ hs-source-dirs: src build-depends: base >= 3 && < 5