diff --git a/core/src/Streamly/Internal/FileSystem/Path/Common.hs b/core/src/Streamly/Internal/FileSystem/Path/Common.hs index c5e61d5bdb..2199910078 100644 --- a/core/src/Streamly/Internal/FileSystem/Path/Common.hs +++ b/core/src/Streamly/Internal/FileSystem/Path/Common.hs @@ -85,9 +85,10 @@ module Streamly.Internal.FileSystem.Path.Common , normalizeSeparators -- , normalize -- separators and /./ components (split/combine) , eqPathBytes - , EqCfg(..) - , eqCfg - , eqPathWith + , EqCfg + , ignoreTrailingSeparators + , ignoreCase + , allowRelativeEquality , eqPath -- , commonPrefix -- common prefix of two paths -- , eqPrefix -- common prefix is equal to first path @@ -146,6 +147,7 @@ import qualified Streamly.Internal.Unicode.Stream as Unicode >>> import qualified Streamly.Internal.Data.Array as Array >>> import qualified Streamly.Internal.FileSystem.Path.Common as Common >>> import qualified Streamly.Internal.Unicode.Stream as Unicode +>>> import Streamly.Internal.FileSystem.Path.Common (ignoreTrailingSeparators, allowRelativeEquality, ignoreCase) >>> packPosix = unsafePerformIO . Stream.fold Array.create . Unicode.encodeUtf8' . Stream.fromList >>> unpackPosix = runIdentity . Stream.toList . Unicode.decodeUtf8' . Array.read @@ -1388,11 +1390,19 @@ eqPathBytes = Array.byteEq -- | Options for path comparison operation. By default path comparison uses a -- strict criteria for equality. The following options are provided to -- control the strictness. +-- +-- The default configuration is as follows: +-- >>> :{ +-- defaultMod = ignoreTrailingSeparators False +-- . ignoreCase False +-- . allowRelativeEquality False +-- :} +-- data EqCfg = EqCfg - { ignoreTrailingSeparators :: Bool -- ^ Allows "x\/" == "x" - , ignoreCase :: Bool -- ^ Allows "x" == \"X\" - , allowRelativeEquality :: Bool + { _ignoreTrailingSeparators :: Bool -- ^ Allows "x\/" == "x" + , _ignoreCase :: Bool -- ^ Allows "x" == \"X\" + , _allowRelativeEquality :: Bool -- ^ A leading dot is ignored, thus ".\/x" == ".\/x" and ".\/x" == "x". -- On Windows allows "\/x" == \/x" and "C:x == C:x" @@ -1413,11 +1423,21 @@ data EqCfg = -- eqCfg :: EqCfg eqCfg = EqCfg - { ignoreTrailingSeparators = False - , ignoreCase = False - , allowRelativeEquality = False + { _ignoreTrailingSeparators = False + , _ignoreCase = False + , _allowRelativeEquality = False } +ignoreTrailingSeparators :: Bool -> EqCfg -> EqCfg +ignoreTrailingSeparators val conf = conf { _ignoreTrailingSeparators = val } + +ignoreCase :: Bool -> EqCfg -> EqCfg +ignoreCase val conf = conf { _ignoreCase = val } + +allowRelativeEquality :: Bool -> EqCfg -> EqCfg +allowRelativeEquality val conf = conf { _allowRelativeEquality = val } + + data PosixRoot = PosixRootAbs | PosixRootRel deriving Eq data WindowsRoot = @@ -1521,38 +1541,34 @@ eqComponentsWith ignCase decoder os a b = Array.byteEq (splitPath_ os a) (splitPath_ os b) -- XXX can we do something like SpecConstr for such functions e.g. without --- inlining the function we can use two copies one for allowRelativeEquality +-- inlining the function we can use two copies one for _allowRelativeEquality -- True and other for False and so on for other values of PathEq. -{-# INLINE eqPathWith #-} -eqPathWith :: (Unbox a, Integral a) => +{-# INLINE eqPath #-} +eqPath :: (Unbox a, Integral a) => (Stream Identity a -> Stream Identity Char) - -> OS -> EqCfg -> Array a -> Array a -> Bool -eqPathWith decoder os EqCfg{..} a b = + -> OS -> (EqCfg -> EqCfg) -> Array a -> Array a -> Bool +eqPath decoder os configMod a b = let (rootA, stemA) = splitRoot os a (rootB, stemB) = splitRoot os b eqRelative = - if allowRelativeEquality - then eqRootLax ignoreCase os rootA rootB + if _allowRelativeEquality + then eqRootLax _ignoreCase os rootA rootB else (not (isRootRelative os rootA) && not (isRootRelative os rootB)) - && eqRootStrict ignoreCase os rootA rootB + && eqRootStrict _ignoreCase os rootA rootB -- XXX If one ends in a "." and the other ends in ./ (and same for ".." -- and "../") then they can be equal. We can append a slash in these two -- cases before comparing. eqTrailingSep = - ignoreTrailingSeparators + _ignoreTrailingSeparators || hasTrailingSeparator os a == hasTrailingSeparator os b in eqRelative && eqTrailingSep - && eqComponentsWith ignoreCase decoder os stemA stemB - -{-# INLINE eqPath #-} -eqPath :: (Unbox a, Integral a) => - (Stream Identity a -> Stream Identity Char) - -> OS -> Array a -> Array a -> Bool -eqPath decoder os = eqPathWith decoder os eqCfg + && eqComponentsWith _ignoreCase decoder os stemA stemB + where + EqCfg {..} = configMod eqCfg diff --git a/core/src/Streamly/Internal/FileSystem/PosixPath.hs b/core/src/Streamly/Internal/FileSystem/PosixPath.hs index e996a4eb6f..d25cc01c26 100644 --- a/core/src/Streamly/Internal/FileSystem/PosixPath.hs +++ b/core/src/Streamly/Internal/FileSystem/PosixPath.hs @@ -158,10 +158,11 @@ module Streamly.Internal.FileSystem.OS_PATH , addExtension -- * Equality + , EqCfg + , Common.ignoreTrailingSeparators + , Common.ignoreCase + , Common.allowRelativeEquality , eqPath - , EqCfg(..) - , eqCfg - , eqPathWith , eqPathBytes , normalize ) @@ -181,7 +182,7 @@ import Foreign.C (CWString) import Language.Haskell.TH.Syntax (lift) import Streamly.Internal.Data.Array (Array(..)) import Streamly.Internal.Data.Stream (Stream) -import Streamly.Internal.FileSystem.Path.Common (mkQ, EqCfg(..), eqCfg) +import Streamly.Internal.FileSystem.Path.Common (mkQ, EqCfg) import qualified Streamly.Internal.Data.Array as Array import qualified Streamly.Internal.Data.Stream as Stream @@ -1032,10 +1033,14 @@ addExtension (OS_PATH _a) = undefined ------------------------------------------------------------------------------ #ifndef IS_WINDOWS --- | Checks two paths for logical equality. It performs some normalizations on --- the paths before comparing them, specifically it drops redundant path --- separators between path segments and redundant "\/.\/" components between --- segments. +-- | Checks whether two paths are logically equal. This function takes a +-- configuration modifier to customize the notion of equality. The default +-- configuration, denoted by @id@, behaves as described below. For details, see +-- the documentation of "EqCfg". +-- +-- It performs some normalizations on the paths before comparing them, +-- specifically it drops redundant path separators between path segments and +-- redundant "\/.\/" components between segments. -- -- Equality semantics followed by this routine are listed below. If it returns -- equal then the paths are definitely equal, if it returns unequal then the @@ -1064,7 +1069,7 @@ addExtension (OS_PATH _a) = undefined -- must be files or both must be directories. -- -- >>> :{ --- eq a b = Path.eqPath (pack a) (pack b) +-- eq a b = Path.eqPath id (pack a) (pack b) -- :} -- -- >>> eq "/x" "//x" @@ -1097,19 +1102,12 @@ addExtension (OS_PATH _a) = undefined -- >>> eq "./x" "./x" -- False -- -eqPath :: OS_PATH -> OS_PATH -> Bool -eqPath (OS_PATH a) (OS_PATH b) = - Common.eqPath Unicode.UNICODE_DECODER - Common.OS_NAME a b - --- | Like 'eqPath' but we can control the equality options. +-- We can change the configuration using the available config modifiers. -- -- >>> :{ --- cfg = Path.eqCfg --- { Path.ignoreTrailingSeparators = True --- , Path.allowRelativeEquality = True --- } --- eq a b = Path.eqPathWith cfg (pack a) (pack b) +-- cfg = Path.ignoreTrailingSeparators True +-- . Path.allowRelativeEquality True +-- eq a b = Path.eqPath cfg (pack a) (pack b) -- :} -- -- >>> eq "." "." @@ -1139,9 +1137,9 @@ eqPath (OS_PATH a) (OS_PATH b) = -- >>> eq "x" "x" -- True -- -eqPathWith :: EqCfg -> OS_PATH -> OS_PATH -> Bool -eqPathWith cfg (OS_PATH a) (OS_PATH b) = - Common.eqPathWith Unicode.UNICODE_DECODER +eqPath :: (EqCfg -> EqCfg) -> OS_PATH -> OS_PATH -> Bool +eqPath cfg (OS_PATH a) (OS_PATH b) = + Common.eqPath Unicode.UNICODE_DECODER Common.OS_NAME cfg a b #endif diff --git a/core/src/Streamly/Internal/FileSystem/WindowsPath.hs b/core/src/Streamly/Internal/FileSystem/WindowsPath.hs index 05e8d00ddc..6a83237f15 100644 --- a/core/src/Streamly/Internal/FileSystem/WindowsPath.hs +++ b/core/src/Streamly/Internal/FileSystem/WindowsPath.hs @@ -306,43 +306,6 @@ extendDir $ Common.append' Common.OS_NAME (Common.toString Unicode.UNICODE_DECODER) a b --- | Like 'eqPath' but we can control the equality options. --- --- >>> :{ --- cfg = Path.eqCfg --- { Path.ignoreTrailingSeparators = True --- , Path.ignoreCase = True --- , Path.allowRelativeEquality = True --- } --- eq a b = Path.eqPathWith cfg (pack a) (pack b) --- :} --- --- >>> eq "./x" "x" --- True --- --- >>> eq "X/" "x" --- True --- --- >>> eq "C:x" "c:X" --- True --- --- >>> eq ".\\x" "./X" --- True --- --- >>> eq "x//y" "x/y" --- True --- --- >>> eq "x/./y" "x/y" --- True --- --- >>> eq "x" "x" --- True --- -eqPathWith :: EqCfg -> OS_PATH -> OS_PATH -> Bool -eqPathWith cfg (OS_PATH a) (OS_PATH b) = - Common.eqPathWith Unicode.UNICODE_DECODER - Common.OS_NAME cfg a b - -- | See the eqPath documentation in the -- "Streamly.Internal.FileSystem.PosixPath" module for details. -- @@ -353,7 +316,7 @@ eqPathWith cfg (OS_PATH a) (OS_PATH b) = -- * the comparison is case sensitive. -- -- >>> :{ --- eq a b = Path.eqPath (pack a) (pack b) +-- eq a b = Path.eqPath id (pack a) (pack b) -- :} -- -- The cases that are different from Posix: @@ -373,10 +336,38 @@ eqPathWith cfg (OS_PATH a) (OS_PATH b) = -- >>> eq "c:x" "c:x" -- False -- -eqPath :: OS_PATH -> OS_PATH -> Bool -eqPath (OS_PATH a) (OS_PATH b) = +-- >>> :{ +-- cfg = Path.ignoreTrailingSeparators True +-- . Path.ignoreCase True +-- . Path.allowRelativeEquality True +-- eq a b = Path.eqPath cfg (pack a) (pack b) +-- :} +-- +-- >>> eq "./x" "x" +-- True +-- +-- >>> eq "X/" "x" +-- True +-- +-- >>> eq "C:x" "c:X" +-- True +-- +-- >>> eq ".\\x" "./X" +-- True +-- +-- >>> eq "x//y" "x/y" +-- True +-- +-- >>> eq "x/./y" "x/y" +-- True +-- +-- >>> eq "x" "x" +-- True +-- +eqPath :: (EqCfg -> EqCfg) -> OS_PATH -> OS_PATH -> Bool +eqPath cfg (OS_PATH a) (OS_PATH b) = Common.eqPath Unicode.UNICODE_DECODER - Common.OS_NAME a b + Common.OS_NAME cfg a b -- | If a path is rooted then separate the root and the remaining path, -- otherwise root is returned as empty. If the path is rooted then the non-root