packages feed

system-filepath 0.4.4 → 0.4.5

raw patch · 5 files changed

+75/−31 lines, 5 files

Files

lib/Filesystem/Path.hs view
@@ -112,7 +112,7 @@ -- | Retrieve a 'FilePath'’s filename component. -- -- @--- filename \"foo/bar.txt\" == \"bar.txt\"+-- filename \"foo\/bar.txt\" == \"bar.txt\" -- @ filename :: FilePath -> FilePath filename p = empty@@ -124,7 +124,7 @@ -- /file name/ of the directory, not its full path. -- -- @--- dirname \"foo/bar/baz.txt\" == \"bar\"+-- dirname \"foo\/bar\/baz.txt\" == \"bar\" -- dirname \"/\" == \"\" -- @ --
lib/Filesystem/Path/Internal.hs view
@@ -173,19 +173,27 @@ #endif  unescape :: T.Text -> (T.Text, Bool)-unescape t = if T.any (\c -> ord c >= 0xEF00 && ord c <= 0xEFFF) t-	then (T.map (\c -> if ord c >= 0xEF00 && ord c <= 0xEFFF-		then chr (ord c - 0xEF00)-		else c) t, False)-	else (t, True)+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 (map (\c -> if ord c >= 0xEF00 && ord c <= 0xEFFF-	then B8.singleton (chr (ord c - 0xEF00))-	else TE.encodeUtf8 (T.singleton c)) (T.unpack t))+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 filename = parsed where@@ -193,15 +201,7 @@ 		then (Nothing, []) 		else case textSplitBy (== '.') filename of 			[] -> (Nothing, [])-			(name':exts') -> (Just (checkChunk name'), map checkChunk exts')-	-	checkChunk t = if chunkGood t-		then t-		else case maybeDecodeUtf8 (unescapeBytes' t) of-			Just text -> text-			Nothing -> t-	-	chunkGood t = not (T.any (\c -> ord c >= 0xEF00 && ord c <= 0xEFFF) t)+			(name':exts') -> (Just name', exts')  maybeDecodeUtf8 :: B.ByteString -> Maybe T.Text maybeDecodeUtf8 = excToMaybe . TE.decodeUtf8 where
lib/Filesystem/Path/Rules.hs view
@@ -77,7 +77,7 @@ -- This is a variant of 'posix' for use with GHC 7.2 or later, which tries to -- decode file paths in its IO computations. ----- Since: 0.3.3+-- Since: 0.4.2 posix_ghc702 :: Rules B.ByteString posix_ghc702 = posix 	{ rulesName = T.pack "POSIX (GHC 7.2)"@@ -119,7 +119,7 @@ posixToBytes p = B.concat (root : chunks) where 	root = TE.encodeUtf8 (rootText (pathRoot p)) 	chunks = intersperse (B8.pack "/") (map chunkBytes (directoryChunks p))-	chunkBytes t = if T.any (\c -> ord c >= 0xEF00 && ord c <= 0xEFFF) t+	chunkBytes t = if T.any (== '\xEF00') t 		then unescapeBytes' t 		else TE.encodeUtf8 t @@ -128,18 +128,43 @@ 	then empty 	else posixFromChunks $ flip map (B.split 0x2F bytes) $ \b -> case maybeDecodeUtf8 b of 		Just text -> text-		Nothing -> T.pack (map (\c -> if ord c >= 0x80-			then chr (ord c + 0xEF00)-			else c) (B8.unpack b))+		Nothing -> processInvalidUtf8 b +processInvalidUtf8 :: B.ByteString -> T.Text+processInvalidUtf8 bytes = T.intercalate (T.pack ".") 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))+ posixToGhcString :: FilePath -> String posixToGhcString p = P.concat (root : chunks) where 	root = T.unpack (rootText (pathRoot p))-	chunks = intersperse "/" (map T.unpack (directoryChunks p))+	chunks = intersperse "/" (map escapeToGhc (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)+ posixFromGhcString :: String -> FilePath-posixFromGhcString = posixFromText . T.pack+posixFromGhcString = posixFromText . T.pack . escapeFromGhc +escapeFromGhc :: String -> String+escapeFromGhc = concatMap step where+	step c = if ord c >= 0xEF00 && ord c <= 0xEFFF+		then ['\xEF00', chr (ord c - 0xEF00)]+		else [c]+ posixValid :: FilePath -> Bool posixValid p = validRoot && validDirectories where 	validDirectories = all validChunk (directoryChunks p)@@ -162,7 +187,7 @@ -- This is almost identical to 'posix', but with a native path type of 'T.Text' -- rather than 'B.ByteString'. ----- Since: 0.3.4+-- Since: 0.4.3 darwin :: Rules T.Text darwin = Rules 	{ rulesName = T.pack "Darwin"@@ -181,7 +206,7 @@ -- 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+-- Since: 0.4.3 darwin_ghc702 :: Rules T.Text darwin_ghc702 = darwin 	{ rulesName = T.pack "Darwin (GHC 7.2)"
system-filepath.cabal view
@@ -1,5 +1,5 @@ name: system-filepath-version: 0.4.4+version: 0.4.5 synopsis: High-level, byte-based file and directory path manipulations license: MIT license-file: license.txt@@ -29,7 +29,7 @@ source-repository this   type: bzr   location: https://john-millikin.com/branches/system-filepath/0.4/-  tag: system-filepath_0.4.4+  tag: system-filepath_0.4.5  library   ghc-options: -Wall -O2
tests/Tests.hs view
@@ -42,6 +42,8 @@ 	, property "stripPrefix" prop_StripPrefix 	, test_SplitExtension 	, test_Collapse+	, test_InvalidUtf8InDirectoryComponent+	, test_Utf8CharInGhcEscapeArea 	 	, suite "to-from-bytes" 		[ test_Identity "posix" posix posixPaths@@ -321,6 +323,24 @@ 	$expect $ equal (collapse "parent/foo/baz/../../bar") "parent/bar" 	$expect $ equal (collapse "parent/foo/..") "parent/" +test_InvalidUtf8InDirectoryComponent :: Suite+test_InvalidUtf8InDirectoryComponent = assertions "invalid-utf8-in-directory-component" $ do+	$expect $ equal (toText posix (fromChar8 "/\218\130.\137\141")) (Left (T.pack "/\1666.\137\141"))+	$expect $ equal (encode posix (fromChar8 "/\218\130.\137\141")) (B8.pack "/\218\130.\137\141")+	+	$expect $ equal (toText posix (fromChar8 "/\218\130.\137\141/")) (Left (T.pack "/\1666.\137\141/"))+	$expect $ equal (encode posix (fromChar8 "/\218\130.\137\141/")) (B8.pack "/\218\130.\137\141/")+	+	$expect $ equal (toText posix (fromChar8 "/\218\130.\137\141//baz")) (Left (T.pack "/\1666.\137\141/baz"))+	$expect $ equal (encode posix (fromChar8 "/\218\130.\137\141//baz")) (B8.pack "/\218\130.\137\141/baz")++test_Utf8CharInGhcEscapeArea :: Suite+test_Utf8CharInGhcEscapeArea = assertions "utf8-char-in-ghc-escape-area" $ do+	let chars = "/a/\238\189\178/b"+	let path = fromChar8 chars+	$expect (equal (toChar8 path) chars)+	$expect (equal (toText posix path) (Right (T.pack "/a/\61298/b")))+ test_Parsing :: Suite test_Parsing = assertions "parsing" $ do 	let p x = toChar8 (fromChar8 x)@@ -437,7 +457,6 @@ 	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")-	$expect $ equal (dec r "test\xEFA1\xEFA2") (fromChar8 "test\xA1\xA2")  test_DecodeString_Win32 :: Suite test_DecodeString_Win32 = assertions "windows" $ do