diff --git a/Filesystem/Path.hs b/Filesystem/Path.hs new file mode 100644 --- /dev/null +++ b/Filesystem/Path.hs @@ -0,0 +1,277 @@ +-- | +-- 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 diff --git a/Filesystem/Path/CurrentOS.hs b/Filesystem/Path/CurrentOS.hs new file mode 100644 --- /dev/null +++ b/Filesystem/Path/CurrentOS.hs @@ -0,0 +1,134 @@ +{-# 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 diff --git a/Filesystem/Path/Internal.hs b/Filesystem/Path/Internal.hs new file mode 100644 --- /dev/null +++ b/Filesystem/Path/Internal.hs @@ -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)) diff --git a/Filesystem/Path/Rules.hs b/Filesystem/Path/Rules.hs new file mode 100644 --- /dev/null +++ b/Filesystem/Path/Rules.hs @@ -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 (== ';') diff --git a/System/FilePath.hs b/System/FilePath.hs --- a/System/FilePath.hs +++ b/System/FilePath.hs @@ -1,277 +1,15 @@ -- | -- Module: System.FilePath --- Copyright: 2010 John Millikin +-- Copyright: 2011 John Millikin -- License: MIT -- -- 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. +-- Deprecated alias for "Filesystem.Path" -- module System.FilePath - ( 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 + ( module Filesystem.Path ) 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 System.FilePath.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 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 +import Filesystem.Path diff --git a/System/FilePath/CurrentOS.hs b/System/FilePath/CurrentOS.hs --- a/System/FilePath/CurrentOS.hs +++ b/System/FilePath/CurrentOS.hs @@ -1,104 +1,15 @@ -{-# LANGUAGE CPP #-} - -- | -- Module: System.FilePath.CurrentOS --- Copyright: 2010 John Millikin +-- Copyright: 2011 John Millikin -- License: MIT -- -- Maintainer: jmillikin@gmail.com -- Portability: portable -- --- 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'. +-- Deprecated alias for "Filesystem.Path.CurrentOS" -- module System.FilePath.CurrentOS - ( module System.FilePath - , currentOS - - -- * Type conversions - , toText - , fromText - , encode - , decode - - -- * Rule‐specific path properties - , valid - , splitSearchPath + ( module Filesystem.Path.CurrentOS ) where -import qualified Data.ByteString as B -import qualified Data.String as S -import qualified Data.Text as T - -import System.FilePath -import qualified System.FilePath as F -import qualified System.FilePath.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 '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 - --- | 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 - --- | 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 - -encode :: F.FilePath -> PLATFORM_PATH_FORMAT -encode = R.encode currentOS - -decode :: PLATFORM_PATH_FORMAT -> F.FilePath -decode = R.decode currentOS +import Filesystem.Path.CurrentOS diff --git a/System/FilePath/Internal.hs b/System/FilePath/Internal.hs deleted file mode 100644 --- a/System/FilePath/Internal.hs +++ /dev/null @@ -1,128 +0,0 @@ -{-# LANGUAGE DeriveDataTypeable #-} - --- | --- Module: System.FilePath.Internal --- Copyright: 2010 John Millikin --- License: MIT --- --- Maintainer: jmillikin@gmail.com --- Portability: portable --- -module System.FilePath.Internal where - -import Prelude hiding (FilePath) - -import Data.Data (Data) -import Data.List (intersperse) -import qualified Data.Text as T -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 :: FilePath -> Chunk -filenameChunk p = Chunk (T.concat texts) (and good) where - name = maybe (Chunk T.empty True) id (pathBasename p) - exts = case pathExtensions p of - [] -> [] - exts' -> intersperse dot ((Chunk T.empty True):exts') - chunks = name:exts - - texts = map chunkText chunks - good = map chunkGood chunks - -------------------------------------------------------------------------------- --- Rules -------------------------------------------------------------------------------- - -data Rules 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 'toBytes' and then decode - -- them manually. - -- - -- Since: 0.2 - , toText :: FilePath -> Either T.Text T.Text - - -- | Convert human‐readable text into a 'FilePath'. - -- - -- This function ignores the user’s locale, and assumes all - -- file paths are encoded in UTF8. If you need to create file paths - -- with an unusual or obscure encoding, encode them manually and then - -- use 'fromBytes'. - -- - -- Since: 0.2 - , fromText :: T.Text -> FilePath - - -- | Convert a 'FilePath' to the platform’s underlying format. - -- - -- Since: 0.3 - , encode :: FilePath -> platformFormat - - -- | Convert the platform’s underlying format to a 'FilePath'. - -- - -- Since: 0.3 - , decode :: platformFormat -> FilePath - } - -instance Show (Rules a) where - showsPrec d r = showParen (d > 10) - (showString "Rules " . shows (rulesName r)) diff --git a/System/FilePath/Rules.hs b/System/FilePath/Rules.hs --- a/System/FilePath/Rules.hs +++ b/System/FilePath/Rules.hs @@ -1,225 +1,15 @@ -- | -- Module: System.FilePath.Rules --- Copyright: 2010 John Millikin +-- Copyright: 2011 John Millikin -- License: MIT -- -- Maintainer: jmillikin@gmail.com -- Portability: portable -- +-- Deprecated alias for "Filesystem.Path.Rules" +-- module System.FilePath.Rules - ( Rules - , posix - , windows - - -- * Type conversions - , toText - , fromText - , encode - , decode - - -- * Rule‐specific path properties - , valid - , splitSearchPath + ( module Filesystem.Path.Rules ) 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.Unsafe (unsafePerformIO) - -import System.FilePath hiding (root, filename, basename) -import System.FilePath.Internal - -------------------------------------------------------------------------------- --- Generic -------------------------------------------------------------------------------- - -rootText :: Maybe Root -> T.Text -rootText r = T.pack $ flip (maybe "") r $ \r' -> case r' of - RootPosix -> "/" - RootWindowsVolume c -> c : ":\\" - RootWindowsCurrentVolume -> "\\" - -directoryChunks :: FilePath -> [Chunk] -directoryChunks path = pathDirectories path ++ [filenameChunk 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 - } - -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 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 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 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 - } - -winToText :: FilePath -> T.Text -winToText p = T.concat (root : chunks) where - root = rootText (pathRoot p) - chunks = intersperse (T.pack "\\") (map chunkText (directoryChunks 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 noExt) - $ \fn -> notElem (T.toUpper (chunkText fn)) reservedNames - - validCharacters = flip all (directoryChunks p) - $ not . T.any (`elem` reservedChars) . chunkText - -winSplit :: T.Text -> [FilePath] -winSplit = map winFromText . filter (not . T.null) . T.split (== ';') +import Filesystem.Path.Rules 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.3 +version: 0.3.1 synopsis: High-level, byte-based file and directory path manipulations license: MIT license-file: license.txt @@ -7,16 +7,16 @@ maintainer: jmillikin@gmail.com copyright: Copyright (c) John Millikin 2010 build-type: Simple -cabal-version: >=1.6 +cabal-version: >= 1.6 category: System stability: experimental -homepage: http://john-millikin.com/software/system-filepath/ +homepage: https://john-millikin.com/software/system-filepath/ bug-reports: mailto:jmillikin@gmail.com -tested-with: GHC==6.12.1 +tested-with: GHC == 6.12.1 source-repository head type: bzr - location: http://john-millikin.com/software/system-filepath/ + location: https://john-millikin.com/software/system-filepath/ library ghc-options: -Wall -O2 @@ -30,9 +30,12 @@ cpp-options: -DCABAL_OS_WINDOWS exposed-modules: + Filesystem.Path + Filesystem.Path.CurrentOS + Filesystem.Path.Rules System.FilePath System.FilePath.CurrentOS System.FilePath.Rules other-modules: - System.FilePath.Internal + Filesystem.Path.Internal