system-filepath 0.3.7 → 0.4
raw patch · 18 files changed
+806/−1780 lines, 18 filesdep −deepseqdep ~text
Dependencies removed: deepseq
Dependency ranges changed: text
Files
- Filesystem/Path.hs +277/−0
- Filesystem/Path/CurrentOS.hs +134/−0
- Filesystem/Path/Internal.hs +156/−0
- Filesystem/Path/Rules.hs +232/−0
- lib/Filesystem/Path.hs +0/−341
- lib/Filesystem/Path/CurrentOS.hs +0/−149
- lib/Filesystem/Path/Internal.hs +0/−219
- lib/Filesystem/Path/Rules.hs +0/−330
- lib/System/FilePath.hs +0/−15
- lib/System/FilePath/CurrentOS.hs +0/−15
- lib/System/FilePath/Rules.hs +0/−15
- scripts/common.bash +0/−23
- scripts/run-benchmarks +0/−21
- scripts/run-coverage +0/−21
- scripts/run-tests +0/−17
- system-filepath.cabal +7/−28
- tests/Tests.hs +0/−561
- tests/system-filepath-tests.cabal +0/−25
+ Filesystem/Path.hs view
@@ -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
+ Filesystem/Path/CurrentOS.hs view
@@ -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
+ 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))
+ 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 (== ';')
− lib/Filesystem/Path.hs
@@ -1,341 +0,0 @@-{-# 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.3.2-dirname :: FilePath -> FilePath-dirname p = case reverse (pathDirectories p) of- [] -> FilePath Nothing [] Nothing []- (d:_) -> case parseFilename d of- (base, exts) -> FilePath Nothing [] base 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 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.3.2-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 unescape' . 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 ++ map escape 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
− lib/Filesystem/Path/CurrentOS.hs
@@ -1,149 +0,0 @@-{-# 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) || defined(CABAL_OS_DARWIN)-#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-#elif defined(CABAL_OS_DARWIN)-#if __GLASGOW_HASKELL__ >= 702-currentOS = R.darwin_ghc702-#else-currentOS = R.darwin-#endif-#else-#if __GLASGOW_HASKELL__ >= 704-currentOS = R.posix_ghc704-#elif __GLASGOW_HASKELL__ >= 702-currentOS = R.posix_ghc702-#else-currentOS = R.posix-#endif-#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
− lib/Filesystem/Path/Internal.hs
@@ -1,219 +0,0 @@-{-# LANGUAGE CPP #-}-{-# 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 Control.DeepSeq (NFData, rnf)-import qualified Control.Exception as Exc-import qualified Data.ByteString as B-import qualified Data.ByteString.Char8 as B8-import Data.Char (chr, ord)-import Data.Data (Data)-import Data.List (intersperse)-import Data.Ord (comparing)-import qualified Data.Text as T-import qualified Data.Text.Encoding as TE-import Data.Text.Encoding.Error (UnicodeException)-import Data.Typeable (Typeable)-import System.IO.Unsafe (unsafePerformIO)------------------------------------------------------------------------------------ File Paths----------------------------------------------------------------------------------type Chunk = String-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 (Data, Typeable)--instance Eq FilePath where- x == y = compare x y == EQ--instance Ord FilePath where- compare = comparing (\p ->- (pathRoot p- , fmap unescape' (pathDirectories p)- , fmap unescape' (pathBasename p)- , fmap unescape' (pathExtensions p)- ))--instance NFData Root where- rnf (RootWindowsVolume c) = rnf c- rnf _ = ()--instance NFData FilePath where- rnf p = rnf (pathRoot p) `seq` rnf (pathDirectories p) `seq` rnf (pathBasename p) `seq` rnf (pathExtensions p)---- | A file path with no root, directory, or filename-empty :: FilePath-empty = FilePath Nothing [] Nothing []--dot :: Chunk-dot = "."--dots :: Chunk-dots = ".."--filenameChunk :: FilePath -> Chunk-filenameChunk p = concat (name:exts) where- name = maybe "" id (pathBasename p)- exts = case pathExtensions p of- [] -> []- exts' -> intersperse dot ("":exts')------------------------------------------------------------------------------------ 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))--escape :: T.Text -> Chunk-escape t = T.unpack t--unescape :: Chunk -> (T.Text, Bool)-unescape cs = if any (\c -> ord c >= 0xDC80 && ord c <= 0xDCFF) cs- then (T.pack (map (\c -> if ord c >= 0xDC80 && ord c <= 0xDCFF- then chr (ord c - 0xDC00)- else c) cs), False)- else (T.pack cs, True)--unescape' :: Chunk -> T.Text-unescape' = fst . unescape--unescapeBytes' :: Chunk -> B.ByteString-unescapeBytes' cs = if any (\c -> ord c >= 0xDC80 && ord c <= 0xDCFF) cs- then B8.concat (map (\c -> if ord c >= 0xDC80 && ord c <= 0xDCFF- then B8.singleton (chr (ord c - 0xDC00))- else TE.encodeUtf8 (T.singleton c)) cs)- else TE.encodeUtf8 (T.pack cs)--splitBy :: (a -> Bool) -> [a] -> [[a]]-splitBy p = loop where- loop xs = let- (chunk, rest) = break p xs- cont = chunk : loop (tail rest)- in if null rest then [chunk] else cont--textSplitBy :: (Char -> Bool) -> T.Text -> [T.Text]-#if MIN_VERSION_text(0,11,0)-textSplitBy = T.split-#else-textSplitBy = T.splitBy-#endif--parseFilename :: Chunk -> (Maybe Basename, [Extension])-parseFilename filename = parsed where- parsed = if null filename- then (Nothing, [])- else case splitBy (== '.') filename of- [] -> (Nothing, [])- (name':exts') -> (Just name', exts')--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
− lib/Filesystem/Path/Rules.hs
@@ -1,330 +0,0 @@--- |--- Module: Filesystem.Path.Rules--- Copyright: 2010 John Millikin--- License: MIT------ Maintainer: jmillikin@gmail.com--- Portability: portable----module Filesystem.Path.Rules- ( Rules- , posix- , posix_ghc702- , posix_ghc704- , windows- , darwin- , darwin_ghc702- - -- * 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 Data.ByteString as B-import qualified Data.ByteString.Char8 as B8-import Data.Char (toUpper, chr, ord)-import Data.List (intersperse, intercalate)-import qualified Data.Text as T-import qualified Data.Text.Encoding as TE-import System.IO ()--import Filesystem.Path hiding (root, filename, basename)-import Filesystem.Path.Internal------------------------------------------------------------------------------------ Generic----------------------------------------------------------------------------------rootChunk :: Maybe Root -> Chunk-rootChunk r = flip (maybe "") r $ \r' -> case r' of- RootPosix -> "/"- RootWindowsVolume c -> c : ":\\"- RootWindowsCurrentVolume -> "\\"--rootText :: Maybe Root -> T.Text-rootText = T.pack . rootChunk--directoryChunks :: FilePath -> [Chunk]-directoryChunks path = pathDirectories path ++ [filenameChunk path]------------------------------------------------------------------------------------ POSIX------------------------------------------------------------------------------------ | Linux, BSD, 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- }---- | Linux, BSD, and other UNIX or UNIX-like operating systems.------ This is a variant of 'posix' for use with GHC 7.2, which tries to decode--- file paths in its IO computations.------ Since: 0.3.3-posix_ghc702 :: Rules B.ByteString-posix_ghc702 = posix- { rulesName = T.pack "POSIX (GHC 7.2)"- , encodeString = posixToGhc702String- , decodeString = posixFromGhc702String- }---- | Linux, BSD, and other UNIX or UNIX-like operating systems.------ This is a variant of 'posix' for use with GHC 7.4 or later, which tries to--- decode file paths in its IO computations.------ Since: 0.3.7-posix_ghc704 :: Rules B.ByteString-posix_ghc704 = posix- { rulesName = T.pack "POSIX (GHC 7.4)"- , encodeString = posixToGhc704String- , decodeString = posixFromGhc704String- }--posixToText :: FilePath -> Either T.Text T.Text-posixToText p = if good then Right text else Left text where- good = and (map snd chunks)- text = T.concat (root : map fst chunks)- - root = rootText (pathRoot p)- chunks = intersperse (T.pack "/", True) (map unescape (directoryChunks p))--posixFromChunks :: [Chunk] -> FilePath-posixFromChunks chunks = FilePath root directories basename exts where- (root, pastRoot) = if P.null (head chunks)- then (Just RootPosix, tail chunks)- else (Nothing, chunks)- - (directories, filename)- | P.null pastRoot = ([], "")- | otherwise = case last pastRoot of- fn | fn == dot -> (goodDirs pastRoot, "")- fn | fn == dots -> (goodDirs pastRoot, "")- fn -> (goodDirs (init pastRoot), fn)- - goodDirs = filter (not . P.null)- - (basename, exts) = parseFilename filename--posixFromText :: T.Text -> FilePath-posixFromText text = if T.null text- then empty- else posixFromChunks (map escape (textSplitBy (== '/') text))--posixToBytes :: FilePath -> B.ByteString-posixToBytes p = B.concat (root : chunks) where- root = B8.pack (rootChunk (pathRoot p))- chunks = intersperse (B8.pack "/") (map chunkBytes (directoryChunks p))- chunkBytes c = unescapeBytes' 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 -> escape text- Nothing -> processInvalidUtf8 b--processInvalidUtf8 :: B.ByteString -> Chunk-processInvalidUtf8 bytes = intercalate "." textChunks where- byteChunks = B.split 0x2E bytes- textChunks = map unicodeDammit byteChunks- unicodeDammit b = case maybeDecodeUtf8 b of- Just t -> escape t- Nothing -> map (\c -> if ord c >= 0x80- then chr (ord c + 0xDC00)- else c) (B8.unpack b)--posixToGhc702String :: FilePath -> String-posixToGhc702String p = P.concat (root : chunks) where- root = rootChunk (pathRoot p)- chunks = intersperse "/" (map escapeToGhc702 (directoryChunks p))--escapeToGhc702 :: Chunk -> String-escapeToGhc702 = map (\c -> if ord c >= 0xDC80 && ord c <= 0xDCFF- then chr (ord c - 0xDC00 + 0xEF00)- else c)--posixFromGhc702String :: String -> FilePath-posixFromGhc702String cs = if P.null cs- then empty- else posixFromChunks (map escapeFromGhc702 (splitBy (== '/') cs))--escapeFromGhc702 :: String -> String-escapeFromGhc702 = map (\c -> if ord c >= 0xEF80 && ord c <= 0xEFFF- -- hopefully this isn't a valid UTF8 filename decoding to these- -- codepoints, but there's no way to tell here.- then chr (ord c - 0xEF00 + 0xDC00)- else c)--posixToGhc704String :: FilePath -> String-posixToGhc704String p = P.concat (root : chunks) where- root = rootChunk (pathRoot p)- chunks = intersperse "/" (directoryChunks p)--posixFromGhc704String :: String -> FilePath-posixFromGhc704String cs = if P.null cs- then empty- else posixFromChunks (splitBy (== '/') cs)--posixValid :: FilePath -> Bool-posixValid p = validRoot && validDirectories where- validDirectories = all validChunk (directoryChunks p)- validChunk ch = not (any (\c -> c == '\0' || c == '/') 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------------------------------------------------------------------------------------ Darwin------------------------------------------------------------------------------------ | Darwin and Mac OS X.------ This is almost identical to 'posix', but with a native path type of 'T.Text'--- rather than 'B.ByteString'.------ Since: 0.3.4-darwin :: Rules T.Text-darwin = Rules- { rulesName = T.pack "Darwin"- , valid = posixValid- , splitSearchPath = darwinSplitSearch- , toText = Right . darwinToText- , fromText = posixFromText- , encode = darwinToText- , decode = posixFromText- , encodeString = darwinToString- , decodeString = darwinFromString- }---- | Darwin and Mac OS X.------ This is a variant of 'darwin' for use with GHC 7.2 or later, which tries to--- decode file paths in its IO computations.------ Since: 0.3.4-darwin_ghc702 :: Rules T.Text-darwin_ghc702 = darwin- { rulesName = T.pack "Darwin (GHC 7.2)"- , encodeString = T.unpack . darwinToText- , decodeString = posixFromText . T.pack- }--darwinToText :: FilePath -> T.Text-darwinToText p = T.concat (root : chunks) where- root = rootText (pathRoot p)- chunks = intersperse (T.pack "/") (map unescape' (directoryChunks p))--darwinToString :: FilePath -> String-darwinToString = B8.unpack . TE.encodeUtf8 . darwinToText--darwinFromString :: String -> FilePath-darwinFromString = posixFromText . TE.decodeUtf8 . B8.pack--darwinSplitSearch :: T.Text -> [FilePath]-darwinSplitSearch = map (posixFromText . normSearch) . textSplitBy (== ':') where- normSearch text = if T.null text then T.pack "." else text------------------------------------------------------------------------------------ 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 unescape' (directoryChunks p))--winFromText :: T.Text -> FilePath-winFromText text = if T.null text then empty else path where- path = FilePath root directories basename exts- - split = textSplitBy (\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 = ([], "")- | otherwise = case last pastRoot of- fn | fn == T.pack "." -> (goodDirs pastRoot, "")- fn | fn == T.pack ".." -> (goodDirs pastRoot, "")- fn -> (goodDirs (init pastRoot), escape fn)- - goodDirs :: [T.Text] -> [Chunk]- goodDirs = map escape . filter (not . T.null)- - (basename, exts) = parseFilename filename--winValid :: FilePath -> Bool-winValid p = validRoot && noReserved && validCharacters where- reservedChars = map chr [0..0x1F] ++ "/\\?*:|\"<>"- reservedNames =- [ "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 (map toUpper fn) reservedNames- - validCharacters = flip all (directoryChunks p)- $ not . any (`elem` reservedChars)--winSplit :: T.Text -> [FilePath]-winSplit = map winFromText . filter (not . T.null) . textSplitBy (== ';')
− lib/System/FilePath.hs
@@ -1,15 +0,0 @@--- |--- Module: System.FilePath--- Copyright: 2011 John Millikin--- License: MIT------ Maintainer: jmillikin@gmail.com--- Portability: portable------ Deprecated alias for "Filesystem.Path"----module System.FilePath- ( module Filesystem.Path- ) where--import Filesystem.Path
− lib/System/FilePath/CurrentOS.hs
@@ -1,15 +0,0 @@--- |--- Module: System.FilePath.CurrentOS--- Copyright: 2011 John Millikin--- License: MIT------ Maintainer: jmillikin@gmail.com--- Portability: portable------ Deprecated alias for "Filesystem.Path.CurrentOS"----module System.FilePath.CurrentOS- ( module Filesystem.Path.CurrentOS- ) where--import Filesystem.Path.CurrentOS
− lib/System/FilePath/Rules.hs
@@ -1,15 +0,0 @@--- |--- Module: System.FilePath.Rules--- Copyright: 2011 John Millikin--- License: MIT------ Maintainer: jmillikin@gmail.com--- Portability: portable------ Deprecated alias for "Filesystem.Path.Rules"----module System.FilePath.Rules- ( module Filesystem.Path.Rules- ) where--import Filesystem.Path.Rules
− scripts/common.bash
@@ -1,23 +0,0 @@-PATH="$PATH:$PWD/cabal-dev/bin/"--VERSION=$(awk '/^version:/{print $2}' system-filepath.cabal)--CABAL_DEV=$(which cabal-dev)-XZ=$(which xz)--require_cabal_dev()-{- if [ -z "$CABAL_DEV" ]; then- echo "Can't find 'cabal-dev' executable; make sure it exists on your "'$PATH'- echo "Cowardly refusing to fuck with the global package database"- exit 1- fi-}--clean_dev_install()-{- require_cabal_dev- - rm -rf dist- $CABAL_DEV install || exit 1-}
− scripts/run-benchmarks
@@ -1,21 +0,0 @@-#!/bin/bash-if [ ! -f 'system-filepath.cabal' ]; then- echo -n "Can't find system-filepath.cabal; please run this script as"- echo -n " ./scripts/run-benchmarks from within the system-filepath source"- echo " directory"- exit 1-fi--. scripts/common.bash--require_cabal_dev--rm -rf dist-cabal-dev install || exit 1--pushd benchmarks-rm -rf dist-$CABAL_DEV -s ../cabal-dev install || exit 1-popd--cabal-dev/bin/system-filepath_benchmarks $@
− scripts/run-coverage
@@ -1,21 +0,0 @@-#!/bin/bash-if [ ! -f 'system-filepath.cabal' ]; then- echo -n "Can't find system-filepath.cabal; please run this script as"- echo -n " ./scripts/run-coverage from within the system-filepath source"- echo " directory"- exit 1-fi--. scripts/common.bash--require_cabal_dev--pushd tests-$CABAL_DEV -s ../cabal-dev install --flags="coverage" || exit 1-popd--rm -f system-filepath_tests.tix-cabal-dev/bin/system-filepath_tests $@--hpc markup --srcdir=src --srcdir=tests/ system-filepath_tests.tix --destdir=hpc-markup --exclude=Main-hpc report --srcdir=src --srcdir=tests/ system-filepath_tests.tix --exclude=Main
− scripts/run-tests
@@ -1,17 +0,0 @@-#!/bin/bash-if [ ! -f 'system-filepath.cabal' ]; then- echo -n "Can't find system-filepath.cabal; please run this script as"- echo -n " ./scripts/run-tests from within the system-filepath source"- echo " directory"- exit 1-fi--. scripts/common.bash--require_cabal_dev--pushd tests-$CABAL_DEV -s ../cabal-dev install || exit 1-popd--cabal-dev/bin/system-filepath_tests $@
system-filepath.cabal view
@@ -1,59 +1,38 @@ name: system-filepath-version: 0.3.7+version: 0.4 synopsis: High-level, byte-based file and directory path manipulations license: MIT license-file: license.txt author: John Millikin <jmillikin@gmail.com>-maintainer: John Millikin <jmillikin@gmail.com>-copyright: John Millikin 2010-2012+maintainer: jmillikin@gmail.com+copyright: Copyright (c) John Millikin 2010 build-type: Simple cabal-version: >= 1.6 category: System stability: experimental-homepage: https://john-millikin.com/software/haskell-filesystem/+homepage: https://john-millikin.com/software/hs-filepath/ bug-reports: mailto:jmillikin@gmail.com--extra-source-files:- scripts/common.bash- scripts/run-benchmarks- scripts/run-coverage- scripts/run-tests- --- tests/system-filepath-tests.cabal- tests/Tests.hs+tested-with: GHC == 6.12.1 source-repository head type: bzr- location: https://john-millikin.com/branches/system-filepath/0.3/--source-repository this- type: bzr- location: https://john-millikin.com/branches/system-filepath/0.3/- tag: system-filepath_0.3.7+ location: https://john-millikin.com/software/hs-filepath/ library ghc-options: -Wall -O2- hs-source-dirs: lib build-depends: base >= 3 && < 5 , bytestring >= 0.9 && < 0.10- , deepseq >= 1.1 && < 1.4- , text >= 0.7.1 && < 0.12+ , text >= 0.3 && < 0.12 if os(windows) cpp-options: -DCABAL_OS_WINDOWS - if os(darwin)- cpp-options: -DCABAL_OS_DARWIN- exposed-modules: Filesystem.Path Filesystem.Path.CurrentOS Filesystem.Path.Rules- System.FilePath- System.FilePath.CurrentOS- System.FilePath.Rules other-modules: Filesystem.Path.Internal
− tests/Tests.hs
@@ -1,561 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE OverloadedStrings #-}--module Main (tests, main) where--import Prelude hiding (FilePath)--import qualified Data.ByteString.Char8 as B8-import Data.Char (toUpper)-import Data.List (intercalate)-import qualified Data.Text as T-import Data.Text (Text)-import Test.Chell-import Test.Chell.QuickCheck-import Test.QuickCheck hiding (property)--import Filesystem.Path as P-import Filesystem.Path.CurrentOS ()-import Filesystem.Path.Rules--main :: IO ()-main = Test.Chell.defaultMain tests--tests :: [Suite]-tests =- [- -- Basic properties- test_Empty- , test_Root- , test_Directory- , test_Parent- , test_Filename- , test_Dirname- , test_Basename- , test_Absolute- , test_Relative- - -- Basic operations- , test_Append- , test_CommonPrefix- , test_StripPrefix- , property "stripPrefix" prop_StripPrefix- , test_SplitExtension- , test_Collapse- , test_InvalidUtf8InDirectoryComponent- , test_Utf8CharInGhcEscapeArea- - , suite "to-from-bytes"- [ test_Identity "posix" posix posixPaths- , test_Identity "windows" windows windowsPaths- , test_MixedValidityToBytes- ]- - , suite "to-from-text"- [ test_ToText- , test_FromText- ]- - , suite "validity"- [ property "posix" (forAll posixPaths (valid posix))- , property "windows" (forAll windowsPaths (valid windows))- ]- - , test_SplitSearchPath- , test_Parsing- , test_EncodeString- , test_DecodeString- , test_EqualsIgnoresPosixEncoding- , test_ShowRules- ]--test_Empty :: Suite-test_Empty = assertions "empty" $ do- $expect $ P.null empty- $expect $ equal (toChar8 empty) ""- $expect $ equal (toString empty) ""--test_Root :: Suite-test_Root = assertions "root" $ do- let root x = toChar8 (P.root (fromChar8 x))- - $expect $ equal (root "") ""- $expect $ equal (root "/") "/"- $expect $ equal (root "foo") ""- $expect $ equal (root "/foo") "/"--test_Directory :: Suite-test_Directory = assertions "directory" $ do- let directory x = toChar8 (P.directory (fromChar8 x))- - $expect $ equal (directory "") "./"- $expect $ equal (directory "/") "/"- $expect $ equal (directory "/foo/bar") "/foo/"- $expect $ equal (directory "/foo/bar/") "/foo/bar/"- $expect $ equal (directory ".") "./"- $expect $ equal (directory "..") "../"- $expect $ equal (directory "../foo") "../"- $expect $ equal (directory "../foo/") "../foo/"- $expect $ equal (directory "foo") "./"- $expect $ equal (directory "foo/bar") "./foo/"--test_Parent :: Suite-test_Parent = assertions "parent" $ do- let parent x = toChar8 (P.parent (fromChar8 x))- - $expect $ equal (parent "") "./"- $expect $ equal (parent "/") "/"- $expect $ equal (parent "/foo/bar") "/foo/"- $expect $ equal (parent "/foo/bar/") "/foo/"- $expect $ equal (parent ".") "./"- $expect $ equal (parent "..") "./"- $expect $ equal (parent "../foo/bar") "../foo/"- $expect $ equal (parent "../foo/bar") "../foo/"- $expect $ equal (parent "foo") "./"- $expect $ equal (parent "foo/bar") "./foo/"--test_Filename :: Suite-test_Filename = assertions "filename" $ do- let filename x = toChar8 (P.filename (fromChar8 x))- - $expect $ equal (filename "") ""- $expect $ equal (filename "/") ""- $expect $ equal (filename "/foo/") ""- $expect $ equal (filename "/foo/bar") "bar"- $expect $ equal (filename "/foo/bar.txt") "bar.txt"--test_Dirname :: Suite-test_Dirname = assertions "dirname" $ do- let dirname x = toChar8 (P.dirname (fromChar8 x))- - $expect $ equal (dirname "") ""- $expect $ equal (dirname "/") ""- $expect $ equal (dirname "foo") ""- $expect $ equal (dirname "foo/bar") "foo"- $expect $ equal (dirname "foo/bar/") "bar"- $expect $ equal (dirname "foo/bar/baz.txt") "bar"- - -- the directory name will be re-parsed to a file name.- let dirnameExts x = P.extensions (P.dirname (fromChar8 x))- $expect $ equal (dirnameExts "foo.d/bar") ["d"]- - -- reparsing preserves good/bad encoding state- $expect $ equal (dirnameExts "foo.\xB1.\xDD\xAA/bar") ["\xB1", "\x76A"]--test_Basename :: Suite-test_Basename = assertions "basename" $ do- let basename_posix x = toChar8 (basename (fromChar8 x))- let basename_windows x = toString (basename (fromString x))- - $expect $ equal (basename_posix "/foo/bar") "bar"- $expect $ equal (basename_posix "/foo/bar.txt") "bar"- $expect $ equal (basename_posix ".") ""- $expect $ equal (basename_posix "..") ""- - $expect $ equal (basename_windows "c:\\foo\\bar") "bar"- $expect $ equal (basename_windows "c:\\foo\\bar.txt") "bar"- $expect $ equal (basename_windows ".") ""- $expect $ equal (basename_windows "..") ""--test_Absolute :: Suite-test_Absolute = assertions "absolute" $ do- $expect $ absolute (fromChar8 "/")- $expect $ absolute (fromChar8 "/foo/bar")- $expect . not $ absolute (fromChar8 "")- $expect . not $ absolute (fromChar8 "foo/bar")- - $expect $ absolute (fromString "c:\\")- $expect $ absolute (fromString "c:\\foo\\bar")- $expect . not $ absolute (fromString "")- $expect . not $ absolute (fromString "foo\\bar")- $expect . not $ absolute (fromString "\\foo\\bar")--test_Relative :: Suite-test_Relative = assertions "relative" $ do- $expect . not $ relative (fromChar8 "/")- $expect . not $ relative (fromChar8 "/foo/bar")- $expect $ relative (fromChar8 "")- $expect $ relative (fromChar8 "foo/bar")- - $expect . not $ relative (fromString "c:\\")- $expect . not $ relative (fromString "c:\\foo\\bar")- $expect $ relative (fromString "")- $expect $ relative (fromString "foo\\bar")- $expect . not $ relative (fromString "\\foo\\bar")--test_Identity :: Text -> Rules a -> Gen FilePath -> Suite-test_Identity name r gen = property name $ forAll gen $ \p -> p == decode r (encode r p)--test_MixedValidityToBytes :: Suite-test_MixedValidityToBytes = assertions "mixed-validity-to-bytes" $ do- let p = fromChar8- - $expect $ equal (encode posix (p "\xB1.\xDD\xAA")) (B8.pack "\xB1.\xDD\xAA")- $expect $ equal (encode posix (p "\xB1.\xDD\xAA" </> p "foo")) (B8.pack "\xB1.\xDD\xAA/foo")--test_ToText :: Suite-test_ToText = assertions "toText" $ do- let p = fromChar8- - $expect $ equal (toText posix (p "")) (Right (T.pack ""))- $expect $ equal (toText posix (p "ascii")) (Right (T.pack "ascii"))- $expect $ equal (toText posix (p "\xF0\x9D\x84\x9E")) (Right (T.pack "\x1D11E"))- $expect $ equal (toText posix (p "\xED\xA0\x80")) (Left (T.pack "\xED\xA0\x80"))- $expect $ equal (toText posix (p "\xF0\x9D\x84\x9E/\xED\xA0\x80")) (Left (T.pack "\x1D11E/\xED\xA0\x80"))- $expect $ equal (toText posix (p "\xED.\xF0\x9D\x84\x9E.\xA0\x80")) (Left (T.pack "\xED.\x1D11E.\xA0\x80"))- $expect $ equal (toText posix (p "\xB1.\xDD\xAA")) (Left (T.pack "\xB1.\x76A"))- $expect $ equal (toText posix (p "\xB1.\xDD\xAA" </> p "foo")) (Left (T.pack "\xB1.\x76A/foo"))--test_FromText :: Suite-test_FromText = assertions "fromText" $ do- let pt x = fromText posix (T.pack x)- let p = fromChar8- - $expect $ equal (pt "") (p "")- $expect $ equal (pt "\x1D11E") (p "\xF0\x9D\x84\x9E")- $expect $ equal (pt "\xED\xA0\x80") (p "\xC3\xAD\xC2\xA0\xC2\x80")--test_Append :: Suite-test_Append = assertions "append" $ do- let appendP x y = toChar8 (P.append (fromChar8 x) (fromChar8 y))- let appendW x y = toString (P.append (fromString x) (fromString y))- - $expect $ equal (appendP "" "") ""- $expect $ equal (appendP "" "b/") "b/"- - -- Relative to a directory- $expect $ equal (appendP "a/" "") "a/"- $expect $ equal (appendP "a/" "b/") "a/b/"- $expect $ equal (appendP "a/" "b.txt") "a/b.txt"- $expect $ equal (appendP "a.txt" "b.txt") "a.txt/b.txt"- $expect $ equal (appendP "." "a") "./a"- - -- Relative to a file- $expect $ equal (appendP "a" "") "a/"- $expect $ equal (appendP "a" "b/") "a/b/"- $expect $ equal (appendP "a/b" "c") "a/b/c"- - -- Absolute- $expect $ equal (appendP "/a/" "") "/a/"- $expect $ equal (appendP "/a/" "b") "/a/b"- $expect $ equal (appendP "/a/" "b/") "/a/b/"- - -- Second parameter is absolute- $expect $ equal (appendP "/a/" "/") "/"- $expect $ equal (appendP "/a/" "/b") "/b"- $expect $ equal (appendP "/a/" "/b/") "/b/"- - -- Windows: volume handling- $expect $ equal (appendW "c:\\" "") "C:\\"- $expect $ equal (appendW "c:\\foo" "bar\\baz") "C:\\foo\\bar\\baz"- $expect $ equal (appendW "c:\\foo" "d:\\bar") "D:\\bar"- $expect $ equal (appendW "c:\\foo" "\\bar") "C:\\bar"- $expect $ equal (appendW "foo\\bar" "\\baz") "\\baz"--test_CommonPrefix :: Suite-test_CommonPrefix = assertions "commonPrefix" $ do- let commonPrefix xs = toChar8 (P.commonPrefix (map (fromChar8) xs))- - $expect $ equal (commonPrefix ["", ""]) ""- $expect $ equal (commonPrefix ["/", ""]) ""- $expect $ equal (commonPrefix ["/", "/"]) "/"- $expect $ equal (commonPrefix ["foo/", "/foo/"]) ""- $expect $ equal (commonPrefix ["/foo", "/foo/"]) "/"- $expect $ equal (commonPrefix ["/foo/", "/foo/"]) "/foo/"- $expect $ equal (commonPrefix ["/foo/bar/baz.txt.gz", "/foo/bar/baz.txt.gz.bar"]) "/foo/bar/baz.txt.gz"--test_StripPrefix :: Suite-test_StripPrefix = assertions "stripPrefix" $ do- let stripPrefix x y = fmap (toChar8) (P.stripPrefix (fromChar8 x) (fromChar8 y))- - $expect $ equal (stripPrefix "" "") (Just "")- $expect $ equal (stripPrefix "" "/") (Just "/")- $expect $ equal (stripPrefix "/" "/") (Just "")- $expect $ equal (stripPrefix "/" "/foo") (Just "foo")- $expect $ equal (stripPrefix "/" "/foo/bar") (Just "foo/bar")- $expect $ equal (stripPrefix "/foo/" "/foo/bar") (Just "bar")- $expect $ equal (stripPrefix "/foo/" "/foo/bar/baz") (Just "bar/baz")- $expect $ equal (stripPrefix "/foo/bar" "/foo/bar.txt") (Just ".txt")- $expect $ equal (stripPrefix "/foo/bar.txt" "/foo/bar.txt.gz") (Just ".gz")- - -- Test ignoring non-matching prefixes- $expect $ equal (stripPrefix "/foo" "/foo/bar") Nothing- $expect $ equal (stripPrefix "/foo/bar/baz" "/foo") Nothing- $expect $ equal (stripPrefix "/foo/baz/" "/foo/bar/qux") Nothing- $expect $ equal (stripPrefix "/foo/bar/baz" "/foo/bar/qux") Nothing- $expect $ equal (stripPrefix "/foo/bar/baz" "/foo/bar/qux") Nothing--prop_StripPrefix :: Property-prop_StripPrefix =- forAll posixPaths $ \x ->- forAll posixPaths $ \suffix ->- let prefix = x </> "" in- let full = fromChar8 (toChar8 prefix ++ toChar8 suffix) in- case stripPrefix prefix full of- Nothing -> False- Just stripped -> prefix </> stripped == full--test_SplitExtension :: Suite-test_SplitExtension = assertions "splitExtension" $ do- let splitExtension x = (toChar8 base, ext) where- (base, ext) = P.splitExtension (fromChar8 x)- - $expect $ equal (splitExtension "") ("", Nothing)- $expect $ equal (splitExtension "foo") ("foo", Nothing)- $expect $ equal (splitExtension "foo.") ("foo", Just (T.pack ""))- $expect $ equal (splitExtension "foo.a") ("foo", Just (T.pack "a"))- $expect $ equal (splitExtension "foo.a/") ("foo.a/", Nothing)- $expect $ equal (splitExtension "foo.a/bar") ("foo.a/bar", Nothing)- $expect $ equal (splitExtension "foo.a/bar.b") ("foo.a/bar", Just (T.pack "b"))- $expect $ equal (splitExtension "foo.a/bar.b.c") ("foo.a/bar.b", Just (T.pack "c"))--test_Collapse :: Suite-test_Collapse = assertions "collapse" $ do- let collapse x = toChar8 (P.collapse (fromChar8 x))- - $expect $ equal (collapse "./") "./"- $expect $ equal (collapse "././") "./"- $expect $ equal (collapse "../") "../"- $expect $ equal (collapse ".././") "../"- $expect $ equal (collapse "./../") "../"- $expect $ equal (collapse "../../") "../../"- $expect $ equal (collapse "parent/foo/baz/../bar") "parent/foo/bar"- $expect $ equal (collapse "parent/foo/baz/../../bar") "parent/bar"- $expect $ equal (collapse "parent/foo/..") "parent/"--test_InvalidUtf8InDirectoryComponent :: Suite-test_InvalidUtf8InDirectoryComponent = assertions "invalid-utf8-in-directory-component" $ do- $expect $ equal (toText posix (fromChar8 "/\218\130.\137\141")) (Left (T.pack "/\1666.\137\141"))- $expect $ equal (encode posix (fromChar8 "/\218\130.\137\141")) (B8.pack "/\218\130.\137\141")- - $expect $ equal (toText posix (fromChar8 "/\218\130.\137\141/")) (Left (T.pack "/\1666.\137\141/"))- $expect $ equal (encode posix (fromChar8 "/\218\130.\137\141/")) (B8.pack "/\218\130.\137\141/")- - $expect $ equal (toText posix (fromChar8 "/\218\130.\137\141//baz")) (Left (T.pack "/\1666.\137\141/baz"))- $expect $ equal (encode posix (fromChar8 "/\218\130.\137\141//baz")) (B8.pack "/\218\130.\137\141/baz")--test_Utf8CharInGhcEscapeArea :: Suite-test_Utf8CharInGhcEscapeArea = assertions "utf8-char-in-ghc-escape-area" $ do- let chars = "/a/\238\189\178/b"- let path = fromChar8 chars- $expect (equal (toChar8 path) chars)- $expect (equal (toText posix path) (Right (T.pack "/a/\61298/b")))- - let chars = "/a/\xEE\xBC\x80/b"- let path = fromChar8 chars- $expect (equal (toChar8 path) chars)- $expect (equal (toText posix path) (Right (T.pack "/a/\61184/b")))--test_Parsing :: Suite-test_Parsing = assertions "parsing" $ do- let p x = toChar8 (fromChar8 x)- let w x = toString (fromString x)- - $expect $ equal (p "") ""- $expect $ equal (p "/") "/"- $expect $ equal (p "/a") "/a"- $expect $ equal (p "/a/") "/a/"- $expect $ equal (p "a") "a"- $expect $ equal (p "a/") "a/"- $expect $ equal (p "a/b") "a/b"- $expect $ equal (p "a//b") "a/b"- $expect $ equal (p "a/./b") "a/./b"- $expect $ equal (p ".") "./"- $expect $ equal (p "./") "./"- $expect $ equal (p "..") "../"- $expect $ equal (p "../") "../"- - $expect $ equal (w "") ""- $expect $ equal (w "c:\\") "C:\\"- $expect $ equal (w "c:\\a") "C:\\a"- $expect $ equal (w "c:\\a\\") "C:\\a\\"- $expect $ equal (w "a") "a"- $expect $ equal (w "a/") "a\\"- $expect $ equal (w "a\\") "a\\"- $expect $ equal (w "a\\b") "a\\b"- $expect $ equal (w "a\\\\b") "a\\b"- $expect $ equal (w "a\\.\\b") "a\\.\\b"- $expect $ equal (w ".") ".\\"- $expect $ equal (w ".\\") ".\\"- $expect $ equal (w "..") "..\\"- $expect $ equal (w "..\\") "..\\"--test_SplitSearchPath :: Suite-test_SplitSearchPath = assertions "splitSearchPath" $ do- let p x = map (toChar8) (splitSearchPath posix (B8.pack x))- let w x = map (toString) (splitSearchPath windows (T.pack x))- - $expect $ equal (p "a:b:c") ["a", "b", "c"]- $expect $ equal (p "a::b:c") ["a", "./", "b", "c"]- $expect $ equal (w "a;b;c") ["a", "b", "c"]- $expect $ equal (w "a;;b;c") ["a", "b", "c"]--test_EncodeString :: Suite-test_EncodeString = suite "encodeString"- [ test_EncodeString_Posix- , test_EncodeString_Posix_Ghc702- , test_EncodeString_Posix_Ghc704- , test_EncodeString_Win32- ]--test_EncodeString_Posix :: Suite-test_EncodeString_Posix = assertions "posix" $ do- let enc = encodeString posix- $expect $ equal (enc (fromChar8 "test")) "test"- $expect $ equal (enc (fromChar8 "test\xC2\xA1\xC2\xA2")) "test\xC2\xA1\xC2\xA2"- $expect $ equal (enc (fromChar8 "test\xA1\xA2")) "test\xA1\xA2"- $expect $ equal (enc (fromChar8 "\xC2\xA1\xC2\xA2/test\xA1\xA2")) "\xC2\xA1\xC2\xA2/test\xA1\xA2"- $expect $ equal (enc (fromText posix "test\xA1\xA2")) "test\xC2\xA1\xC2\xA2"--test_EncodeString_Posix_Ghc702 :: Suite-test_EncodeString_Posix_Ghc702 = assertions "posix_ghc702" $ do- let enc = encodeString posix_ghc702- $expect $ equal (enc (fromChar8 "test")) "test"- $expect $ equal (enc (fromChar8 "test\xA1\xA2")) "test\xEFA1\xEFA2"- $expect $ equal (enc (fromChar8 "\xC2\xA1\xC2\xA2/test\xA1\xA2")) "\xA1\xA2/test\xEFA1\xEFA2"- $expect $ equal (enc (fromText posix_ghc702 "test\xA1\xA2")) "test\xA1\xA2"--test_EncodeString_Posix_Ghc704 :: Suite-test_EncodeString_Posix_Ghc704 = assertions "posix_ghc704" $ do- let enc = encodeString posix_ghc704- $expect $ equal (enc (fromChar8 "test")) "test"- $expect $ equal (enc (fromChar8 "test\xA1\xA2")) "test\xDCA1\xDCA2"- $expect $ equal (enc (fromChar8 "\xC2\xA1\xC2\xA2/test\xA1\xA2")) "\xA1\xA2/test\xDCA1\xDCA2"- $expect $ equal (enc (fromText posix_ghc704 "test\xA1\xA2")) "test\xA1\xA2"--test_EncodeString_Win32 :: Suite-test_EncodeString_Win32 = assertions "windows" $ do- let enc = encodeString windows- $expect $ equal (enc (fromString "test")) "test"- $expect $ equal (enc (fromString "test\xA1\xA2")) "test\xA1\xA2"- $expect $ equal (enc (fromText windows "test\xA1\xA2")) "test\xA1\xA2"--test_DecodeString :: Suite-test_DecodeString = suite "decodeString"- [ test_DecodeString_Posix- , test_DecodeString_Posix_Ghc702- , test_DecodeString_Posix_Ghc704- , test_DecodeString_Darwin- , test_DecodeString_Darwin_Ghc702- , test_DecodeString_Win32- ]--test_DecodeString_Posix :: Suite-test_DecodeString_Posix = assertions "posix" $ do- let r = posix- let dec = decodeString- $expect $ equal (dec r "test") (fromText r "test")- $expect $ equal (dec r "test\xC2\xA1\xC2\xA2") (fromText r "test\xA1\xA2")- $expect $ equal (dec r "test\xA1\xA2") (fromText r "test\xA1\xA2")--test_DecodeString_Posix_Ghc702 :: Suite-test_DecodeString_Posix_Ghc702 = assertions "posix_ghc702" $ do- let r = posix_ghc702- let dec = decodeString- $expect $ equal (dec r "test") (fromText r "test")- $expect $ equal (dec r "test\xC2\xA1\xC2\xA2") (fromText r "test\xC2\xA1\xC2\xA2")- $expect $ equal (dec r "test\xA1\xA2") (fromText r "test\xA1\xA2")- $expect $ equal (dec r "test\xEFA1\xEFA2") (fromChar8 "test\xA1\xA2")- $expect $ equal- (toText r (dec r "test\xEFA1\xEFA2"))- (Left "test\xA1\xA2")--test_DecodeString_Posix_Ghc704 :: Suite-test_DecodeString_Posix_Ghc704 = assertions "posix_ghc704" $ do- let r = posix_ghc704- let dec = decodeString- $expect $ equal (dec r "test") (fromText r "test")- $expect $ equal (dec r "test\xC2\xA1\xC2\xA2") (fromText r "test\xC2\xA1\xC2\xA2")- $expect $ equal (dec r "test\xA1\xA2") (fromText r "test\xA1\xA2")- $expect $ equal (dec r "test\xDCA1\xDCA2") (fromChar8 "test\xA1\xA2")- $expect $ equal- (toText r (dec r "test\xDCA1\xDCA2"))- (Left "test\xA1\xA2")--test_DecodeString_Darwin :: Suite-test_DecodeString_Darwin = assertions "darwin" $ do- let r = darwin- let dec = decodeString- $expect $ equal (dec r "test\xC2\xA1\xC2\xA2") (fromText r "test\xA1\xA2")--test_DecodeString_Darwin_Ghc702 :: Suite-test_DecodeString_Darwin_Ghc702 = assertions "darwin_ghc702" $ do- let r = darwin_ghc702- let dec = decodeString- $expect $ equal (dec r "test\xC2\xA1\xC2\xA2") (fromText r "test\xC2\xA1\xC2\xA2")- $expect $ equal (dec r "test\xA1\xA2") (fromText r "test\xA1\xA2")--test_DecodeString_Win32 :: Suite-test_DecodeString_Win32 = assertions "windows" $ do- let r = windows- let dec = decodeString- $expect $ equal (dec r "test") (fromText r "test")- $expect $ equal (dec r "test\xC2\xA1\xC2\xA2") (fromText r "test\xC2\xA1\xC2\xA2")- $expect $ equal (dec r "test\xA1\xA2") (fromText r "test\xA1\xA2")--test_EqualsIgnoresPosixEncoding :: Suite-test_EqualsIgnoresPosixEncoding = assertions "equals-ignores-posix-encoding" $ do- $expect $ equal- (fromChar8 "test\xA1\xA2")- (fromText posix "test\xA1\xA2")--test_ShowRules :: Suite-test_ShowRules = assertions "show-rules" $ do- $expect $ equal (showsPrec 11 darwin "") "(Rules \"Darwin\")"- $expect $ equal (showsPrec 11 darwin_ghc702 "") "(Rules \"Darwin (GHC 7.2)\")"- $expect $ equal (showsPrec 11 posix "") "(Rules \"POSIX\")"- $expect $ equal (showsPrec 11 posix_ghc702 "") "(Rules \"POSIX (GHC 7.2)\")"- $expect $ equal (showsPrec 11 windows "") "(Rules \"Windows\")"--posixPaths :: Gen FilePath-posixPaths = sized $ fmap merge . genComponents where- merge = fromChar8 . intercalate "/"- validChar c = not $ elem c ['\x00', '/']- component = do- size <- choose (0, 10)- vectorOf size $ arbitrary `suchThat` validChar- genComponents n = do- cs <- vectorOf n component- frequency [(1, return cs), (9, return ([""] ++ cs))]--windowsPaths :: Gen FilePath-windowsPaths = sized $ \n -> genComponents n >>= merge where- merge cs = do- root <- genRoot- let path = intercalate "\\" cs- return $ fromString $ root ++ path- - reserved = ['\x00'..'\x1F'] ++ ['/', '\\', '?', '*', ':', '|', '"', '<', '>']- reservedNames =- [ "AUX", "CLOCK$", "COM1", "COM2", "COM3", "COM4"- , "COM5", "COM6", "COM7", "COM8", "COM9", "CON"- , "LPT1", "LPT2", "LPT3", "LPT4", "LPT5", "LPT6"- , "LPT7", "LPT8", "LPT9", "NUL", "PRN"- ]- validChar c = not (elem c reserved)- validComponent c = not (elem (map toUpper c) reservedNames)- component = do- size <- choose (0, 10)- vectorOf size $ arbitrary `suchThat` validChar- genComponents n = do- cs <- vectorOf n (component `suchThat` validComponent)- frequency [(1, return cs), (9, return ([""] ++ cs))]- - genRoot = do- let upperChar = elements ['A'..'Z']- label <- frequency [(1, return Nothing), (9, fmap Just upperChar)]- return $ case label of- Just c -> [c, ':', '\\']- Nothing -> "\\"--toChar8 :: FilePath -> String-toChar8 = B8.unpack . encode posix--fromChar8 :: String -> FilePath-fromChar8 = decode posix . B8.pack--toString :: FilePath -> String-toString = T.unpack . encode windows--fromString :: String -> FilePath-fromString = decode windows . T.pack
− tests/system-filepath-tests.cabal
@@ -1,25 +0,0 @@-name: system-filepath-tests-version: 0-build-type: Simple-cabal-version: >= 1.6--flag coverage- default: False- manual: True--executable system-filepath_tests- main-is: Tests.hs- ghc-options: -Wall- hs-source-dirs: ../lib,.-- if flag(coverage)- ghc-options: -fhpc-- build-depends:- base > 3 && < 5- , bytestring- , chell >= 0.2 && < 0.3- , chell-quickcheck >= 0.1 && < 0.2- , deepseq >= 1.1 && < 1.4- , QuickCheck- , text