packages feed

system-filepath (empty) → 0.1

raw patch · 7 files changed

+656/−0 lines, 7 filesdep +basedep +bytestringsetup-changed

Dependencies added: base, bytestring

Files

+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ System/FilePath.hs view
@@ -0,0 +1,210 @@+-----------------------------------------------------------------------------+-- |+-- Module: System.FilePath+-- Copyright: 2010 John Millikin+-- License: MIT+--+-- Maintainer:  jmillikin@gmail.com+-- Portability:  portable+--+-----------------------------------------------------------------------------++module System.FilePath+	( FilePath+	, empty+	+	-- * Basic properties+	, null+	, root+	, directory+	, parent+	, filename+	, basename+	, absolute+	, relative+	+	-- * Basic operations+	, append+	, (</>)+	, concat+	, commonPrefix+	+	-- * Extensions+	, extension+	, extensions+	, hasExtension+	+	, addExtension+	, (<.>)+	, dropExtension+	, replaceExtension+	+	, addExtensions+	, dropExtensions+	, replaceExtensions+	+	, splitExtension+	, splitExtensions+	) where++import Prelude hiding (FilePath, concat, null)+import qualified Prelude as P+import Data.Maybe (isNothing, listToMaybe)+import qualified Data.Monoid as M+import System.FilePath.Internal+import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as B8++instance M.Monoid FilePath where+	mempty = empty+	mappend = append+	mconcat = concat++-------------------------------------------------------------------------------+-- Basic properties+-------------------------------------------------------------------------------++null :: FilePath -> Bool+null = (== empty)++root :: FilePath -> FilePath+root p = empty { pathRoot = pathRoot p }++directory :: FilePath -> FilePath+directory p = empty+	{ pathRoot = pathRoot p+	, pathComponents = if P.null (pathComponents p) && isNothing (pathRoot p)+		then [B8.pack "."]+		else pathComponents p+	}++parent :: FilePath -> FilePath+parent p = empty+	{ pathRoot = pathRoot p+	, pathComponents = if P.null (pathComponents p) && isNothing (pathRoot p)+		then [B8.pack "."]+		else if null (filename p)+			then safeInit (pathComponents p)+			else pathComponents p+	}++filename :: FilePath -> FilePath+filename p = empty+	{ pathBasename = pathBasename p+	, pathExtensions = pathExtensions p+	}++basename :: FilePath -> FilePath+basename p = empty+	{ pathBasename = pathBasename p+	}++absolute :: FilePath -> Bool+absolute p = case pathRoot p of+	Just RootPosix -> True+	Just (RootWindowsVolume _) -> True+	_ -> False++relative :: FilePath -> Bool+relative p = case pathRoot p of+	Just _ -> False+	_ -> True++-------------------------------------------------------------------------------+-- Basic operations+-------------------------------------------------------------------------------++append :: FilePath -> FilePath -> FilePath+append x y = if absolute y then y else xy where+	xy = y+		{ pathRoot = pathRoot x+		, pathComponents = components+		}+	components = xComponents ++ pathComponents y+	xComponents = (pathComponents x ++) $ if null (filename x)+		then []+		else [B.concat $ [maybe (B8.pack "") id (pathBasename x)] ++ pathExtensions x]++(</>) :: FilePath -> FilePath -> FilePath+(</>) = append++concat :: [FilePath] -> FilePath+concat [] = empty+concat ps = foldr1 append ps++commonPrefix :: [FilePath] -> FilePath+commonPrefix [] = empty+commonPrefix ps = foldr1 step ps where+	step x y = if pathRoot x /= pathRoot y+		then empty+		else let cs = commonComponents x y in+			if cs /= pathComponents x+				then empty { pathRoot = pathRoot x, pathComponents = cs }+				else if pathBasename x /= pathBasename y+					then empty { pathRoot = pathRoot x, pathComponents = cs }+					else let exts = commonExtensions x y in+						x { pathExtensions = exts }+	+	commonComponents x y = common (pathComponents x) (pathComponents 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 []++-------------------------------------------------------------------------------+-- Basenames+-------------------------------------------------------------------------------++-------------------------------------------------------------------------------+-- Extensions+-------------------------------------------------------------------------------++extension :: FilePath -> Maybe B.ByteString+extension p = case extensions p of+	[] -> Nothing+	es -> Just (last es)++extensions :: FilePath -> [B.ByteString]+extensions = pathExtensions++hasExtension :: FilePath -> B.ByteString -> Bool+hasExtension p e = extension p == Just e++addExtension :: FilePath -> B.ByteString -> FilePath+addExtension p ext = addExtensions p [ext]++addExtensions :: FilePath -> [B.ByteString] -> FilePath+addExtensions p exts = p { pathExtensions = pathExtensions p ++ exts }++(<.>) :: FilePath -> B.ByteString -> FilePath+(<.>) = addExtension++dropExtension :: FilePath -> FilePath+dropExtension p = p { pathExtensions = safeInit (pathExtensions p) }++dropExtensions :: FilePath -> FilePath+dropExtensions p = p { pathExtensions = [] }++replaceExtension :: FilePath -> B.ByteString -> FilePath+replaceExtension = addExtension . dropExtension++replaceExtensions :: FilePath -> [B.ByteString] -> FilePath+replaceExtensions = addExtensions . dropExtensions++splitExtension :: FilePath -> (FilePath, Maybe B.ByteString)+splitExtension p = (dropExtension p, extension p)++splitExtensions :: FilePath -> (FilePath, [B.ByteString])+splitExtensions p = (dropExtensions p, extensions p)++-------------------------------------------------------------------------------+-- Utils+-------------------------------------------------------------------------------++safeInit :: [a] -> [a]+safeInit xs = case xs of+	[] -> []+	_ -> init xs
+ System/FilePath/CurrentOS.hs view
@@ -0,0 +1,85 @@+-----------------------------------------------------------------------------+-- |+-- Module: System.FilePath.CurrentOS+-- Copyright: 2010 John Millikin+-- License: MIT+--+-- Maintainer:  jmillikin@gmail.com+-- Portability:  portable+--+-- Re-exports contents of "System.FilePath", defaulting to the current OS's+-- rules when needed.+--+-----------------------------------------------------------------------------++{-# LANGUAGE CPP #-}+module System.FilePath.CurrentOS+	( module System.FilePath+	, currentOS+	+	-- * Rule-specific path properties+	, valid+	, normalise+	, equivalent+	+	-- * Parsing file paths+	, toBytes+	, toLazyBytes+	, toString+	, fromBytes+	, fromLazyBytes+	, fromString+	+	-- * Search paths+	, splitSearchPath+	) where+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL+import qualified Data.String as S+import System.FilePath+import qualified System.FilePath as F+import qualified System.FilePath.Rules as R++currentOS :: R.Rules+#if defined(mingw32_HOST_OS) || defined(__MINGW32__)+currentOS = R.windows+#else+currentOS = R.posix+#endif++instance S.IsString F.FilePath where+	fromString = R.fromString currentOS++instance Show F.FilePath where+	showsPrec d path = showParen (d > 10) $+		showString "FilePath " . shows (toBytes path)++valid :: F.FilePath -> Bool+valid = R.valid currentOS++normalise :: F.FilePath -> F.FilePath+normalise = R.normalise currentOS++equivalent :: F.FilePath -> F.FilePath -> Bool+equivalent = R.equivalent currentOS++toBytes :: F.FilePath -> B.ByteString+toBytes = R.toBytes currentOS++toLazyBytes :: F.FilePath -> BL.ByteString+toLazyBytes = R.toLazyBytes currentOS++toString :: F.FilePath -> String+toString = R.toString currentOS++fromBytes :: B.ByteString -> F.FilePath+fromBytes = R.fromBytes currentOS++fromLazyBytes :: BL.ByteString -> F.FilePath+fromLazyBytes = R.fromLazyBytes currentOS++fromString :: String -> F.FilePath+fromString = R.fromString currentOS++splitSearchPath :: B.ByteString -> [F.FilePath]+splitSearchPath = R.splitSearchPath currentOS
+ System/FilePath/Internal.hs view
@@ -0,0 +1,61 @@+-----------------------------------------------------------------------------+-- |+-- Module: System.FilePath.Internal+-- Copyright: 2010 John Millikin+-- License: MIT+--+-- Maintainer:  jmillikin@gmail.com+-- Portability:  portable+--+-----------------------------------------------------------------------------++{-# LANGUAGE DeriveDataTypeable #-}+module System.FilePath.Internal where++import Prelude hiding (FilePath)+import Data.Data (Data)+import Data.Typeable (Typeable)+import qualified Data.ByteString as B++-------------------------------------------------------------------------------+-- File Paths+-------------------------------------------------------------------------------++type Component = B.ByteString+type Basename = B.ByteString+type Extension = B.ByteString++data Root+	= RootPosix+	| RootWindowsVolume Char+	| RootWindowsCurrentVolume+	deriving (Eq, Data, Typeable)++data FilePath = FilePath+	{ pathRoot :: (Maybe Root)+	, pathComponents :: [Component]+	, pathBasename :: (Maybe Basename)+	, pathExtensions :: [Extension]+	}+	deriving (Eq, Data, Typeable)++empty :: FilePath+empty = FilePath Nothing [] Nothing []++-------------------------------------------------------------------------------+-- Rules+-------------------------------------------------------------------------------++data Rules = Rules+	{ rulesName :: String+	, toByteChunks :: FilePath -> [B.ByteString]+	, fromBytes :: B.ByteString -> FilePath+	, caseSensitive :: Bool+	, valid :: FilePath -> Bool+	, splitSearchPath :: B.ByteString -> [FilePath]+	, normalise :: FilePath -> FilePath+	}++instance Show Rules where+	showsPrec d r = showParen (d > 10) $+		showString "Rules " . shows (rulesName r)
+ System/FilePath/Rules.hs view
@@ -0,0 +1,242 @@+-----------------------------------------------------------------------------+-- |+-- Module: System.FilePath.Rules+-- Copyright: 2010 John Millikin+-- License: MIT+--+-- Maintainer:  jmillikin@gmail.com+-- Portability:  portable+--+-----------------------------------------------------------------------------++module System.FilePath.Rules+	( Rules+	, posix+	, windows+	+	-- * Rule-specific path properties+	, valid+	, normalise+	, equivalent+	+	-- * Parsing file paths+	, toBytes+	, toLazyBytes+	, toString+	, fromBytes+	, fromLazyBytes+	, fromString+	+	-- * Parsing search paths+	, splitSearchPath+	) where++import Prelude hiding (FilePath, null)+import qualified Prelude as P+import Data.Char (toUpper, chr)+import Data.List (intersperse)+import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as B8+import qualified Data.ByteString.Lazy as BL+import qualified Data.ByteString.Lazy.Char8 as BL8++import System.FilePath+import System.FilePath.Internal++-------------------------------------------------------------------------------+-- Rule-specific path properties+-------------------------------------------------------------------------------+equivalent :: Rules -> FilePath -> FilePath -> Bool+equivalent r x y = n x == n y where+	n p = if caseSensitive r+		then normalise r p+		else casefold (normalise r p)+	+	-- TODO: use proper unicode case folding here? I'm not sure there's+	-- any way to do correct case-insensitive comparison without knowing+	-- the filename's encoding.+	casefold p = p+		{ pathComponents = map upperBytes $ pathComponents p+		, pathBasename = fmap upperBytes $ pathBasename p+		, pathExtensions = map upperBytes $ pathExtensions p+		}++-------------------------------------------------------------------------------+-- Public helpers+-------------------------------------------------------------------------------+toBytes :: Rules -> FilePath -> B.ByteString+toBytes r = B.concat . toByteChunks r++toLazyBytes :: Rules -> FilePath -> BL.ByteString+toLazyBytes r = BL.fromChunks . toByteChunks r++fromLazyBytes :: Rules -> BL.ByteString -> FilePath+fromLazyBytes r = fromBytes r . B.concat . BL.toChunks++toString :: Rules -> FilePath -> String+toString r = BL8.unpack . toLazyBytes r++fromString :: Rules -> String -> FilePath+fromString r = fromBytes r . B8.pack++-------------------------------------------------------------------------------+-- Generic+-------------------------------------------------------------------------------++rootBytes :: Maybe Root -> B.ByteString+rootBytes r = B8.pack $ flip (maybe "") r $ \r' -> case r' of+	RootPosix -> "/"+	RootWindowsVolume c -> c : ":\\"+	RootWindowsCurrentVolume -> "\\"++byteComponents :: FilePath -> [B.ByteString]+byteComponents path = pathComponents path ++ [name] where+	name = (`B.append` ext) $ case pathBasename path of+		Nothing -> B.empty+		Just name' -> name'+	ext = case pathExtensions path of+		[] -> B.empty+		exts -> B.intercalate (B8.pack ".") (B.empty:exts)++upperBytes :: B.ByteString -> B.ByteString+upperBytes bytes = (`B.map` bytes) $ \b -> if b >= 0x41 && b <= 0x5A+	then b + 0x20+	else b++-------------------------------------------------------------------------------+-- POSIX+-------------------------------------------------------------------------------++posix :: Rules+posix = Rules+	{ rulesName = "POSIX"+	, toByteChunks = posixToByteChunks+	, fromBytes = posixFromBytes+	, caseSensitive = True+	, valid = posixValid+	, splitSearchPath = posixSplitSearch+	, normalise = posixNormalise+	}++posixToByteChunks :: FilePath -> [B.ByteString]+posixToByteChunks p = root : chunks where+	root = rootBytes $ pathRoot p+	chunks = intersperse (B8.pack "/") $ byteComponents p++posixFromBytes :: B.ByteString -> FilePath+posixFromBytes bytes = if B.null bytes then empty else path where+	path = FilePath root cs name exts+	split' = B.split 0x2F bytes+	+	(root, pastRoot) = if B.null (head split')+		then (Just RootPosix, tail split')+		else (Nothing, split')+	+	cs = if P.null pastRoot+		then []+		else filter (not . B.null) $ if B.null (last pastRoot)+			then pastRoot+			else init pastRoot+	+	(name, exts) = case B.split 0x2E (last split') of+		[] -> (Nothing, [])+		(name':exts') -> (Just name', exts')++posixValid :: FilePath -> Bool+posixValid p = validRoot && validComponents where+	validComponents = flip all (byteComponents p)+		$ not . B.any (\b -> b == 0 || b == 0x2F)+	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++posixNormalise :: FilePath -> FilePath+posixNormalise p = p { pathComponents = components } where+	components = filter (/= B8.pack ".") $ pathComponents p++-------------------------------------------------------------------------------+-- Windows+-------------------------------------------------------------------------------++windows :: Rules+windows = Rules+	{ rulesName = "Windows"+	, toByteChunks = winToByteChunks+	, fromBytes = winFromBytes+	, caseSensitive = False+	, valid = winValid+	, splitSearchPath = map winFromBytes . filter (not . B.null) . B.split 0x3B+	, normalise = winNormalise+	}++winToByteChunks :: FilePath -> [B.ByteString]+winToByteChunks p = root : chunks where+	root = rootBytes $ pathRoot p+	chunks = intersperse (B8.pack "\\") $ byteComponents p++winFromBytes :: B.ByteString -> FilePath+winFromBytes bytes = if B.null bytes then empty else path where+	path = FilePath root cs name exts+	split' = B.splitWith isSep bytes+	isSep b = b == 0x2F || b == 0x5C+	+	(root, pastRoot) = let+		head' = head split'+		tail' = tail split'+		in if B.null head'+			then (Just RootWindowsCurrentVolume, tail')+			else if B.elem 0x3A head'+				then (Just (parseDrive head'), tail')+				else (Nothing, split')+	+	parseDrive bytes' = RootWindowsVolume c where+		c = chr . fromIntegral . B.head $ bytes'+	+	cs = if P.null pastRoot+		then []+		else filter (not . B.null) $ if B.null (last pastRoot)+			then pastRoot+			else init pastRoot+	+	(name, exts) = case B.split 0x2E (last split') of+		[] -> (Nothing, [])+		(name':exts') -> (Just name', exts')++winValid :: FilePath -> Bool+winValid p = validRoot && noReserved && validCharacters where+	reservedChars = [0..0x1F] ++ [0x2F, 0x5C, 0x3F, 0x2A, 0x3A, 0x7C, 0x22, 0x3C, 0x3E]+	reservedNames = map B8.pack+		[ "AUX", "CLOCK$", "COM1", "COM2", "COM3", "COM4"+		, "COM5", "COM6", "COM7", "COM8", "COM9", "CON"+		, "LPT1", "LPT2", "LPT3", "LPT4", "LPT5", "LPT6"+		, "LPT7", "LPT8", "LPT9", "NUL", "PRN"+		]+	+	validRoot = case pathRoot p of+		Nothing -> True+		Just RootWindowsCurrentVolume -> True+		Just (RootWindowsVolume v) -> elem (toUpper v) ['A'..'Z']+		_ -> False+	+	noExt = p { pathExtensions = [] }+	noReserved = flip all (byteComponents noExt)+		$ \c -> notElem (upperBytes c) reservedNames+	+	validCharacters = flip all (byteComponents p)+		$ not . B.any (`elem` reservedChars)++winNormalise :: FilePath -> FilePath+winNormalise p = p' where+	p' = p+		{ pathComponents = components+		, pathRoot = root+		}+	components = filter (/= B8.pack ".") $ pathComponents p+	root = case pathRoot p of+		Just (RootWindowsVolume c) -> Just (RootWindowsVolume (toUpper c))+		r -> r
+ license.txt view
@@ -0,0 +1,22 @@+Copyright (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.cabal view
@@ -0,0 +1,34 @@+name: system-filepath+version: 0.1+synopsis: High-level, byte-based file and directory path manipulations+license: MIT+license-file: license.txt+author: John Millikin <jmillikin@gmail.com>+maintainer: jmillikin@gmail.com+copyright: Copyright (c) John Millikin 2010+build-type: Simple+cabal-version: >=1.6+category: System+stability: experimental+homepage: http://ianen.org/haskell/system-filepath/+bug-reports: mailto:jmillikin@gmail.com+tested-with: GHC==6.12.1++source-repository head+  type: darcs+  location: http://ianen.org/haskell/system-filepath/++library+  ghc-options: -Wall -fno-warn-unused-do-bind -fno-warn-orphans++  build-depends:+      base >=3 && < 5+    , bytestring >= 0.9 && < 0.10++  exposed-modules:+    System.FilePath+    System.FilePath.CurrentOS+    System.FilePath.Rules++  other-modules:+    System.FilePath.Internal