Skip to content

Use (EqCfg -> EqCfg) config modifier instead of EqCfg #3040

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
adithyaov merged 1 commit into from
Jun 14, 2025
Merged

Use (EqCfg -> EqCfg) config modifier instead of EqCfg #3040

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
66 changes: 41 additions & 25 deletions core/src/Streamly/Internal/FileSystem/Path/Common.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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"

Expand All @@ -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 =
Expand Down Expand Up @@ -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
44 changes: 21 additions & 23 deletions core/src/Streamly/Internal/FileSystem/PosixPath.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
)
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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"
Expand Down Expand Up @@ -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 "." "."
Expand Down Expand Up @@ -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

Expand Down
73 changes: 32 additions & 41 deletions core/src/Streamly/Internal/FileSystem/WindowsPath.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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.
--
Expand All @@ -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:
Expand All @@ -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
Expand Down
Loading