Rename some Path APIs and fix docs, doctests of some

Author: harendra-kumar

bench-test-lib/src/BenchTestLib/DirIO.hs

@@ -61,7 +61,6 @@ import qualified Streamly.Internal.Data.Unfold as Unfold
 import qualified Streamly.Internal.FileSystem.DirIO as Dir
 import qualified Streamly.FileSystem.Path as Path
 #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
-import qualified Streamly.Internal.FileSystem.Path as Path (toChunk)
 import qualified Streamly.Internal.FileSystem.Posix.ReadDir as Dir
 #endif
 
@@ -165,7 +164,7 @@ listDirChunkedWith
     -> [Char] -> Stream IO Word8
 listDirChunkedWith act inp = do
      Stream.unfoldEachEndBy 10 Array.reader
-        $ fmap (Array.asBytes . Path.toChunk)
+        $ fmap (Array.asBytes . Path.toArray)
         $ Stream.unfoldEach Unfold.fromList
         $ fmap (either id id)
         $ act
@@ -177,7 +176,7 @@ listDirWith
     -> [Char] -> Stream IO Word8
 listDirWith act inp = do
      Stream.unfoldEachEndBy 10 Array.reader
-        $ fmap (Array.asBytes . Path.toChunk . either id id)
+        $ fmap (Array.asBytes . Path.toArray . either id id)
         $ act
         $ Stream.fromPure (Left (fromJust $ Path.fromString inp))
 

core/src/DocTestFileSystemPath.hs

@@ -0,0 +1,20 @@
+{- $setup
+>>> :m
+>>> :set -XQuasiQuotes
+>>> import Control.Exception (SomeException, evaluate, try)
+>>> import Data.Either (Either, isLeft)
+>>> import Data.Maybe (fromJust, isJust, isNothing)
+>>> import Streamly.FileSystem.Path (Path, path)
+>>> import qualified Streamly.Data.Array as Array
+>>> import qualified Streamly.Data.Stream as Stream
+>>> import qualified Streamly.FileSystem.Path as Path
+>>> import qualified Streamly.Unicode.Stream as Unicode
+
+For APIs that have not been released yet.
+
+>>> import qualified Streamly.Internal.FileSystem.Path as Path
+
+Utilities:
+
+>>> fails x = isLeft <$> (try (evaluate x) :: IO (Either SomeException String))
+-}

core/src/DocTestFileSystemPosixPath.hs

@@ -0,0 +1,19 @@
+{- $setup
+>>> :m
+>>> :set -XQuasiQuotes
+>>> import Control.Exception (SomeException, evaluate, try)
+>>> import Data.Either (Either, isLeft)
+>>> import Data.Maybe (isNothing, isJust)
+>>> import qualified Streamly.Data.Array as Array
+>>> import qualified Streamly.Data.Stream as Stream
+>>> import qualified Streamly.Unicode.Stream as Unicode
+
+For APIs that have not been released yet.
+
+>>> import Streamly.Internal.FileSystem.PosixPath (PosixPath, path)
+>>> import qualified Streamly.Internal.FileSystem.PosixPath as Path
+
+Utilities:
+
+>>> fails x = isLeft <$> (try (evaluate x) :: IO (Either SomeException String))
+-}

core/src/DocTestFileSystemWindowsPath.hs

@@ -0,0 +1,21 @@
+{- $setup
+>>> :m
+>>> :set -XQuasiQuotes
+>>> import Control.Exception (SomeException, evaluate, try)
+>>> import Data.Either (Either, isLeft)
+>>> import Data.Maybe (fromJust, isNothing, isJust)
+>>> import Data.Word (Word16)
+>>> import Streamly.Data.Array (Array)
+>>> import qualified Streamly.Data.Array as Array
+>>> import qualified Streamly.Data.Stream as Stream
+>>> import qualified Streamly.Unicode.Stream as Unicode
+
+For APIs that have not been released yet.
+
+>>> import Streamly.Internal.FileSystem.WindowsPath (WindowsPath, path)
+>>> import qualified Streamly.Internal.FileSystem.WindowsPath as Path
+
+Utilities:
+
+>>> fails x = isLeft <$> (try (evaluate x) :: IO (Either SomeException String))
+-}

core/src/Streamly/FileSystem/Path.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 -- |
 -- Module      : Streamly.FileSystem.Path
 -- Copyright   : (c) 2023 Composewell Technologies
@@ -68,11 +69,20 @@
 
 module Streamly.FileSystem.Path
     (
+    -- * Setup
+    -- | To execute the code examples provided in this module in ghci, please
+    -- run the following commands first.
+    --
+    -- $setup
+
     -- * Type
       Path
+    , OsWord
 
     -- * Construction
-    , fromChunk
+    , isValidPath
+    , validatePath
+    , fromArray
     , fromString
 
     -- * Statically Verified String Literals
@@ -84,19 +94,20 @@ module Streamly.FileSystem.Path
     , pathE
 
     -- * Elimination
-    , toChunk
+    , toArray
     , toChars
     , toString
-    , asOsCString
+    -- , asOsCString
 
     -- * Path Info
     , isRooted
     , isBranch
 
-    -- * Separators
-    , dropTrailingSeparators
-    , hasTrailingSeparator
-    , addTrailingSeparator
+    -- These are unstable APIs, see comments in the internal module.
+    -- -- * Separators
+    -- , dropTrailingSeparators
+    -- , hasTrailingSeparator
+    -- , addTrailingSeparator
 
     -- * Joining
     , unsafeExtend
@@ -123,14 +134,11 @@ module Streamly.FileSystem.Path
 
     -- * Equality
     , EqCfg
-    , eqPath
-
-#ifndef IS_WINDOWS
-    -- ** Config options (Posix)
     , ignoreTrailingSeparators
     , ignoreCase
     , allowRelativeEquality
-#endif
+
+    , eqPath
     )
 where
 
@@ -186,3 +194,5 @@ where
 -}
 
 import Streamly.Internal.FileSystem.Path
+
+#include "DocTestFileSystemPath.hs"

core/src/Streamly/Internal/FileSystem/Path.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 -- |
 -- Module      : Streamly.Internal.FileSystem.Path
 -- Copyright   : (c) 2023 Composewell Technologies

core/src/Streamly/Internal/FileSystem/Path/Common.hs

@@ -19,8 +19,8 @@ module Streamly.Internal.FileSystem.Path.Common
     , validateFile
 
     -- * Construction
-    , fromChunk
-    , unsafeFromChunk
+    , fromArray
+    , unsafeFromArray
     , fromChars
     , unsafeFromChars
 
@@ -34,7 +34,9 @@ module Streamly.Internal.FileSystem.Path.Common
     -- * Separators
     , primarySeparator
     , isSeparator
+    , isSeparatorWord
     , dropTrailingSeparators
+    , dropTrailingBy
     , hasTrailingSeparator
     , hasLeadingSeparator
 
@@ -85,7 +87,7 @@ module Streamly.Internal.FileSystem.Path.Common
     , normalizeSeparators
  -- , normalize -- separators and /./ components (split/combine)
     , eqPathBytes
-    , EqCfg
+    , EqCfg(..)
     , ignoreTrailingSeparators
     , ignoreCase
     , allowRelativeEquality
@@ -165,6 +167,10 @@ data OS = Windows | Posix deriving Eq
 -- XXX We can use Enum type class to include the Char type as well so that the
 -- functions can work on Array Word8/Word16/Char but that may be slow.
 
+-- XXX Windows is supported only on little endian machines so generally we do
+-- not need covnersion from LE to BE format unless we want to manipulate
+-- windows paths on big-endian machines.
+
 -- | Unsafe, may tructate to shorter word types, can only be used safely for
 -- characters that fit in the given word size.
 charToWord :: Integral a => Char -> a
@@ -235,6 +241,9 @@ isSeparatorWord os = isSeparator os . wordToChar
 -- @a@. On Windows "c:" and "c:/" are different paths, therefore, we do not
 -- drop the trailing separator from "c:/" or for that matter a separator
 -- preceded by a ':'.
+--
+-- Can't use any arbitrary predicate "p", the logic in this depends on assuming
+-- that it is a path separator.
 {-# INLINE dropTrailingBy #-}
 dropTrailingBy :: (Unbox a, Integral a) =>
     OS -> (a -> Bool) -> Array a -> Array a
@@ -245,13 +254,23 @@ dropTrailingBy os p arr =
      in if n == 0
         then arr
         else if n == len -- "////"
-        then fst $ Array.unsafeBreakAt 1 arr
-        -- "c:////"
+        then
+            -- Even though "//" is not allowed as a valid path.
+            -- We still handle that case in this low level function.
+            if os == Windows
+                && n >= 2
+                && Array.unsafeGetIndex 0 arr == Array.unsafeGetIndex 1 arr
+            then fst $ Array.unsafeBreakAt 2 arr -- make it "//" share name
+            else fst $ Array.unsafeBreakAt 1 arr
+        -- "c:////" - keep one "/" after colon in ".*:///" otherwise it will
+        -- change the meaning. "c:/" may also appear, in the middle e.g.
+        -- in UNC paths.
         else if (os == Windows)
                 && (Array.unsafeGetIndex (len - n - 1) arr == charToWord ':')
         then fst $ Array.unsafeBreakAt (len - n + 1) arr
         else arr1
 
+-- XXX we cannot compact "//" to "/" on windows
 {-# INLINE compactTrailingBy #-}
 compactTrailingBy :: Unbox a => (a -> Bool) -> Array a -> Array a
 compactTrailingBy p arr =
@@ -1158,8 +1177,9 @@ validatePathWith allowRoot Windows path
 validatePath :: (MonadThrow m, Integral a, Unbox a) => OS -> Array a -> m ()
 validatePath = validatePathWith True
 
--- | Like validatePath but on Windows only full paths are allowed, path roots
--- only are not allowed. Thus "//x/" is not valid.
+-- | Like validatePath but on Windows the path must refer to a file system
+-- object, share roots or prefixes not referring to a specific path are not
+-- allowed. Thus "//x/" is not a valid path.
 {-# INLINE validatePath' #-}
 validatePath' :: (MonadThrow m, Integral a, Unbox a) => OS -> Array a -> m ()
 validatePath' = validatePathWith False
@@ -1187,18 +1207,18 @@ isValidPath' os path =
         Nothing -> False
         Just _ -> True
 
-{-# INLINE unsafeFromChunk #-}
-unsafeFromChunk :: Array a -> Array a
-unsafeFromChunk = id
+{-# INLINE unsafeFromArray #-}
+unsafeFromArray :: Array a -> Array a
+unsafeFromArray = id
 
-{-# INLINE fromChunk #-}
-fromChunk :: forall m a. (MonadThrow m, Unbox a, Integral a) =>
+{-# INLINE fromArray #-}
+fromArray :: forall m a. (MonadThrow m, Unbox a, Integral a) =>
     OS -> Array a -> m (Array a)
-fromChunk os arr = validatePath os arr >> pure arr
+fromArray os arr = validatePath os arr >> pure arr
 {-
     let arr1 = Array.unsafeCast arr :: Array a
      in validatePath os arr1 >> pure arr1
-fromChunk Windows arr =
+fromArray Windows arr =
     case Array.cast arr of
         Nothing ->
             throwM
@@ -1228,7 +1248,7 @@ fromChars :: (MonadThrow m, Unbox a, Integral a) =>
     -> m (Array a)
 fromChars os encode s =
     let arr = unsafeFromChars encode s
-     in fromChunk os (Array.unsafeCast arr)
+     in fromArray os (Array.unsafeCast arr)
 
 {-# INLINE toChars #-}
 toChars :: (Monad m, Unbox a) =>
@@ -1392,6 +1412,7 @@ eqPathBytes = Array.byteEq
 -- control the strictness.
 --
 -- The default configuration is as follows:
+--
 -- >>> :{
 -- defaultMod = ignoreTrailingSeparators False
 --            . ignoreCase False
@@ -1411,33 +1432,36 @@ data EqCfg =
     -- , noIgnoreRedundantDot -- "x\/.\/" \/= "x"
     }
 
--- | Default equality check configuration.
---
--- > :{
--- > eqCfg = EqCfg
--- >     { ignoreTrailingSeparators = False
--- >     , ignoreCase = False
--- >     , allowRelativeEquality = False
--- >     }
--- > :}
---
-eqCfg :: EqCfg
-eqCfg = EqCfg
-    { _ignoreTrailingSeparators = False
-    , _ignoreCase = False
-    , _allowRelativeEquality = False
-    }
-
+-- | When set to 'False', a path with a trailing slash and a path without are
+-- treated as unequal e.g. "x" is not the same as "x\/". The latter is a
+-- directory.
+--
+-- /Default/: False
 ignoreTrailingSeparators :: Bool -> EqCfg -> EqCfg
 ignoreTrailingSeparators val conf = conf { _ignoreTrailingSeparators = val }
 
+-- | When set to 'False', comparison is case sensitive.
+--
+-- /Posix Default/: False
+--
+-- /Windows Default/: True
 ignoreCase :: Bool -> EqCfg -> EqCfg
 ignoreCase val conf = conf { _ignoreCase = val }
 
+-- | When set to 'False':
+--
+-- * paths with a leading "." and without a leading "." e.g. ".\/x\/y" and
+-- "x\/y" are treated as unequal. The first one is a dynamically rooted path
+-- and the second one is a branch or free path segment.
+--
+-- * Two paths starting with a leading "." may not actually be equal even if
+-- they are literally equal, depending on the meaning of ".". We return unequal
+-- even though they may be equal sometimes.
+--
+-- /Default/: False
 allowRelativeEquality :: Bool -> EqCfg -> EqCfg
 allowRelativeEquality val conf = conf { _allowRelativeEquality = val }
 
-
 data PosixRoot = PosixRootAbs | PosixRootRel deriving Eq
 
 data WindowsRoot =
@@ -1547,8 +1571,8 @@ eqComponentsWith ignCase decoder os a b =
 {-# INLINE eqPath #-}
 eqPath :: (Unbox a, Integral a) =>
     (Stream Identity a -> Stream Identity Char)
-    -> OS -> (EqCfg -> EqCfg) -> Array a -> Array a -> Bool
-eqPath decoder os configMod a b =
+    -> OS -> EqCfg -> Array a -> Array a -> Bool
+eqPath decoder os EqCfg{..} a b =
     let (rootA, stemA) = splitRoot os a
         (rootB, stemB) = splitRoot os b
 
@@ -1570,5 +1594,3 @@ eqPath decoder os configMod a b =
            eqRelative
         && eqTrailingSep
         && eqComponentsWith _ignoreCase decoder os stemA stemB
-     where
-     EqCfg {..} = configMod eqCfg