system-filepath-0.4.7/0000755000000000000000000000000012021547246013031 5ustar0000000000000000system-filepath-0.4.7/Setup.hs0000644000000000000000000000005612021547246014466 0ustar0000000000000000import Distribution.Simple main = defaultMain system-filepath-0.4.7/system-filepath.cabal0000644000000000000000000000242512021547246017136 0ustar0000000000000000name: system-filepath version: 0.4.7 synopsis: High-level, byte-based file and directory path manipulations license: MIT license-file: license.txt author: John Millikin maintainer: John Millikin copyright: John Millikin 2010-2012 build-type: Simple cabal-version: >= 1.6 category: System stability: experimental homepage: https://john-millikin.com/software/haskell-filesystem/ 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 source-repository head type: bzr location: https://john-millikin.com/branches/system-filepath/0.4/ source-repository this type: bzr location: https://john-millikin.com/branches/system-filepath/0.4/ tag: system-filepath_0.4.7 library ghc-options: -Wall -O2 hs-source-dirs: lib build-depends: base >= 4.0 && < 5.0 , bytestring >= 0.9 , deepseq >= 1.1 && < 1.4 , text >= 0.7.1 && < 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 other-modules: Filesystem.Path.Internal system-filepath-0.4.7/license.txt0000644000000000000000000000204112021547246015211 0ustar0000000000000000Copyright (c) 2010 John Millikin Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. system-filepath-0.4.7/lib/0000755000000000000000000000000012021547246013577 5ustar0000000000000000system-filepath-0.4.7/lib/Filesystem/0000755000000000000000000000000012021547246015723 5ustar0000000000000000system-filepath-0.4.7/lib/Filesystem/Path.hs0000644000000000000000000002357212021547246017164 0ustar0000000000000000{-# 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 , splitDirectories -- * 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:_) -> 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.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) splitDirectories :: FilePath -> [FilePath] splitDirectories p = rootName ++ dirNames ++ fileName where rootName = case pathRoot p of Nothing -> [] r -> [asFile (rootChunk r)] dirNames = map asFile (pathDirectories p) fileName = case (pathBasename p, pathExtensions p) of (Nothing, []) -> [] _ -> [filename p] asFile :: Chunk -> FilePath asFile c = case parseFilename c of (base, exts) -> empty { pathBasename = base , pathExtensions = exts } ------------------------------------------------------------------------------- -- 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 system-filepath-0.4.7/lib/Filesystem/Path/0000755000000000000000000000000012021547246016617 5ustar0000000000000000system-filepath-0.4.7/lib/Filesystem/Path/Internal.hs0000644000000000000000000001563512021547246020741 0ustar0000000000000000{-# 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') 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] ------------------------------------------------------------------------------- -- 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 system-filepath-0.4.7/lib/Filesystem/Path/CurrentOS.hs0000644000000000000000000001071612021547246021044 0ustar0000000000000000{-# 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 system-filepath-0.4.7/lib/Filesystem/Path/Rules.hs0000644000000000000000000002255612021547246020257 0ustar0000000000000000-- | -- 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 ------------------------------------------------------------------------------- -- 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 / 0.4.2 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 / 0.4.6 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 / 0.4.3 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 / 0.4.3 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 (== ';') system-filepath-0.4.7/tests/0000755000000000000000000000000012021547246014173 5ustar0000000000000000system-filepath-0.4.7/tests/Tests.hs0000644000000000000000000005156212021547246015642 0ustar0000000000000000{-# 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 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 = 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_SplitDirectories test_InvalidUtf8InDirectoryComponent test_Utf8CharInGhcEscapeArea (suite "to-from-bytes" (test_Identity "posix" posix posixPaths) (test_Identity "windows" windows windowsPaths) test_MixedValidityToBytes :: Suite) (suite "to-from-text" test_ToText test_FromText :: Suite) (suite "validity" (property "posix" (forAll posixPaths (valid posix))) (property "windows" (forAll windowsPaths (valid windows))) :: Suite) test_SplitSearchPath test_Parsing test_EncodeString test_DecodeString test_EqualsIgnoresPosixEncoding test_ShowRules test_Empty :: Test test_Empty = assertions "empty" $ do $expect $ P.null empty $expect $ equal (toChar8 empty) "" $expect $ equal (toString empty) "" test_Root :: Test 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 :: Test 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 :: Test 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 :: Test 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 :: Test 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 :: Test 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 :: Test 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 :: Test 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 :: String -> Rules a -> Gen FilePath -> Test test_Identity name r gen = property name $ forAll gen $ \p -> p == decode r (encode r p) test_MixedValidityToBytes :: Test 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 :: Test 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 :: Test 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 :: Test 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 :: Test 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 :: Test 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 :: Test 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 :: Test 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_SplitDirectories :: Test test_SplitDirectories = assertions "splitDirectories" $ do let splitDirectories x = map toChar8 (P.splitDirectories (fromChar8 x)) $expect $ equal (splitDirectories "") [] $expect $ equal (splitDirectories "/") ["/"] $expect $ equal (splitDirectories "/a") ["/", "a"] $expect $ equal (splitDirectories "/ab/cd") ["/", "ab", "cd"] $expect $ equal (splitDirectories "/ab/cd/") ["/", "ab", "cd"] $expect $ equal (splitDirectories "ab/cd") ["ab", "cd"] $expect $ equal (splitDirectories "ab/cd/") ["ab", "cd"] $expect $ equal (splitDirectories "ab/cd.txt") ["ab", "cd.txt"] $expect $ equal (splitDirectories "ab/cd/.txt") ["ab", "cd", ".txt"] $expect $ equal (splitDirectories "ab/./cd") ["ab", ".", "cd"] test_InvalidUtf8InDirectoryComponent :: Test 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 :: Test 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 :: Test 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 :: Test 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 :: Test 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 :: Test 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 :: Test 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 :: Test 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 :: Test 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 :: Test 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 :: Test 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 :: Test 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 :: Test 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 :: Test 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 :: Test test_EqualsIgnoresPosixEncoding = assertions "equals-ignores-posix-encoding" $ do $expect $ equal (fromChar8 "test\xA1\xA2") (fromText posix "test\xA1\xA2") test_ShowRules :: Test 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 system-filepath-0.4.7/tests/system-filepath-tests.cabal0000644000000000000000000000107312021547246021436 0ustar0000000000000000name: 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,. -- http://hackage.haskell.org/trac/ghc/ticket/5395 if impl(ghc < 7.2) ghc-options: -fcontext-stack=200 if flag(coverage) ghc-options: -fhpc build-depends: base > 4.0 && < 5.0 , bytestring , chell >= 0.3 && < 0.4 , chell-quickcheck >= 0.2 && < 0.3 , deepseq >= 1.1 && < 1.4 , QuickCheck , text system-filepath-0.4.7/scripts/0000755000000000000000000000000012021547246014520 5ustar0000000000000000system-filepath-0.4.7/scripts/common.bash0000644000000000000000000000067512021547246016657 0ustar0000000000000000PATH="$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 } system-filepath-0.4.7/scripts/run-coverage0000755000000000000000000000114112021547246017040 0ustar0000000000000000#!/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 system-filepath-0.4.7/scripts/run-benchmarks0000755000000000000000000000066712021547246017376 0ustar0000000000000000#!/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 $@ system-filepath-0.4.7/scripts/run-tests0000755000000000000000000000056312021547246016416 0ustar0000000000000000#!/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 $@