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

Author: adithyaov

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

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
 

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