system-filepath 0.4.1 → 0.4.2
raw patch · 11 files changed
+1404/−872 lines, 11 files
Files
- lib/Filesystem/Path.hs +344/−0
- lib/Filesystem/Path/CurrentOS.hs +141/−0
- lib/Filesystem/Path/Internal.hs +159/−0
- lib/Filesystem/Path/Rules.hs +243/−0
- src/Filesystem/Path.hs +0/−344
- src/Filesystem/Path/CurrentOS.hs +0/−137
- src/Filesystem/Path/Internal.hs +0/−156
- src/Filesystem/Path/Rules.hs +0/−232
- system-filepath.cabal +7/−3
- tests/Tests.hs +486/−0
- tests/system-filepath-tests.cabal +24/−0
+ lib/Filesystem/Path.hs view
@@ -0,0 +1,344 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}++-- |+-- Module: Filesystem.Path+-- Copyright: 2010 John Millikin+-- License: MIT+--+-- Maintainer: jmillikin@gmail.com+-- Portability: portable+--+-- High‐level, byte‐based file and directory path+-- manipulations. You probably want to import "Filesystem.Path.CurrentOS"+-- instead, since it handles detecting which rules to use in the current+-- compilation.+--+module Filesystem.Path+ ( FilePath+ , empty+ + -- * Basic properties+ , null+ , root+ , directory+ , parent+ , filename+ , dirname+ , basename+ , absolute+ , relative+ + -- * Basic operations+ , append+ , (</>)+ , concat+ , commonPrefix+ , stripPrefix+ , collapse+ + -- * Extensions+ , extension+ , extensions+ , hasExtension+ + , addExtension+ , (<.>)+ , dropExtension+ , replaceExtension+ + , addExtensions+ , dropExtensions+ , replaceExtensions+ + , splitExtension+ , splitExtensions+ ) where++import Prelude hiding (FilePath, concat, null)++import Data.List (foldl')+import Data.Maybe (isNothing)+import qualified Data.Monoid as M+import qualified Data.Text as T++import Filesystem.Path.Internal++instance M.Monoid FilePath where+ mempty = empty+ mappend = append+ mconcat = concat++-------------------------------------------------------------------------------+-- Basic properties+-------------------------------------------------------------------------------++-- | @null p = (p == 'empty')@+null :: FilePath -> Bool+null = (== empty)++-- | Retrieves the 'FilePath'’s root.+root :: FilePath -> FilePath+root p = empty { pathRoot = pathRoot p }++-- | Retrieves the 'FilePath'’s directory. If the path is already a+-- directory, it is returned unchanged.+directory :: FilePath -> FilePath+directory p = empty+ { pathRoot = pathRoot p+ , pathDirectories = let+ starts = map Just [dot, dots]+ dot' | safeHead (pathDirectories p) `elem` starts = []+ | isNothing (pathRoot p) = [dot]+ | otherwise = []+ in dot' ++ pathDirectories p+ }++-- | Retrieves the 'FilePath'’s parent directory.+parent :: FilePath -> FilePath+parent p = empty+ { pathRoot = pathRoot p+ , pathDirectories = let+ starts = map Just [dot, dots]+ directories = if null (filename p)+ then safeInit (pathDirectories p)+ else pathDirectories p+ + dot' | safeHead directories `elem` starts = []+ | isNothing (pathRoot p) = [dot]+ | otherwise = []+ in dot' ++ directories+ }++-- | Retrieve a 'FilePath'’s filename component.+--+-- @+-- filename \"foo/bar.txt\" == \"bar.txt\"+-- @+filename :: FilePath -> FilePath+filename p = empty+ { pathBasename = pathBasename p+ , pathExtensions = pathExtensions p+ }++-- | Retrieve a 'FilePath'’s directory name. This is only the+-- /file name/ of the directory, not its full path.+--+-- @+-- dirname \"foo/bar/baz.txt\" == \"bar\"+-- dirname \"/\" == \"\"+-- @+--+-- Since: 0.4.1+dirname :: FilePath -> FilePath+dirname p = case reverse (pathDirectories p) of+ [] -> FilePath Nothing [] Nothing []+ (d:_) -> let+ d':exts = T.split (== '.') (chunkText d)+ chunk txt = d { chunkText = txt }+ in FilePath Nothing [] (Just (chunk d')) (map chunk exts)+++-- | Retrieve a 'FilePath'’s basename component.+--+-- @+-- basename \"foo/bar.txt\" == \"bar\"+-- @+basename :: FilePath -> FilePath+basename p = empty+ { pathBasename = pathBasename p+ }++-- | Test whether a path is absolute.+absolute :: FilePath -> Bool+absolute p = case pathRoot p of+ Just RootPosix -> True+ Just (RootWindowsVolume _) -> True+ _ -> False++-- | Test whether a path is relative.+relative :: FilePath -> Bool+relative p = case pathRoot p of+ Just _ -> False+ _ -> True++-------------------------------------------------------------------------------+-- Basic operations+-------------------------------------------------------------------------------++-- | Appends two 'FilePath's. If the second path is absolute, it is returned+-- unchanged.+append :: FilePath -> FilePath -> FilePath+append x y = cased where+ cased = case pathRoot y of+ Just RootPosix -> y+ Just (RootWindowsVolume _) -> y+ Just RootWindowsCurrentVolume -> case pathRoot x of+ Just (RootWindowsVolume _) -> y { pathRoot = pathRoot x }+ _ -> y+ Nothing -> xy+ xy = y+ { pathRoot = pathRoot x+ , pathDirectories = directories+ }+ directories = xDirectories ++ pathDirectories y+ xDirectories = (pathDirectories x ++) $ if null (filename x)+ then []+ else [filenameChunk True x]++-- | An alias for 'append'.+(</>) :: FilePath -> FilePath -> FilePath+(</>) = append++-- | A fold over 'append'.+concat :: [FilePath] -> FilePath+concat [] = empty+concat ps = foldr1 append ps++-- | Find the greatest common prefix between a list of 'FilePath's.+commonPrefix :: [FilePath] -> FilePath+commonPrefix [] = empty+commonPrefix ps = foldr1 step ps where+ step x y = if pathRoot x /= pathRoot y+ then empty+ else let cs = commonDirectories x y in+ if cs /= pathDirectories x || pathBasename x /= pathBasename y+ then empty { pathRoot = pathRoot x, pathDirectories = cs }+ else let exts = commonExtensions x y in+ x { pathExtensions = exts }+ + commonDirectories x y = common (pathDirectories x) (pathDirectories y)+ commonExtensions x y = common (pathExtensions x) (pathExtensions y)+ + common [] _ = []+ common _ [] = []+ common (x:xs) (y:ys) = if x == y+ then x : common xs ys+ else []++-- Remove a prefix from a path.+--+-- @+-- stripPrefix "/foo/" "/foo/bar/baz.txt" == Just "bar/baz.txt"+-- stripPrefix "/foo/" "/bar/baz.txt" == Nothing+-- @+--+-- Since: 0.4.1+stripPrefix :: FilePath -> FilePath -> Maybe FilePath+stripPrefix x y = if pathRoot x /= pathRoot y+ then case pathRoot x of+ Nothing -> Just y+ Just _ -> Nothing+ else do+ dirs <- strip (pathDirectories x) (pathDirectories y)+ case dirs of+ [] -> case (pathBasename x, pathBasename y) of+ (Nothing, Nothing) -> do+ exts <- strip (pathExtensions x) (pathExtensions y)+ return (y { pathRoot = Nothing, pathDirectories = dirs, pathExtensions = exts })+ (Nothing, Just _) -> case pathExtensions x of+ [] -> Just (y { pathRoot = Nothing, pathDirectories = dirs })+ _ -> Nothing+ (Just x_b, Just y_b) | x_b == y_b -> do+ exts <- strip (pathExtensions x) (pathExtensions y)+ return (empty { pathExtensions = exts })+ _ -> Nothing+ _ -> case (pathBasename x, pathExtensions x) of+ (Nothing, []) -> Just (y { pathRoot = Nothing, pathDirectories = dirs })+ _ -> Nothing++strip :: Eq a => [a] -> [a] -> Maybe [a]+strip [] ys = Just ys+strip _ [] = Nothing+strip (x:xs) (y:ys) = if x == y+ then strip xs ys+ else Nothing++-- | Remove @\".\"@ and @\"..\"@ directories from a path.+--+-- Note that if any of the elements are symbolic links, 'collapse' may change+-- which file the path resolves to.+--+-- Since: 0.2+collapse :: FilePath -> FilePath+collapse p = p { pathDirectories = reverse newDirs } where+ (_, newDirs) = foldl' step (True, []) (pathDirectories p)+ + step (True, acc) c = (False, c:acc)+ step (_, acc) c | c == dot = (False, acc)+ step (_, acc) c | c == dots = case acc of+ [] -> (False, c:acc)+ (h:ts) | h == dot -> (False, c:ts)+ | h == dots -> (False, c:acc)+ | otherwise -> (False, ts)+ step (_, acc) c = (False, c:acc)++-------------------------------------------------------------------------------+-- Extensions+-------------------------------------------------------------------------------++-- | Get a 'FilePath'’s last extension, or 'Nothing' if it has no+-- extensions.+extension :: FilePath -> Maybe T.Text+extension p = case extensions p of+ [] -> Nothing+ es -> Just (last es)++-- | Get a 'FilePath'’s full extension list.+extensions :: FilePath -> [T.Text]+extensions = map chunkText . pathExtensions++-- | Get whether a 'FilePath'’s last extension is the predicate.+hasExtension :: FilePath -> T.Text -> Bool+hasExtension p e = extension p == Just e++-- | Append an extension to the end of a 'FilePath'.+addExtension :: FilePath -> T.Text -> FilePath+addExtension p ext = addExtensions p [ext]++-- | Append many extensions to the end of a 'FilePath'.+addExtensions :: FilePath -> [T.Text] -> FilePath+addExtensions p exts = p { pathExtensions = newExtensions } where+ newExtensions = pathExtensions p ++ chunks+ chunks = map (\e -> Chunk e True) exts++-- | An alias for 'addExtension'.+(<.>) :: FilePath -> T.Text -> FilePath+(<.>) = addExtension++-- | Remove a 'FilePath'’s last extension.+dropExtension :: FilePath -> FilePath+dropExtension p = p { pathExtensions = safeInit (pathExtensions p) }++-- | Remove all extensions from a 'FilePath'.+dropExtensions :: FilePath -> FilePath+dropExtensions p = p { pathExtensions = [] }++-- | Replace a 'FilePath'’s last extension.+replaceExtension :: FilePath -> T.Text -> FilePath+replaceExtension = addExtension . dropExtension++-- | Remove all extensions from a 'FilePath', and replace them with a new+-- list.+replaceExtensions :: FilePath -> [T.Text] -> FilePath+replaceExtensions = addExtensions . dropExtensions++-- | @splitExtension p = ('dropExtension' p, 'extension' p)@+splitExtension :: FilePath -> (FilePath, Maybe T.Text)+splitExtension p = (dropExtension p, extension p)++-- | @splitExtensions p = ('dropExtensions' p, 'extensions' p)@+splitExtensions :: FilePath -> (FilePath, [T.Text])+splitExtensions p = (dropExtensions p, extensions p)++-------------------------------------------------------------------------------+-- Utils+-------------------------------------------------------------------------------++safeInit :: [a] -> [a]+safeInit xs = case xs of+ [] -> []+ _ -> init xs++safeHead :: [a] -> Maybe a+safeHead [] = Nothing+safeHead (x:_) = Just x
+ lib/Filesystem/Path/CurrentOS.hs view
@@ -0,0 +1,141 @@+{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++-- |+-- Module: Filesystem.Path.CurrentOS+-- Copyright: 2010 John Millikin+-- License: MIT+--+-- Maintainer: jmillikin@gmail.com+-- Portability: portable+--+-- Re‐exports contents of "Filesystem.Path.Rules", defaulting to the+-- current OS’s rules when needed.+--+-- Also enables 'Show' and 'S.IsString' instances for 'F.FilePath'.+--+module Filesystem.Path.CurrentOS+ ( module Filesystem.Path+ , currentOS+ + -- * Type conversions+ , toText+ , fromText+ , encode+ , decode+ , encodeString+ , decodeString+ + -- * Rule‐specific path properties+ , valid+ , splitSearchPath+ ) where++import Prelude hiding (FilePath)++import qualified Data.ByteString as B+import qualified Data.String as S+import qualified Data.Text as T++import Filesystem.Path+import qualified Filesystem.Path as F+import qualified Filesystem.Path.Rules as R++#if defined(CABAL_OS_WINDOWS)+#define PLATFORM_PATH_FORMAT T.Text+#else+#define PLATFORM_PATH_FORMAT B.ByteString+#endif++currentOS :: R.Rules PLATFORM_PATH_FORMAT+#if defined(CABAL_OS_WINDOWS)+currentOS = R.windows+#else+#if __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 view
@@ -0,0 +1,159 @@+{-# 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 (Ord, Data, Typeable)++instance Eq Chunk where+ (Chunk x _) == (Chunk y _) = x == y++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))
+ lib/Filesystem/Path/Rules.hs view
@@ -0,0 +1,243 @@+-- |+-- Module: Filesystem.Path.Rules+-- Copyright: 2010 John Millikin+-- License: MIT+--+-- Maintainer: jmillikin@gmail.com+-- Portability: portable+--+module Filesystem.Path.Rules+ ( Rules+ , posix+ , posix_ghc702+ , 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+ }++-- | Linux, BSD, OS X, and other UNIX or UNIX-like operating systems.+--+-- This variant is for use with GHC 7.2 or later, which tries to decode+-- file paths in its IO computations.+posix_ghc702 :: Rules B.ByteString+posix_ghc702 = posix+ { encodeString = T.unpack . either id id . posixToText+ , decodeString = posixFromText . T.pack+ }++posixToText :: FilePath -> Either T.Text T.Text+posixToText p = if good then Right text else Left text where+ good = and (map chunkGood chunks)+ text = T.concat (root : map chunkText chunks)+ + root = rootText (pathRoot p)+ chunks = intersperse (Chunk (T.pack "/") True) (directoryChunks False p)++posixFromChunks :: [Chunk] -> FilePath+posixFromChunks chunks = FilePath root directories basename exts where+ (root, pastRoot) = if T.null (chunkText (head chunks))+ then (Just RootPosix, tail chunks)+ else (Nothing, chunks)+ + (directories, filename)+ | P.null pastRoot = ([], Chunk T.empty True)+ | otherwise = case last pastRoot of+ fn | fn == dot -> (goodDirs pastRoot, Chunk T.empty True)+ fn | fn == dots -> (goodDirs pastRoot, Chunk T.empty True)+ fn -> (goodDirs (init pastRoot), fn)+ + goodDirs = filter (not . T.null . chunkText)+ + (basename, exts) = if T.null (chunkText filename)+ then (Nothing, [])+ else case T.split (== '.') (chunkText filename) of+ [] -> (Nothing, [])+ (name':exts') -> if chunkGood filename+ then (Just (Chunk name' True), map (\e -> Chunk e True) exts')+ else (Just (checkChunk name'), map checkChunk exts')+ + checkChunk raw = case maybeDecodeUtf8 (B8.pack (T.unpack raw)) of+ Just text -> Chunk text True+ Nothing -> Chunk raw False++posixFromText :: T.Text -> FilePath+posixFromText text = if T.null text+ then empty+ else posixFromChunks (map (\t -> Chunk t True) (T.split (== '/') text))++posixToBytes :: FilePath -> B.ByteString+posixToBytes p = B.concat (root : chunks) where+ root = TE.encodeUtf8 (rootText (pathRoot p))+ chunks = intersperse (B8.pack "/") (map chunkBytes (directoryChunks True p))+ chunkBytes c = if chunkGood c+ then TE.encodeUtf8 (chunkText c)+ else B8.pack (T.unpack (chunkText c))++posixFromBytes :: B.ByteString -> FilePath+posixFromBytes bytes = if B.null bytes+ then empty+ else posixFromChunks $ flip map (B.split 0x2F bytes) $ \b -> case maybeDecodeUtf8 b of+ Just text -> Chunk text True+ Nothing -> Chunk (T.pack (B8.unpack b)) False++posixValid :: FilePath -> Bool+posixValid p = validRoot && validDirectories where+ validDirectories = all validChunk (directoryChunks True p)+ validChunk ch = not (T.any (\c -> c == '\0' || c == '/') (chunkText ch))+ validRoot = case pathRoot p of+ Nothing -> True+ Just RootPosix -> True+ _ -> False++posixSplitSearch :: B.ByteString -> [FilePath]+posixSplitSearch = map (posixFromBytes . normSearch) . B.split 0x3A where+ normSearch bytes = if B.null bytes then B8.pack "." else bytes++-------------------------------------------------------------------------------+-- Windows+-------------------------------------------------------------------------------++-- | Windows and DOS+windows :: Rules T.Text+windows = Rules+ { rulesName = T.pack "Windows"+ , valid = winValid+ , splitSearchPath = winSplit+ , toText = Right . winToText+ , fromText = winFromText+ , encode = winToText+ , decode = winFromText+ , encodeString = T.unpack . winToText+ , decodeString = winFromText . T.pack+ }++winToText :: FilePath -> T.Text+winToText p = T.concat (root : chunks) where+ root = rootText (pathRoot p)+ chunks = intersperse (T.pack "\\") (map chunkText (directoryChunks False p))++winFromText :: T.Text -> FilePath+winFromText text = if T.null text then empty else path where+ path = FilePath root directories basename exts+ + split = T.split (\c -> c == '/' || c == '\\') text+ + (root, pastRoot) = let+ head' = head split+ tail' = tail split+ in if T.null head'+ then (Just RootWindowsCurrentVolume, tail')+ else if T.any (== ':') head'+ then (Just (parseDrive head'), tail')+ else (Nothing, split)+ + parseDrive = RootWindowsVolume . toUpper . T.head+ + (directories, filename)+ | P.null pastRoot = ([], T.empty)+ | otherwise = case last pastRoot of+ fn | fn == chunkText dot -> (goodDirs pastRoot, T.empty)+ fn | fn == chunkText dots -> (goodDirs pastRoot, T.empty)+ fn -> (goodDirs (init pastRoot), fn)+ + goodDirs = map (\t -> Chunk t True) . filter (not . T.null)+ + (basename, exts) = if T.null filename+ then (Nothing, [])+ else case T.split (== '.') filename of+ [] -> (Nothing, [])+ (name':exts') -> (Just (Chunk name' True), map (\e -> Chunk e True) exts')++winValid :: FilePath -> Bool+winValid p = validRoot && noReserved && validCharacters where+ reservedChars = map chr [0..0x1F] ++ "/\\?*:|\"<>"+ reservedNames = map T.pack+ [ "AUX", "CLOCK$", "COM1", "COM2", "COM3", "COM4"+ , "COM5", "COM6", "COM7", "COM8", "COM9", "CON"+ , "LPT1", "LPT2", "LPT3", "LPT4", "LPT5", "LPT6"+ , "LPT7", "LPT8", "LPT9", "NUL", "PRN"+ ]+ + validRoot = case pathRoot p of+ Nothing -> True+ Just RootWindowsCurrentVolume -> True+ Just (RootWindowsVolume v) -> elem v ['A'..'Z']+ _ -> False+ + noExt = p { pathExtensions = [] }+ noReserved = flip all (directoryChunks False noExt)+ $ \fn -> notElem (T.toUpper (chunkText fn)) reservedNames+ + validCharacters = flip all (directoryChunks False p)+ $ not . T.any (`elem` reservedChars) . chunkText++winSplit :: T.Text -> [FilePath]+winSplit = map winFromText . filter (not . T.null) . T.split (== ';')
− src/Filesystem/Path.hs
@@ -1,344 +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.4.1-dirname :: FilePath -> FilePath-dirname p = case reverse (pathDirectories p) of- [] -> FilePath Nothing [] Nothing []- (d:_) -> let- d':exts = T.split (== '.') (chunkText d)- chunk txt = d { chunkText = txt }- in FilePath Nothing [] (Just (chunk d')) (map chunk exts)----- | Retrieve a 'FilePath'’s basename component.------ @--- basename \"foo/bar.txt\" == \"bar\"--- @-basename :: FilePath -> FilePath-basename p = empty- { pathBasename = pathBasename p- }---- | Test whether a path is absolute.-absolute :: FilePath -> Bool-absolute p = case pathRoot p of- Just RootPosix -> True- Just (RootWindowsVolume _) -> True- _ -> False---- | Test whether a path is relative.-relative :: FilePath -> Bool-relative p = case pathRoot p of- Just _ -> False- _ -> True------------------------------------------------------------------------------------ Basic operations------------------------------------------------------------------------------------ | Appends two 'FilePath's. If the second path is absolute, it is returned--- unchanged.-append :: FilePath -> FilePath -> FilePath-append x y = cased where- cased = case pathRoot y of- Just RootPosix -> y- Just (RootWindowsVolume _) -> y- Just RootWindowsCurrentVolume -> case pathRoot x of- Just (RootWindowsVolume _) -> y { pathRoot = pathRoot x }- _ -> y- Nothing -> xy- xy = y- { pathRoot = pathRoot x- , pathDirectories = directories- }- directories = xDirectories ++ pathDirectories y- xDirectories = (pathDirectories x ++) $ if null (filename x)- then []- else [filenameChunk True x]---- | An alias for 'append'.-(</>) :: FilePath -> FilePath -> FilePath-(</>) = append---- | A fold over 'append'.-concat :: [FilePath] -> FilePath-concat [] = empty-concat ps = foldr1 append ps---- | Find the greatest common prefix between a list of 'FilePath's.-commonPrefix :: [FilePath] -> FilePath-commonPrefix [] = empty-commonPrefix ps = foldr1 step ps where- step x y = if pathRoot x /= pathRoot y- then empty- else let cs = commonDirectories x y in- if cs /= pathDirectories x || pathBasename x /= pathBasename y- then empty { pathRoot = pathRoot x, pathDirectories = cs }- else let exts = commonExtensions x y in- x { pathExtensions = exts }- - commonDirectories x y = common (pathDirectories x) (pathDirectories y)- commonExtensions x y = common (pathExtensions x) (pathExtensions y)- - common [] _ = []- common _ [] = []- common (x:xs) (y:ys) = if x == y- then x : common xs ys- else []---- Remove a prefix from a path.------ @--- stripPrefix "/foo/" "/foo/bar/baz.txt" == Just "bar/baz.txt"--- stripPrefix "/foo/" "/bar/baz.txt" == Nothing--- @------ Since: 0.4.1-stripPrefix :: FilePath -> FilePath -> Maybe FilePath-stripPrefix x y = if pathRoot x /= pathRoot y- then case pathRoot x of- Nothing -> Just y- Just _ -> Nothing- else do- dirs <- strip (pathDirectories x) (pathDirectories y)- case dirs of- [] -> case (pathBasename x, pathBasename y) of- (Nothing, Nothing) -> do- exts <- strip (pathExtensions x) (pathExtensions y)- return (y { pathRoot = Nothing, pathDirectories = dirs, pathExtensions = exts })- (Nothing, Just _) -> case pathExtensions x of- [] -> Just (y { pathRoot = Nothing, pathDirectories = dirs })- _ -> Nothing- (Just x_b, Just y_b) | x_b == y_b -> do- exts <- strip (pathExtensions x) (pathExtensions y)- return (empty { pathExtensions = exts })- _ -> Nothing- _ -> case (pathBasename x, pathExtensions x) of- (Nothing, []) -> Just (y { pathRoot = Nothing, pathDirectories = dirs })- _ -> Nothing--strip :: Eq a => [a] -> [a] -> Maybe [a]-strip [] ys = Just ys-strip _ [] = Nothing-strip (x:xs) (y:ys) = if x == y- then strip xs ys- else Nothing---- | Remove @\".\"@ and @\"..\"@ directories from a path.------ Note that if any of the elements are symbolic links, 'collapse' may change--- which file the path resolves to.------ Since: 0.2-collapse :: FilePath -> FilePath-collapse p = p { pathDirectories = reverse newDirs } where- (_, newDirs) = foldl' step (True, []) (pathDirectories p)- - step (True, acc) c = (False, c:acc)- step (_, acc) c | c == dot = (False, acc)- step (_, acc) c | c == dots = case acc of- [] -> (False, c:acc)- (h:ts) | h == dot -> (False, c:ts)- | h == dots -> (False, c:acc)- | otherwise -> (False, ts)- step (_, acc) c = (False, c:acc)------------------------------------------------------------------------------------ Extensions------------------------------------------------------------------------------------ | Get a 'FilePath'’s last extension, or 'Nothing' if it has no--- extensions.-extension :: FilePath -> Maybe T.Text-extension p = case extensions p of- [] -> Nothing- es -> Just (last es)---- | Get a 'FilePath'’s full extension list.-extensions :: FilePath -> [T.Text]-extensions = map chunkText . pathExtensions---- | Get whether a 'FilePath'’s last extension is the predicate.-hasExtension :: FilePath -> T.Text -> Bool-hasExtension p e = extension p == Just e---- | Append an extension to the end of a 'FilePath'.-addExtension :: FilePath -> T.Text -> FilePath-addExtension p ext = addExtensions p [ext]---- | Append many extensions to the end of a 'FilePath'.-addExtensions :: FilePath -> [T.Text] -> FilePath-addExtensions p exts = p { pathExtensions = newExtensions } where- newExtensions = pathExtensions p ++ chunks- chunks = map (\e -> Chunk e True) exts---- | An alias for 'addExtension'.-(<.>) :: FilePath -> T.Text -> FilePath-(<.>) = addExtension---- | Remove a 'FilePath'’s last extension.-dropExtension :: FilePath -> FilePath-dropExtension p = p { pathExtensions = safeInit (pathExtensions p) }---- | Remove all extensions from a 'FilePath'.-dropExtensions :: FilePath -> FilePath-dropExtensions p = p { pathExtensions = [] }---- | Replace a 'FilePath'’s last extension.-replaceExtension :: FilePath -> T.Text -> FilePath-replaceExtension = addExtension . dropExtension---- | Remove all extensions from a 'FilePath', and replace them with a new--- list.-replaceExtensions :: FilePath -> [T.Text] -> FilePath-replaceExtensions = addExtensions . dropExtensions---- | @splitExtension p = ('dropExtension' p, 'extension' p)@-splitExtension :: FilePath -> (FilePath, Maybe T.Text)-splitExtension p = (dropExtension p, extension p)---- | @splitExtensions p = ('dropExtensions' p, 'extensions' p)@-splitExtensions :: FilePath -> (FilePath, [T.Text])-splitExtensions p = (dropExtensions p, extensions p)------------------------------------------------------------------------------------ Utils----------------------------------------------------------------------------------safeInit :: [a] -> [a]-safeInit xs = case xs of- [] -> []- _ -> init xs--safeHead :: [a] -> Maybe a-safeHead [] = Nothing-safeHead (x:_) = Just x
− src/Filesystem/Path/CurrentOS.hs
@@ -1,137 +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)-#define PLATFORM_PATH_FORMAT T.Text-#else-#define PLATFORM_PATH_FORMAT B.ByteString-#endif--currentOS :: R.Rules PLATFORM_PATH_FORMAT-#if defined(CABAL_OS_WINDOWS)-currentOS = R.windows-#else-currentOS = R.posix-#endif--instance S.IsString F.FilePath where- fromString = R.fromText currentOS . T.pack--instance Show F.FilePath where- showsPrec d path = showParen (d > 10) (ss "FilePath " . s txt) where- s = shows- ss = showString- txt = either id id (toText path)---- | Attempt to convert a 'F.FilePath' to human‐readable text.------ If the path is decoded successfully, the result is a 'Right' containing--- the decoded text. Successfully decoded text can be converted back to the--- original path using 'fromText'.------ If the path cannot be decoded, the result is a 'Left' containing an--- approximation of the original path. If displayed to the user, this value--- should be accompanied by some warning that the path has an invalid--- encoding. Approximated text cannot be converted back to the original path.------ This function ignores the user’s locale, and assumes all file paths--- are encoded in UTF8. If you need to display file paths with an unusual or--- obscure encoding, use 'encode' and then decode them manually.------ Since: 0.2-toText :: F.FilePath -> Either T.Text T.Text-toText = R.toText currentOS---- | Convert human‐readable text into a 'FilePath'.------ This function ignores the user’s locale, and assumes all file paths--- are encoded in UTF8. If you need to create file paths with an unusual or--- obscure encoding, encode them manually and then use 'decode'.------ Since: 0.2-fromText :: T.Text -> F.FilePath-fromText = R.fromText currentOS---- | Check if a 'FilePath' is valid; it must not contain any illegal--- characters, and must have a root appropriate to the current 'R.Rules'.-valid :: F.FilePath -> Bool-valid = R.valid currentOS---- | Split a search path, such as @$PATH@ or @$PYTHONPATH@, into a list--- of 'FilePath's.-splitSearchPath :: PLATFORM_PATH_FORMAT -> [F.FilePath]-splitSearchPath = R.splitSearchPath currentOS---- | Convert a 'F.FilePath' to a platform‐specific format, suitable--- for use with external OS functions.------ Since: 0.3-encode :: F.FilePath -> PLATFORM_PATH_FORMAT-encode = R.encode currentOS---- | Convert a 'F.FilePath' from a platform‐specific format, suitable--- for use with external OS functions.------ Since: 0.3-decode :: PLATFORM_PATH_FORMAT -> F.FilePath-decode = R.decode currentOS---- | Attempt to convert a 'F.FilePath' to a string suitable for use with--- functions in @System.IO@. The contents of this string are--- platform‐dependent, and are not guaranteed to be--- human‐readable. For converting 'F.FilePath's to a--- human‐readable format, use 'toText'.------ Since: 0.3.1-encodeString :: F.FilePath -> String-encodeString = R.encodeString currentOS---- | Attempt to parse a 'F.FilePath' from a string suitable for use with--- functions in @System.IO@. Do not use this function for parsing--- human‐readable paths, as the character set decoding is--- platform‐dependent. For converting human‐readable text to a--- 'F.FilePath', use 'fromText'.------ Since: 0.3.1-decodeString :: String -> F.FilePath-decodeString = R.decodeString currentOS
− src/Filesystem/Path/Internal.hs
@@ -1,156 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}---- |--- Module: Filesystem.Path.Internal--- Copyright: 2010 John Millikin--- License: MIT------ Maintainer: jmillikin@gmail.com--- Portability: portable----module Filesystem.Path.Internal where--import Prelude hiding (FilePath)--import qualified Data.ByteString.Char8 as B8-import Data.Data (Data)-import Data.List (intersperse)-import qualified Data.Text as T-import qualified Data.Text.Encoding as TE-import Data.Typeable (Typeable)------------------------------------------------------------------------------------ File Paths----------------------------------------------------------------------------------data Chunk = Chunk- { chunkText :: T.Text- , chunkGood :: Bool- }- deriving (Eq, Ord, Data, Typeable)--type Directory = Chunk-type Basename = Chunk-type Extension = Chunk--data Root- = RootPosix- | RootWindowsVolume Char- | RootWindowsCurrentVolume- deriving (Eq, Ord, Data, Typeable)--data FilePath = FilePath- { pathRoot :: Maybe Root- , pathDirectories :: [Directory]- , pathBasename :: Maybe Basename- , pathExtensions :: [Extension]- }- deriving (Eq, Ord, Data, Typeable)---- | A file path with no root, directory, or filename-empty :: FilePath-empty = FilePath Nothing [] Nothing []--dot :: Chunk-dot = Chunk (T.pack ".") True--dots :: Chunk-dots = Chunk (T.pack "..") True--filenameChunk :: Bool -> FilePath -> Chunk-filenameChunk strict p = Chunk (T.concat texts) allGood where- name = maybe (Chunk T.empty True) id (pathBasename p)- exts = case pathExtensions p of- [] -> []- exts' -> intersperse dot ((Chunk T.empty True):exts')- chunks = name:exts- - texts = map chunkText' chunks- allGood = and (map chunkGood chunks)- - chunkText' c = if chunkGood c- then if allGood || not strict- then chunkText c- else T.pack (B8.unpack (TE.encodeUtf8 (chunkText c)))- else chunkText c------------------------------------------------------------------------------------ Rules----------------------------------------------------------------------------------data Rules platformFormat = Rules- { rulesName :: T.Text- - -- | Check if a 'FilePath' is valid; it must not contain any illegal- -- characters, and must have a root appropriate to the current- -- 'Rules'.- , valid :: FilePath -> Bool- - -- | Split a search path, such as @$PATH@ or @$PYTHONPATH@, into- -- a list of 'FilePath's.- , splitSearchPath :: platformFormat -> [FilePath]- - -- | Attempt to convert a 'FilePath' to human‐readable text.- --- -- If the path is decoded successfully, the result is a 'Right'- -- containing the decoded text. Successfully decoded text can be- -- converted back to the original path using 'fromText'.- --- -- If the path cannot be decoded, the result is a 'Left' containing an- -- approximation of the original path. If displayed to the user, this- -- value should be accompanied by some warning that the path has an- -- invalid encoding. Approximated text cannot be converted back to the- -- original path.- --- -- This function ignores the user’s locale, and assumes all- -- file paths are encoded in UTF8. If you need to display file paths- -- with an unusual or obscure encoding, use 'encode' and then decode- -- them manually.- --- -- Since: 0.2- , toText :: FilePath -> Either T.Text T.Text- - -- | Convert human‐readable text into a 'FilePath'.- --- -- This function ignores the user’s locale, and assumes all- -- file paths are encoded in UTF8. If you need to create file paths- -- with an unusual or obscure encoding, encode them manually and then- -- use 'decode'.- --- -- Since: 0.2- , fromText :: T.Text -> FilePath- - -- | Convert a 'FilePath' to a platform‐specific format,- -- suitable for use with external OS functions.- --- -- Since: 0.3- , encode :: FilePath -> platformFormat- - -- | Convert a 'FilePath' from a platform‐specific format,- -- suitable for use with external OS functions.- --- -- Since: 0.3- , decode :: platformFormat -> FilePath- - -- | Attempt to convert a 'FilePath' to a string suitable for use with- -- functions in @System.IO@. The contents of this string are- -- platform‐dependent, and are not guaranteed to be- -- human‐readable. For converting 'FilePath's to a- -- human‐readable format, use 'toText'.- --- -- Since: 0.3.1- , encodeString :: FilePath -> String- - -- | Attempt to parse a 'FilePath' from a string suitable for use- -- with functions in @System.IO@. Do not use this function for parsing- -- human‐readable paths, as the character set decoding is- -- platform‐dependent. For converting human‐readable- -- text to a 'FilePath', use 'fromText'.- --- -- Since: 0.3.1- , decodeString :: String -> FilePath- }--instance Show (Rules a) where- showsPrec d r = showParen (d > 10)- (showString "Rules " . shows (rulesName r))
− src/Filesystem/Path/Rules.hs
@@ -1,232 +0,0 @@--- |--- Module: Filesystem.Path.Rules--- Copyright: 2010 John Millikin--- License: MIT------ Maintainer: jmillikin@gmail.com--- Portability: portable----module Filesystem.Path.Rules- ( Rules- , posix- , windows- - -- * Type conversions- , toText- , fromText- , encode- , decode- , encodeString- , decodeString- - -- * Rule‐specific path properties- , valid- , splitSearchPath- ) where--import Prelude hiding (FilePath, null)-import qualified Prelude as P--import qualified Control.Exception as Exc-import qualified Data.ByteString as B-import qualified Data.ByteString.Char8 as B8-import Data.Char (toUpper, chr)-import Data.List (intersperse)-import qualified Data.Text as T-import qualified Data.Text.Encoding as TE-import Data.Text.Encoding.Error (UnicodeException)-import System.IO ()-import System.IO.Unsafe (unsafePerformIO)--import Filesystem.Path hiding (root, filename, basename)-import Filesystem.Path.Internal------------------------------------------------------------------------------------ Generic----------------------------------------------------------------------------------rootText :: Maybe Root -> T.Text-rootText r = T.pack $ flip (maybe "") r $ \r' -> case r' of- RootPosix -> "/"- RootWindowsVolume c -> c : ":\\"- RootWindowsCurrentVolume -> "\\"--directoryChunks :: Bool -> FilePath -> [Chunk]-directoryChunks strict path = pathDirectories path ++ [filenameChunk strict path]--maybeDecodeUtf8 :: B.ByteString -> Maybe T.Text-maybeDecodeUtf8 = excToMaybe . TE.decodeUtf8 where- excToMaybe :: a -> Maybe a- excToMaybe x = unsafePerformIO $ Exc.catch- (fmap Just (Exc.evaluate x))- unicodeError- - unicodeError :: UnicodeException -> IO (Maybe a)- unicodeError _ = return Nothing------------------------------------------------------------------------------------ POSIX------------------------------------------------------------------------------------ | Linux, BSD, OS X, and other UNIX or UNIX-like operating systems.-posix :: Rules B.ByteString-posix = Rules- { rulesName = T.pack "POSIX"- , valid = posixValid- , splitSearchPath = posixSplitSearch- , toText = posixToText- , fromText = posixFromText- , encode = posixToBytes- , decode = posixFromBytes- , encodeString = B8.unpack . posixToBytes- , decodeString = posixFromBytes . B8.pack- }--posixToText :: FilePath -> Either T.Text T.Text-posixToText p = if good then Right text else Left text where- good = and (map chunkGood chunks)- text = T.concat (root : map chunkText chunks)- - root = rootText (pathRoot p)- chunks = intersperse (Chunk (T.pack "/") True) (directoryChunks False p)--posixFromChunks :: [Chunk] -> FilePath-posixFromChunks chunks = FilePath root directories basename exts where- (root, pastRoot) = if T.null (chunkText (head chunks))- then (Just RootPosix, tail chunks)- else (Nothing, chunks)- - (directories, filename)- | P.null pastRoot = ([], Chunk T.empty True)- | otherwise = case last pastRoot of- fn | fn == dot -> (goodDirs pastRoot, Chunk T.empty True)- fn | fn == dots -> (goodDirs pastRoot, Chunk T.empty True)- fn -> (goodDirs (init pastRoot), fn)- - goodDirs = filter (not . T.null . chunkText)- - (basename, exts) = if T.null (chunkText filename)- then (Nothing, [])- else case T.split (== '.') (chunkText filename) of- [] -> (Nothing, [])- (name':exts') -> if chunkGood filename- then (Just (Chunk name' True), map (\e -> Chunk e True) exts')- else (Just (checkChunk name'), map checkChunk exts')- - checkChunk raw = case maybeDecodeUtf8 (B8.pack (T.unpack raw)) of- Just text -> Chunk text True- Nothing -> Chunk raw False--posixFromText :: T.Text -> FilePath-posixFromText text = if T.null text- then empty- else posixFromChunks (map (\t -> Chunk t True) (T.split (== '/') text))--posixToBytes :: FilePath -> B.ByteString-posixToBytes p = B.concat (root : chunks) where- root = TE.encodeUtf8 (rootText (pathRoot p))- chunks = intersperse (B8.pack "/") (map chunkBytes (directoryChunks True p))- chunkBytes c = if chunkGood c- then TE.encodeUtf8 (chunkText c)- else B8.pack (T.unpack (chunkText c))--posixFromBytes :: B.ByteString -> FilePath-posixFromBytes bytes = if B.null bytes- then empty- else posixFromChunks $ flip map (B.split 0x2F bytes) $ \b -> case maybeDecodeUtf8 b of- Just text -> Chunk text True- Nothing -> Chunk (T.pack (B8.unpack b)) False--posixValid :: FilePath -> Bool-posixValid p = validRoot && validDirectories where- validDirectories = all validChunk (directoryChunks True p)- validChunk ch = not (T.any (\c -> c == '\0' || c == '/') (chunkText ch))- validRoot = case pathRoot p of- Nothing -> True- Just RootPosix -> True- _ -> False--posixSplitSearch :: B.ByteString -> [FilePath]-posixSplitSearch = map (posixFromBytes . normSearch) . B.split 0x3A where- normSearch bytes = if B.null bytes then B8.pack "." else bytes------------------------------------------------------------------------------------ Windows------------------------------------------------------------------------------------ | Windows and DOS-windows :: Rules T.Text-windows = Rules- { rulesName = T.pack "Windows"- , valid = winValid- , splitSearchPath = winSplit- , toText = Right . winToText- , fromText = winFromText- , encode = winToText- , decode = winFromText- , encodeString = T.unpack . winToText- , decodeString = winFromText . T.pack- }--winToText :: FilePath -> T.Text-winToText p = T.concat (root : chunks) where- root = rootText (pathRoot p)- chunks = intersperse (T.pack "\\") (map chunkText (directoryChunks False p))--winFromText :: T.Text -> FilePath-winFromText text = if T.null text then empty else path where- path = FilePath root directories basename exts- - split = T.split (\c -> c == '/' || c == '\\') text- - (root, pastRoot) = let- head' = head split- tail' = tail split- in if T.null head'- then (Just RootWindowsCurrentVolume, tail')- else if T.any (== ':') head'- then (Just (parseDrive head'), tail')- else (Nothing, split)- - parseDrive = RootWindowsVolume . toUpper . T.head- - (directories, filename)- | P.null pastRoot = ([], T.empty)- | otherwise = case last pastRoot of- fn | fn == chunkText dot -> (goodDirs pastRoot, T.empty)- fn | fn == chunkText dots -> (goodDirs pastRoot, T.empty)- fn -> (goodDirs (init pastRoot), fn)- - goodDirs = map (\t -> Chunk t True) . filter (not . T.null)- - (basename, exts) = if T.null filename- then (Nothing, [])- else case T.split (== '.') filename of- [] -> (Nothing, [])- (name':exts') -> (Just (Chunk name' True), map (\e -> Chunk e True) exts')--winValid :: FilePath -> Bool-winValid p = validRoot && noReserved && validCharacters where- reservedChars = map chr [0..0x1F] ++ "/\\?*:|\"<>"- reservedNames = map T.pack- [ "AUX", "CLOCK$", "COM1", "COM2", "COM3", "COM4"- , "COM5", "COM6", "COM7", "COM8", "COM9", "CON"- , "LPT1", "LPT2", "LPT3", "LPT4", "LPT5", "LPT6"- , "LPT7", "LPT8", "LPT9", "NUL", "PRN"- ]- - validRoot = case pathRoot p of- Nothing -> True- Just RootWindowsCurrentVolume -> True- Just (RootWindowsVolume v) -> elem v ['A'..'Z']- _ -> False- - noExt = p { pathExtensions = [] }- noReserved = flip all (directoryChunks False noExt)- $ \fn -> notElem (T.toUpper (chunkText fn)) reservedNames- - validCharacters = flip all (directoryChunks False p)- $ not . T.any (`elem` reservedChars) . chunkText--winSplit :: T.Text -> [FilePath]-winSplit = map winFromText . filter (not . T.null) . T.split (== ';')
system-filepath.cabal view
@@ -1,5 +1,5 @@ name: system-filepath-version: 0.4.1+version: 0.4.2 synopsis: High-level, byte-based file and directory path manipulations license: MIT license-file: license.txt@@ -13,6 +13,10 @@ homepage: https://john-millikin.com/software/hs-filepath/ bug-reports: mailto:jmillikin@gmail.com +extra-source-files:+ tests/system-filepath-tests.cabal+ tests/Tests.hs+ source-repository head type: bzr location: https://john-millikin.com/software/hs-filepath/@@ -20,11 +24,11 @@ source-repository this type: bzr location: https://john-millikin.com/branches/hs-filepath/0.4/- tag: system-filepath_0.4.1+ tag: system-filepath_0.4.2 library ghc-options: -Wall -O2- hs-source-dirs: src+ hs-source-dirs: lib build-depends: base >= 3 && < 5
+ tests/Tests.hs view
@@ -0,0 +1,486 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE OverloadedStrings #-}++module Main (tests, main) where++import Prelude hiding (FilePath)++import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as B8+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+ + , 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_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", "\xDD\xAA"]++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.\xDD\xAA/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_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_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\xA1\xA2"+ $expect $ equal (enc (fromChar8 "\xC2\xA1\xC2\xA2/test\xA1\xA2")) "\xA1\xA2/test\xA1\xA2"+ $expect $ equal (enc (fromText posix_ghc702 "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_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")++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")++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 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 view
@@ -0,0 +1,24 @@+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+ , QuickCheck+ , text