packages feed

system-filepath 0.4.5 → 0.4.6

raw patch · 6 files changed

+163/−106 lines, 6 files

Files

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'&#x2019;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.4.2+-- Since: 0.3.3 / 0.4.2 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 / 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)@@ -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@@ -187,7 +209,7 @@ -- This is almost identical to 'posix', but with a native path type of 'T.Text' -- rather than 'B.ByteString'. ----- Since: 0.4.3+-- Since: 0.3.4 / 0.4.3 darwin :: Rules T.Text darwin = Rules 	{ rulesName = T.pack "Darwin"@@ -206,7 +228,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.4.3+-- Since: 0.3.4 / 0.4.3 darwin_ghc702 :: Rules T.Text darwin_ghc702 = darwin 	{ rulesName = T.pack "Darwin (GHC 7.2)"@@ -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.4.5+version: 0.4.6 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.4/-  tag: system-filepath_0.4.5+  tag: system-filepath_0.4.6  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