system-filepath 0.3.6 → 0.3.7
raw patch · 6 files changed
+160/−103 lines, 6 files
Files
- lib/Filesystem/Path.hs +3/−2
- lib/Filesystem/Path/CurrentOS.hs +3/−1
- lib/Filesystem/Path/Internal.hs +42/−38
- lib/Filesystem/Path/Rules.hs +82/−59
- system-filepath.cabal +3/−3
- tests/Tests.hs +27/−0
lib/Filesystem/Path.hs view
@@ -180,7 +180,7 @@ directories = xDirectories ++ pathDirectories y xDirectories = (pathDirectories x ++) $ if null (filename x) then []- else [filenameText x]+ else [filenameChunk x] -- | An alias for 'append'. (</>) :: FilePath -> FilePath -> FilePath@@ -284,6 +284,7 @@ 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@@ -295,7 +296,7 @@ -- | Append many extensions to the end of a 'FilePath'. addExtensions :: FilePath -> [T.Text] -> FilePath addExtensions p exts = p { pathExtensions = newExtensions } where- newExtensions = pathExtensions p ++ exts+ newExtensions = pathExtensions p ++ map escape exts -- | An alias for 'addExtension'. (<.>) :: FilePath -> T.Text -> FilePath
lib/Filesystem/Path/CurrentOS.hs view
@@ -57,7 +57,9 @@ currentOS = R.darwin #endif #else-#if __GLASGOW_HASKELL__ >= 702+#if __GLASGOW_HASKELL__ >= 704+currentOS = R.posix_ghc704+#elif __GLASGOW_HASKELL__ >= 702 currentOS = R.posix_ghc702 #else currentOS = R.posix
lib/Filesystem/Path/Internal.hs view
@@ -31,9 +31,10 @@ -- File Paths ------------------------------------------------------------------------------- -type Directory = T.Text-type Basename = T.Text-type Extension = T.Text+type Chunk = String+type Directory = Chunk+type Basename = Chunk+type Extension = Chunk data Root = RootPosix@@ -71,18 +72,18 @@ empty :: FilePath empty = FilePath Nothing [] Nothing [] -dot :: T.Text-dot = T.pack "."+dot :: Chunk+dot = "." -dots :: T.Text-dots = T.pack ".."+dots :: Chunk+dots = ".." -filenameText :: FilePath -> T.Text-filenameText p = T.concat (name:exts) where- name = maybe T.empty id (pathBasename p)+filenameChunk :: FilePath -> Chunk+filenameChunk p = concat (name:exts) where+ name = maybe "" id (pathBasename p) exts = case pathExtensions p of [] -> []- exts' -> intersperse dot (T.empty:exts')+ exts' -> intersperse dot ("":exts') ------------------------------------------------------------------------------- -- Rules@@ -165,6 +166,33 @@ 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@@ -172,34 +200,11 @@ textSplitBy = T.splitBy #endif -unescape :: T.Text -> (T.Text, Bool)-unescape t = if anyEscaped then (impl, False) else (t, True) where- anyEscaped = T.any (== '\xEF00') t- impl = T.pack (reverse (snd folded))- folded = T.foldl' step (False, []) t- step (prevEsc, acc) c = if prevEsc- then (False, c:acc)- else if c == '\xEF00'- then (True, acc)- else (False, c:acc)--unescape' :: T.Text -> T.Text-unescape' = fst . unescape--unescapeBytes' :: T.Text -> B8.ByteString-unescapeBytes' t = B8.concat (reverse (snd folded)) where- folded = T.foldl' step (False, []) t- step (prevEsc, acc) c = if prevEsc- then (False, B8.singleton (chr (ord c)) : acc)- else if c == '\xEF00'- then (True, acc)- else (False, TE.encodeUtf8 (T.singleton c) : acc)--parseFilename :: T.Text -> (Maybe Basename, [Extension])+parseFilename :: Chunk -> (Maybe Basename, [Extension]) parseFilename filename = parsed where- parsed = if T.null filename+ parsed = if null filename then (Nothing, [])- else case textSplitBy (== '.') filename of+ else case splitBy (== '.') filename of [] -> (Nothing, []) (name':exts') -> (Just name', exts') @@ -212,4 +217,3 @@ unicodeError :: UnicodeException -> IO (Maybe a) unicodeError _ = return Nothing-
lib/Filesystem/Path/Rules.hs view
@@ -10,6 +10,7 @@ ( Rules , posix , posix_ghc702+ , posix_ghc704 , windows , darwin , darwin_ghc702@@ -33,7 +34,7 @@ import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as B8 import Data.Char (toUpper, chr, ord)-import Data.List (intersperse)+import Data.List (intersperse, intercalate) import qualified Data.Text as T import qualified Data.Text.Encoding as TE import System.IO ()@@ -45,15 +46,18 @@ -- Generic ------------------------------------------------------------------------------- -rootText :: Maybe Root -> T.Text-rootText r = T.pack $ flip (maybe "") r $ \r' -> case r' of+rootChunk :: Maybe Root -> Chunk+rootChunk r = flip (maybe "") r $ \r' -> case r' of RootPosix -> "/" RootWindowsVolume c -> c : ":\\" RootWindowsCurrentVolume -> "\\" -directoryChunks :: FilePath -> [T.Text]-directoryChunks path = pathDirectories path ++ [filenameText path]+rootText :: Maybe Root -> T.Text+rootText = T.pack . rootChunk +directoryChunks :: FilePath -> [Chunk]+directoryChunks path = pathDirectories path ++ [filenameChunk path]+ ------------------------------------------------------------------------------- -- POSIX -------------------------------------------------------------------------------@@ -74,17 +78,30 @@ -- | Linux, BSD, and other UNIX or UNIX-like operating systems. ----- This is a variant of 'posix' for use with GHC 7.2 or later, which tries to--- decode file paths in its IO computations.+-- This is a variant of 'posix' for use with GHC 7.2, which tries to decode+-- file paths in its IO computations. -- -- Since: 0.3.3 posix_ghc702 :: Rules B.ByteString posix_ghc702 = posix { rulesName = T.pack "POSIX (GHC 7.2)"- , encodeString = posixToGhcString- , decodeString = posixFromGhcString+ , encodeString = posixToGhc702String+ , decodeString = posixFromGhc702String } +-- | Linux, BSD, and other UNIX or UNIX-like operating systems.+--+-- This is a variant of 'posix' for use with GHC 7.4 or later, which tries to+-- decode file paths in its IO computations.+--+-- Since: 0.3.7+posix_ghc704 :: Rules B.ByteString+posix_ghc704 = posix+ { rulesName = T.pack "POSIX (GHC 7.4)"+ , encodeString = posixToGhc704String+ , decodeString = posixFromGhc704String+ }+ posixToText :: FilePath -> Either T.Text T.Text posixToText p = if good then Right text else Left text where good = and (map snd chunks)@@ -93,82 +110,87 @@ root = rootText (pathRoot p) chunks = intersperse (T.pack "/", True) (map unescape (directoryChunks p)) -posixFromChunks :: [T.Text] -> FilePath+posixFromChunks :: [Chunk] -> FilePath posixFromChunks chunks = FilePath root directories basename exts where- (root, pastRoot) = if T.null (head chunks)+ (root, pastRoot) = if P.null (head chunks) then (Just RootPosix, tail chunks) else (Nothing, chunks) (directories, filename)- | P.null pastRoot = ([], T.empty)+ | P.null pastRoot = ([], "") | otherwise = case last pastRoot of- fn | fn == dot -> (goodDirs pastRoot, T.empty)- fn | fn == dots -> (goodDirs pastRoot, T.empty)+ fn | fn == dot -> (goodDirs pastRoot, "")+ fn | fn == dots -> (goodDirs pastRoot, "") fn -> (goodDirs (init pastRoot), fn) - goodDirs = filter (not . T.null)+ goodDirs = filter (not . P.null) (basename, exts) = parseFilename filename posixFromText :: T.Text -> FilePath posixFromText text = if T.null text then empty- else posixFromChunks (textSplitBy (== '/') text)+ else posixFromChunks (map escape (textSplitBy (== '/') text)) posixToBytes :: FilePath -> B.ByteString posixToBytes p = B.concat (root : chunks) where- root = TE.encodeUtf8 (rootText (pathRoot p))+ root = B8.pack (rootChunk (pathRoot p)) chunks = intersperse (B8.pack "/") (map chunkBytes (directoryChunks p))- chunkBytes t = if T.any (== '\xEF00') t- then unescapeBytes' t- else TE.encodeUtf8 t+ 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 -> text+ Just text -> escape text Nothing -> processInvalidUtf8 b -processInvalidUtf8 :: B.ByteString -> T.Text-processInvalidUtf8 bytes = T.intercalate (T.pack ".") textChunks where+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 -> t- Nothing -> T.pack (concatMap (\c -> if ord c >= 0x80- then ['\xEF00', c]- else [c]) (B8.unpack b))+ Just t -> escape t+ Nothing -> map (\c -> if ord c >= 0x80+ then chr (ord c + 0xDC00)+ else c) (B8.unpack b) -posixToGhcString :: FilePath -> String-posixToGhcString p = P.concat (root : chunks) where- root = T.unpack (rootText (pathRoot p))- chunks = intersperse "/" (map escapeToGhc (directoryChunks p))+posixToGhc702String :: FilePath -> String+posixToGhc702String p = P.concat (root : chunks) where+ root = rootChunk (pathRoot p)+ chunks = intersperse "/" (map escapeToGhc702 (directoryChunks p)) -escapeToGhc :: T.Text -> String-escapeToGhc t = if anyEscaped then impl else T.unpack t where- anyEscaped = T.any (== '\xEF00') t- impl = reverse (snd folded)- folded = T.foldl' step (False, []) t- step (prevEsc, acc) c = if prevEsc- then (False, (chr (ord c + 0xEF00)):acc)- else if c == '\xEF00'- then (True, acc)- else (False, c:acc)+escapeToGhc702 :: Chunk -> String+escapeToGhc702 = map (\c -> if ord c >= 0xDC80 && ord c <= 0xDCFF+ then chr (ord c - 0xDC00 + 0xEF00)+ else c) -posixFromGhcString :: String -> FilePath-posixFromGhcString = posixFromText . T.pack . escapeFromGhc+posixFromGhc702String :: String -> FilePath+posixFromGhc702String cs = if P.null cs+ then empty+ else posixFromChunks (map escapeFromGhc702 (splitBy (== '/') cs)) -escapeFromGhc :: String -> String-escapeFromGhc = concatMap step where- step c = if ord c >= 0xEF00 && ord c <= 0xEFFF- then ['\xEF00', chr (ord c - 0xEF00)]- else [c]+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 (T.any (\c -> c == '\0' || c == '/') ch)+ validChunk ch = not (any (\c -> c == '\0' || c == '/') ch) validRoot = case pathRoot p of Nothing -> True Just RootPosix -> True@@ -217,7 +239,7 @@ darwinToText :: FilePath -> T.Text darwinToText p = T.concat (root : chunks) where root = rootText (pathRoot p)- chunks = intersperse (T.pack "/") (directoryChunks p)+ chunks = intersperse (T.pack "/") (map unescape' (directoryChunks p)) darwinToString :: FilePath -> String darwinToString = B8.unpack . TE.encodeUtf8 . darwinToText@@ -250,7 +272,7 @@ winToText :: FilePath -> T.Text winToText p = T.concat (root : chunks) where root = rootText (pathRoot p)- chunks = intersperse (T.pack "\\") (directoryChunks p)+ chunks = intersperse (T.pack "\\") (map unescape' (directoryChunks p)) winFromText :: T.Text -> FilePath winFromText text = if T.null text then empty else path where@@ -270,20 +292,21 @@ parseDrive = RootWindowsVolume . toUpper . T.head (directories, filename)- | P.null pastRoot = ([], T.empty)+ | P.null pastRoot = ([], "") | otherwise = case last pastRoot of- fn | fn == dot -> (goodDirs pastRoot, T.empty)- fn | fn == dots -> (goodDirs pastRoot, T.empty)- fn -> (goodDirs (init pastRoot), fn)+ fn | fn == T.pack "." -> (goodDirs pastRoot, "")+ fn | fn == T.pack ".." -> (goodDirs pastRoot, "")+ fn -> (goodDirs (init pastRoot), escape fn) - goodDirs = filter (not . T.null)+ 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 = map T.pack+ reservedNames = [ "AUX", "CLOCK$", "COM1", "COM2", "COM3", "COM4" , "COM5", "COM6", "COM7", "COM8", "COM9", "CON" , "LPT1", "LPT2", "LPT3", "LPT4", "LPT5", "LPT6"@@ -298,10 +321,10 @@ noExt = p { pathExtensions = [] } noReserved = flip all (directoryChunks noExt)- $ \fn -> notElem (T.toUpper fn) reservedNames+ $ \fn -> notElem (map toUpper fn) reservedNames validCharacters = flip all (directoryChunks p)- $ not . T.any (`elem` reservedChars)+ $ not . any (`elem` reservedChars) winSplit :: T.Text -> [FilePath] winSplit = map winFromText . filter (not . T.null) . textSplitBy (== ';')
system-filepath.cabal view
@@ -1,11 +1,11 @@ name: system-filepath-version: 0.3.6+version: 0.3.7 synopsis: High-level, byte-based file and directory path manipulations license: MIT license-file: license.txt author: John Millikin <jmillikin@gmail.com> maintainer: John Millikin <jmillikin@gmail.com>-copyright: John Millikin 2010-2011+copyright: John Millikin 2010-2012 build-type: Simple cabal-version: >= 1.6 category: System@@ -29,7 +29,7 @@ source-repository this type: bzr location: https://john-millikin.com/branches/system-filepath/0.3/- tag: system-filepath_0.3.6+ tag: system-filepath_0.3.7 library ghc-options: -Wall -O2
tests/Tests.hs view
@@ -340,6 +340,11 @@ let path = fromChar8 chars $expect (equal (toChar8 path) chars) $expect (equal (toText posix path) (Right (T.pack "/a/\61298/b")))+ + let chars = "/a/\xEE\xBC\x80/b"+ let path = fromChar8 chars+ $expect (equal (toChar8 path) chars)+ $expect (equal (toText posix path) (Right (T.pack "/a/\61184/b"))) test_Parsing :: Suite test_Parsing = assertions "parsing" $ do@@ -389,6 +394,7 @@ test_EncodeString = suite "encodeString" [ test_EncodeString_Posix , test_EncodeString_Posix_Ghc702+ , test_EncodeString_Posix_Ghc704 , test_EncodeString_Win32 ] @@ -409,6 +415,14 @@ $expect $ equal (enc (fromChar8 "\xC2\xA1\xC2\xA2/test\xA1\xA2")) "\xA1\xA2/test\xEFA1\xEFA2" $expect $ equal (enc (fromText posix_ghc702 "test\xA1\xA2")) "test\xA1\xA2" +test_EncodeString_Posix_Ghc704 :: Suite+test_EncodeString_Posix_Ghc704 = assertions "posix_ghc704" $ do+ let enc = encodeString posix_ghc704+ $expect $ equal (enc (fromChar8 "test")) "test"+ $expect $ equal (enc (fromChar8 "test\xA1\xA2")) "test\xDCA1\xDCA2"+ $expect $ equal (enc (fromChar8 "\xC2\xA1\xC2\xA2/test\xA1\xA2")) "\xA1\xA2/test\xDCA1\xDCA2"+ $expect $ equal (enc (fromText posix_ghc704 "test\xA1\xA2")) "test\xA1\xA2"+ test_EncodeString_Win32 :: Suite test_EncodeString_Win32 = assertions "windows" $ do let enc = encodeString windows@@ -420,6 +434,7 @@ 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@@ -443,6 +458,18 @@ $expect $ equal (dec r "test\xEFA1\xEFA2") (fromChar8 "test\xA1\xA2") $expect $ equal (toText r (dec r "test\xEFA1\xEFA2"))+ (Left "test\xA1\xA2")++test_DecodeString_Posix_Ghc704 :: Suite+test_DecodeString_Posix_Ghc704 = assertions "posix_ghc704" $ do+ let r = posix_ghc704+ let dec = decodeString+ $expect $ equal (dec r "test") (fromText r "test")+ $expect $ equal (dec r "test\xC2\xA1\xC2\xA2") (fromText r "test\xC2\xA1\xC2\xA2")+ $expect $ equal (dec r "test\xA1\xA2") (fromText r "test\xA1\xA2")+ $expect $ equal (dec r "test\xDCA1\xDCA2") (fromChar8 "test\xA1\xA2")+ $expect $ equal+ (toText r (dec r "test\xDCA1\xDCA2")) (Left "test\xA1\xA2") test_DecodeString_Darwin :: Suite