Rename some and fix docs, doctests of Path APIs

Author: harendra-kumar

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,19 @@
 
 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
 
     -- * Construction
-    , fromChunk
+    , isValidPath
+    , validatePath
+    , fromArray
     , fromString
 
     -- * Statically Verified String Literals
@@ -84,7 +93,7 @@ module Streamly.FileSystem.Path
     , pathE
 
     -- * Elimination
-    , toChunk
+    , toArray
     , toChars
     , toString
     , asOsCString
@@ -93,10 +102,11 @@ module Streamly.FileSystem.Path
     , isRooted
     , isBranch
 
-    -- * Separators
-    , dropTrailingSeparators
-    , hasTrailingSeparator
-    , addTrailingSeparator
+    -- These are unstable APIs, see comments in the internal module.
+    -- -- * Separators
+    -- , dropTrailingSeparators
+    -- , hasTrailingSeparator
+    -- , addTrailingSeparator
 
     -- * Joining
     , unsafeExtend
@@ -123,14 +133,11 @@ module Streamly.FileSystem.Path
 
     -- * Equality
     , EqCfg
-    , eqPath
-
-#ifndef IS_WINDOWS
-    -- ** Config options (Posix)
     , ignoreTrailingSeparators
     , ignoreCase
     , allowRelativeEquality
-#endif
+
+    , eqPath
     )
 where
 
@@ -186,3 +193,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
 
@@ -35,6 +35,7 @@ module Streamly.Internal.FileSystem.Path.Common
     , primarySeparator
     , isSeparator
     , dropTrailingSeparators
+    , dropTrailingBy
     , hasTrailingSeparator
     , hasLeadingSeparator
 
@@ -85,7 +86,7 @@ module Streamly.Internal.FileSystem.Path.Common
     , normalizeSeparators
  -- , normalize -- separators and /./ components (split/combine)
     , eqPathBytes
-    , EqCfg
+    , EqCfg(..)
     , ignoreTrailingSeparators
     , ignoreCase
     , allowRelativeEquality
@@ -235,6 +236,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 +249,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 +1172,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 +1202,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 +1243,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 +1407,7 @@ eqPathBytes = Array.byteEq
 -- control the strictness.
 --
 -- The default configuration is as follows:
+--
 -- >>> :{
 -- defaultMod = ignoreTrailingSeparators False
 --            . ignoreCase False
@@ -1411,33 +1427,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 +1566,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 +1589,3 @@ eqPath decoder os configMod a b =
            eqRelative
         && eqTrailingSep
         && eqComponentsWith _ignoreCase decoder os stemA stemB
-     where
-     EqCfg {..} = configMod eqCfg

core/src/Streamly/Internal/FileSystem/Posix/ReadDir.hsc

@@ -237,7 +237,7 @@ openDirStreamCString s = do
 -- {-# INLINE openDirStream #-}
 openDirStream :: PosixPath -> IO DirStream
 openDirStream p =
-    Array.asCStringUnsafe (Path.toChunk p) $ \s -> do
+    Array.asCStringUnsafe (Path.toArray p) $ \s -> do
         -- openDirStreamCString s
         dirp <- throwErrnoPathIfNullRetry "openDirStream" p $ c_opendir s
         return (DirStream dirp)
@@ -296,7 +296,7 @@ statEntryType conf parent dname = do
     -- XXX We can create a pinned array right here since the next call pins
     -- it anyway.
     path <- appendCString parent dname
-    Array.asCStringUnsafe (Path.toChunk path) $ \cStr -> do
+    Array.asCStringUnsafe (Path.toArray path) $ \cStr -> do
         res <- stat (_followSymlinks conf) cStr
         case res of
             Right mode -> pure $
@@ -368,7 +368,7 @@ readDirStreamEither confMod (curdir, (DirStream dirp)) = loop
   -- mkPath :: IsPath (Rel (a Path)) => Array Word8 -> Rel (a Path)
   -- {-# INLINE mkPath #-}
   mkPath :: Array Word8 -> PosixPath
-  mkPath = Path.unsafeFromChunk
+  mkPath = Path.unsafeFromArray
 
   loop = do
     resetErrno
@@ -920,7 +920,7 @@ readEitherByteChunksAt confMod (ppath, alldirs) =
                                     dname pfd dirp curdir xs dirs ndirs mbarr pos)
                 EntryIsDir -> do
                     arr <- Array.fromCString (castPtr dname)
-                    let path = Path.unsafeFromChunk arr
+                    let path = Path.unsafeFromArray arr
                     let dirs1 = path : dirs
                         ndirs1 = ndirs + 1
                     r <- copyToBuf mbarr pos curdir dname