content: {-# LANGUAGE UnliftedFFITypes #-}
  -- |
  -- Module      : Streamly.Internal.FileSystem.Path.Common
  -- Copyright   : (c) 2023 Composewell Technologies
  -- License     : BSD3
  -- Maintainer  : streamly@composewell.com
  -- Portability : GHC
  --
  module Streamly.Internal.FileSystem.Path.Common
      (
      -- * Types
        OS (..)
  
      -- * Validation
      , validatePath
      , validatePath'
      , validateFile
  
      -- * Construction
      , fromArray
      , unsafeFromArray
      , fromChars
      , unsafeFromChars
  
      -- * Quasiquoters
      , mkQ
  
      -- * Elimination
      , toString
      , toChars
  
      -- * Separators
      , primarySeparator
      , isSeparator
      , isSeparatorWord
      , dropTrailingSeparators
      , dropTrailingBy
      , hasTrailingSeparator
      , hasLeadingSeparator
  
      -- * Tests
      , isBranch
      , isRooted
      , isAbsolute
   -- , isRelative -- not isAbsolute
      , isRootRelative -- XXX hasRelativeRoot
      , isRelativeWithDrive -- XXX hasRelativeDriveRoot
      , hasDrive
  
      -- * Joining
      , append
      , append'
      , unsafeAppend
      , appendCString
      , appendCString'
      , unsafeJoinPaths
   -- , joinRoot -- XXX append should be enough
  
      -- * Splitting
  
      -- Note: splitting the search path does not belong here, it is shell aware
      -- operation. search path is separated by : and : is allowed in paths on
      -- posix. Shell would escape it which needs to be handled.
  
      , splitRoot
   -- , dropRoot
   -- , dropRelRoot -- if relative then dropRoot
      , splitHead
      , splitTail
      , splitPath
      , splitPath_
  
      -- * Dir and File
      , splitFile
      , splitDir
  
      -- * Extensions
      , extensionWord
      , splitExtension
      , splitExtensionBy
   -- , addExtension
  
      -- * Equality
   -- , processParentRefs
      , normalizeSeparators
   -- , normalize -- separators and /./ components (split/combine)
      , eqPathBytes
      , EqCfg(..)
      , eqPath
   -- , commonPrefix -- common prefix of two paths
   -- , eqPrefix -- common prefix is equal to first path
   -- , dropPrefix
  
      -- * Utilities
      , wordToChar
      , charToWord
      , unsafeIndexChar
  
      -- * Internal
      , unsafeSplitTopLevel
      , unsafeSplitDrive
      , unsafeSplitUNC
      , splitCompact
      , splitWithFilter
      )
  where
  
  #include "assert.hs"
  
  import Control.Monad (when)
  import Control.Monad.Catch (MonadThrow(..))
  import Control.Monad.IO.Class (MonadIO(..))
  import Data.Char (chr, ord, isAlpha, toUpper)
  import Data.Function ((&))
  import Data.Functor.Identity (Identity(..))
  import Data.Word (Word8, Word16)
  import Foreign (castPtr)
  import Foreign.C (CString, CSize(..))
  import GHC.Base (unsafeChr, Addr#)
  import GHC.Ptr (Ptr(..))
  import Language.Haskell.TH (Q, Exp)
  import Language.Haskell.TH.Quote (QuasiQuoter (..))
  import Streamly.Internal.Data.Array (Array(..))
  import Streamly.Internal.Data.MutArray (MutArray)
  import Streamly.Internal.Data.MutByteArray (Unbox(..))
  import Streamly.Internal.Data.Path (PathException(..))
  import Streamly.Internal.Data.Stream (Stream)
  import System.IO.Unsafe (unsafePerformIO)
  
  import qualified Data.List as List
  import qualified Streamly.Internal.Data.Array as Array
  import qualified Streamly.Internal.Data.Fold as Fold
  import qualified Streamly.Internal.Data.MutArray as MutArray
  import qualified Streamly.Internal.Data.Stream as Stream
  import qualified Streamly.Internal.Unicode.Stream as Unicode
  
  {- $setup
  >>> :m
  
  >>> import Data.Functor.Identity (runIdentity)
  >>> import System.IO.Unsafe (unsafePerformIO)
  >>> import qualified Streamly.Data.Stream as Stream
  >>> import qualified Streamly.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 (ignoreTrailingSeparators, allowRelativeEquality, ignoreCase)
  
  >>> packPosix = unsafePerformIO . Stream.fold Array.create . Unicode.encodeUtf8' . Stream.fromList
  >>> unpackPosix = runIdentity . Stream.toList . Unicode.decodeUtf8' . Array.read
  
  >>> packWindows = unsafePerformIO . Stream.fold Array.create . Unicode.encodeUtf16le' . Stream.fromList
  >>> unpackWindows = runIdentity . Stream.toList . Unicode.decodeUtf16le' . Array.read
  -}
  
  data OS = Windows | Posix deriving Eq
  
  ------------------------------------------------------------------------------
  -- Parsing Operations
  ------------------------------------------------------------------------------
  
  -- 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
  charToWord c =
      let n = ord c
       in assert (n <= 255) (fromIntegral n)
  
  -- | Unsafe, should be a valid character.
  wordToChar :: Integral a => a -> Char
  wordToChar = unsafeChr . fromIntegral
  
  ------------------------------------------------------------------------------
  -- Array utils
  ------------------------------------------------------------------------------
  
  -- | Index a word in an array and convert it to Char.
  unsafeIndexChar :: (Unbox a, Integral a) => Int -> Array a -> Char
  unsafeIndexChar i a = wordToChar (Array.unsafeGetIndex i a)
  
  -- XXX put this in array module, we can have Array.fold and Array.foldM
  foldArr :: Unbox a => Fold.Fold Identity a b -> Array a -> b
  foldArr f arr = runIdentity $ Array.foldM f arr
  
  {-# INLINE countLeadingBy #-}
  countLeadingBy :: Unbox a => (a -> Bool) -> Array a -> Int
  countLeadingBy p = foldArr (Fold.takeEndBy_ (not . p) Fold.length)
  
  countTrailingBy :: Unbox a => (a -> Bool) -> Array a -> Int
  countTrailingBy p = Array.foldRev (Fold.takeEndBy_ (not . p) Fold.length)
  
  ------------------------------------------------------------------------------
  -- Separator parsing
  ------------------------------------------------------------------------------
  
  extensionWord :: Integral a => a
  extensionWord = charToWord '.'
  
  posixSeparator :: Char
  posixSeparator = '/'
  
  windowsSeparator :: Char
  windowsSeparator = '\\'
  
  -- | Primary path separator character, @/@ on Posix and @\\@ on Windows.
  -- Windows supports @/@ too as a separator. Please use 'isSeparator' for
  -- testing if a char is a separator char.
  {-# INLINE primarySeparator #-}
  primarySeparator :: OS -> Char
  primarySeparator Posix = posixSeparator
  primarySeparator Windows = windowsSeparator
  
  -- | On Posix only @/@ is a path separator but in windows it could be either
  -- @/@ or @\\@.
  {-# INLINE isSeparator #-}
  isSeparator :: OS -> Char -> Bool
  isSeparator Posix c = c == posixSeparator
  isSeparator Windows c = (c == windowsSeparator) || (c == posixSeparator)
  
  {-# INLINE isSeparatorWord #-}
  isSeparatorWord :: Integral a => OS -> a -> Bool
  isSeparatorWord os = isSeparator os . wordToChar
  
  ------------------------------------------------------------------------------
  -- Separator normalization
  ------------------------------------------------------------------------------
  
  -- | If the path is @//@ the result is @/@. If it is @a//@ then the result is
  -- @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
  dropTrailingBy os p arr =
      let len = Array.length arr
          n = countTrailingBy p arr
          arr1 = fst $ Array.unsafeBreakAt (len - n) arr
       in if n == 0
          then arr
          else if n == len -- "////"
          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 =
      let len = Array.length arr
          n = countTrailingBy p arr
       in if n <= 1
          then arr
          else fst $ Array.unsafeBreakAt (len - n + 1) arr
  
  {-# INLINE dropTrailingSeparators #-}
  dropTrailingSeparators :: (Unbox a, Integral a) => OS -> Array a -> Array a
  dropTrailingSeparators os =
      dropTrailingBy os (isSeparator os . wordToChar)
  
  -- | A path starting with a separator.
  hasLeadingSeparator :: (Unbox a, Integral a) => OS -> Array a -> Bool
  hasLeadingSeparator os a
      | Array.null a = False -- empty path should not occur
      | isSeparatorWord os (Array.unsafeGetIndex 0 a) = True
      | otherwise = False
  
  {-# INLINE hasTrailingSeparator #-}
  hasTrailingSeparator :: (Integral a, Unbox a) => OS -> Array a -> Bool
  hasTrailingSeparator os path =
      let e = Array.getIndexRev 0 path
       in case e of
              Nothing -> False
              Just x -> isSeparatorWord os x
  
  {-# INLINE toDefaultSeparator #-}
  toDefaultSeparator :: Integral a => a -> a
  toDefaultSeparator x =
      if isSeparatorWord Windows x
      then charToWord (primarySeparator Windows)
      else x
  
  -- | Change all separators in the path to default separator on windows.
  {-# INLINE normalizeSeparators #-}
  normalizeSeparators :: (Integral a, Unbox a) => Array a -> Array a
  normalizeSeparators a =
      -- XXX We can check and return the original array if no change is needed.
      Array.fromPureStreamN (Array.length a)
          $ fmap toDefaultSeparator
          $ Array.read a
  
  ------------------------------------------------------------------------------
  -- Windows drive parsing
  ------------------------------------------------------------------------------
  
  -- | @C:...@, does not check array length.
  {-# INLINE unsafeHasDrive #-}
  unsafeHasDrive :: (Unbox a, Integral a) => Array a -> Bool
  unsafeHasDrive a
      -- Check colon first for quicker return
      | unsafeIndexChar 1 a /= ':' = False
      -- XXX If we found a colon anyway this cannot be a valid path unless it has
      -- a drive prefix. colon is not a valid path character.
      -- XXX check isAlpha perf
      | not (isAlpha (unsafeIndexChar 0 a)) = False
      | otherwise = True
  
  -- | A path that starts with a alphabet followed by a colon e.g. @C:...@.
  hasDrive :: (Unbox a, Integral a) => Array a -> Bool
  hasDrive a = Array.length a >= 2 && unsafeHasDrive a
  
  -- | A path that contains only an alphabet followed by a colon e.g. @C:@.
  isDrive :: (Unbox a, Integral a) => Array a -> Bool
  isDrive a = Array.length a == 2 && unsafeHasDrive a
  
  ------------------------------------------------------------------------------
  -- Relative or Absolute
  ------------------------------------------------------------------------------
  
  -- | A path relative to cur dir it is either @.@ or starts with @./@.
  isRelativeCurDir :: (Unbox a, Integral a) => OS -> Array a -> Bool
  isRelativeCurDir os a
      | len == 0 = False -- empty path should not occur
      | wordToChar (Array.unsafeGetIndex 0 a) /= '.' = False
      | len < 2 = True
      | otherwise = isSeparatorWord os (Array.unsafeGetIndex 1 a)
  
      where
  
      len = Array.length a
  
  -- | A non-UNC path starting with a separator.
  -- Note that "\\/share/x" is treated as "C:/share/x".
  isRelativeCurDriveRoot :: (Unbox a, Integral a) => Array a -> Bool
  isRelativeCurDriveRoot a
      | len == 0 = False -- empty path should not occur
      | len == 1 && sep0 = True
      | sep0 && c0 /= c1 = True -- "\\/share/x" is treated as "C:/share/x".
      | otherwise = False
  
      where
  
      len = Array.length a
      c0 = Array.unsafeGetIndex 0 a
      c1 = Array.unsafeGetIndex 1 a
      sep0 = isSeparatorWord Windows c0
  
  -- | @C:@ or @C:a...@.
  isRelativeWithDrive :: (Unbox a, Integral a) => Array a -> Bool
  isRelativeWithDrive a =
      hasDrive a
          && (  Array.length a < 3
             || not (isSeparator Windows (unsafeIndexChar 2 a))
             )
  
  isRootRelative :: (Unbox a, Integral a) => OS -> Array a -> Bool
  isRootRelative Posix a = isRelativeCurDir Posix a
  isRootRelative Windows a =
      isRelativeCurDir Windows a
          || isRelativeCurDriveRoot a
          || isRelativeWithDrive a
  
  -- | @C:\...@. Note that "C:" or "C:a" is not absolute.
  isAbsoluteWithDrive :: (Unbox a, Integral a) => Array a -> Bool
  isAbsoluteWithDrive a =
      Array.length a >= 3
          && unsafeHasDrive a
          && isSeparator Windows (unsafeIndexChar 2 a)
  
  -- | @\\\\...@ or @//...@
  isAbsoluteUNC :: (Unbox a, Integral a) => Array a -> Bool
  isAbsoluteUNC a
      | Array.length a < 2 = False
      | isSeparatorWord Windows c0 && c0 == c1 = True
      | otherwise = False
  
      where
  
      c0 = Array.unsafeGetIndex 0 a
      c1 = Array.unsafeGetIndex 1 a
  
  -- XXX rename to isRootAbsolute
  
  -- | Note that on Windows a path starting with a separator is relative to
  -- current drive while on Posix this is absolute path as there is only one
  -- drive.
  isAbsolute :: (Unbox a, Integral a) => OS -> Array a -> Bool
  isAbsolute Posix arr =
      hasLeadingSeparator Posix arr
  isAbsolute Windows arr =
      isAbsoluteWithDrive arr || isAbsoluteUNC arr
  
  ------------------------------------------------------------------------------
  -- Location or Segment
  ------------------------------------------------------------------------------
  
  -- XXX API for static processing of .. (normalizeParentRefs)
  --
  -- Note: paths starting with . or .. are ambiguous and can be considered
  -- segments or rooted. We consider a path starting with "." as rooted, when
  -- someone uses "./x" they explicitly mean x in the current directory whereas
  -- just "x" can be taken to mean a path segment without any specific root.
  -- However, in typed paths the programmer can convey the meaning whether they
  -- mean it as a segment or a rooted path. So even "./x" can potentially be used
  -- as a segment which can just mean "x".
  --
  -- XXX For the untyped Path we can allow appending "./x" to other paths. We can
  -- leave this to the programmer. In typed paths we can allow "./x" in segments.
  -- XXX Empty path can be taken to mean "." except in case of UNC paths
  
  isRooted :: (Unbox a, Integral a) => OS -> Array a -> Bool
  isRooted Posix a =
      hasLeadingSeparator Posix a
          || isRelativeCurDir Posix a
  isRooted Windows a =
      hasLeadingSeparator Windows a
          || isRelativeCurDir Windows a
          || hasDrive a -- curdir-in-drive relative, drive absolute
  
  isBranch :: (Unbox a, Integral a) => OS -> Array a -> Bool
  isBranch os = not . isRooted os
  
  ------------------------------------------------------------------------------
  -- Split root
  ------------------------------------------------------------------------------
  
  unsafeSplitPrefix :: (Unbox a, Integral a) =>
      OS -> Int -> Array a -> (Array a, Array a)
  unsafeSplitPrefix os prefixLen arr =
      Array.unsafeBreakAt cnt arr
  
      where
  
      afterDrive = snd $ Array.unsafeBreakAt prefixLen arr
      n = countLeadingBy (isSeparatorWord os) afterDrive
      cnt = prefixLen + n
  
  -- Note: We can have normalized splitting functions to normalize as we split
  -- for efficiency. But then we will have to allocate new arrays instead of
  -- slicing which can make it inefficient.
  
  -- | Split a path prefixed with a separator into (drive, path) tuple.
  --
  -- >>> toListPosix (a,b) = (unpackPosix a, unpackPosix b)
  -- >>> splitPosix = toListPosix . Common.unsafeSplitTopLevel Common.Posix . packPosix
  --
  -- >>> toListWin (a,b) = (unpackWindows a, unpackWindows b)
  -- >>> splitWin = toListWin . Common.unsafeSplitTopLevel Common.Windows . packWindows
  --
  -- >>> splitPosix "/"
  -- ("/","")
  --
  -- >>> splitPosix "//"
  -- ("//","")
  --
  -- >>> splitPosix "/home"
  -- ("/","home")
  --
  -- >>> splitPosix "/home/user"
  -- ("/","home/user")
  --
  -- >>> splitWin "\\"
  -- ("\\","")
  --
  -- >>> splitWin "\\home"
  -- ("\\","home")
  unsafeSplitTopLevel :: (Unbox a, Integral a) =>
      OS -> Array a -> (Array a, Array a)
  -- Note on Windows we should be here only when the path starts with exactly one
  -- separator, otherwise it would be UNC path. But on posix multiple separators
  -- are valid.
  unsafeSplitTopLevel os = unsafeSplitPrefix os 1
  
  -- In some cases there is no valid drive component e.g. "\\a\\b", though if we
  -- consider relative roots then we could use "\\" as the root in this case. In
  -- other cases there is no valid path component e.g. "C:" or "\\share\\" though
  -- the latter is not a valid path and in the former case we can use "." as the
  -- path component.
  
  -- | Split a path prefixed with drive into (drive, path) tuple.
  --
  -- >>> toList (a,b) = (unpackPosix a, unpackPosix b)
  -- >>> split = toList . Common.unsafeSplitDrive . packPosix
  --
  -- >>> split "C:"
  -- ("C:","")
  --
  -- >>> split "C:a"
  -- ("C:","a")
  --
  -- >>> split "C:\\"
  -- ("C:\\","")
  --
  -- >>> split "C:\\\\" -- this is invalid path
  -- ("C:\\\\","")
  --
  -- >>> split "C:\\\\a" -- this is invalid path
  -- ("C:\\\\","a")
  --
  -- >>> split "C:\\/a/b" -- is this valid path?
  -- ("C:\\/","a/b")
  unsafeSplitDrive :: (Unbox a, Integral a) => Array a -> (Array a, Array a)
  unsafeSplitDrive = unsafeSplitPrefix Windows 2
  
  -- | Skip separators and then parse the next path segment.
  -- Return (segment offset, segment length).
  parseSegment :: (Unbox a, Integral a) => Array a -> Int -> (Int, Int)
  parseSegment arr sepOff = (segOff, segCnt)
  
      where
  
      arr1 = snd $ Array.unsafeBreakAt sepOff arr
      sepCnt = countLeadingBy (isSeparatorWord Windows) arr1
      segOff = sepOff + sepCnt
  
      arr2 = snd $ Array.unsafeBreakAt segOff arr
      segCnt = countLeadingBy (not . isSeparatorWord Windows) arr2
  
  -- XXX We can split a path as "root, . , rest" or "root, /, rest".
  -- XXX We can remove the redundant path separator after the root. With that
  -- joining root vs other paths will become similar. But there are some special
  -- cases e.g. (1) "C:a" does not have a separator, can we make this "C:.\\a"?
  -- (2) In case of "/home" we have "/" as root - while joining root and path we
  -- should not add another separator between root and path - thus joining root
  -- and path in this case is anyway special.
  
  -- | Split a path prefixed with "\\" into (drive, path) tuple.
  --
  -- >>> toList (a,b) = (unpackPosix a, unpackPosix b)
  -- >>> split = toList . Common.unsafeSplitUNC . packPosix
  --
  -- >> split ""
  -- ("","")
  --
  -- >>> split "\\\\"
  -- ("\\\\","")
  --
  -- >>> split "\\\\server"
  -- ("\\\\server","")
  --
  -- >>> split "\\\\server\\"
  -- ("\\\\server\\","")
  --
  -- >>> split "\\\\server\\home"
  -- ("\\\\server\\","home")
  --
  -- >>> split "\\\\?\\c:"
  -- ("\\\\?\\c:","")
  --
  -- >>> split "\\\\?\\c:/"
  -- ("\\\\?\\c:/","")
  --
  -- >>> split "\\\\?\\c:\\home"
  -- ("\\\\?\\c:\\","home")
  --
  -- >>> split "\\\\?\\UNC/"
  -- ("\\\\?\\UNC/","")
  --
  -- >>> split "\\\\?\\UNC\\server"
  -- ("\\\\?\\UNC\\server","")
  --
  -- >>> split "\\\\?\\UNC/server\\home"
  -- ("\\\\?\\UNC/server\\","home")
  --
  unsafeSplitUNC :: (Unbox a, Integral a) => Array a -> (Array a, Array a)
  unsafeSplitUNC arr =
      if cnt1 == 1 && unsafeIndexChar 2 arr == '?'
      then do
          if uncLen == 3
                  && unsafeIndexChar uncOff arr == 'U'
                  && unsafeIndexChar (uncOff + 1) arr == 'N'
                  && unsafeIndexChar (uncOff + 2) arr == 'C'
          then unsafeSplitPrefix Windows (serverOff + serverLen) arr
          else unsafeSplitPrefix Windows sepOff1 arr
      else unsafeSplitPrefix Windows sepOff arr
  
      where
  
      arr1 = snd $ Array.unsafeBreakAt 2 arr
      cnt1 = countLeadingBy (not . isSeparatorWord Windows) arr1
      sepOff = 2 + cnt1
  
      -- XXX there should be only one separator in a valid path?
      -- XXX it should either be UNC or two letter drive in a valid path
      (uncOff, uncLen) = parseSegment arr sepOff
      sepOff1 = uncOff + uncLen
      (serverOff, serverLen) = parseSegment arr sepOff1
  
  -- XXX should we make the root Maybe? Both components will have to be Maybe to
  -- avoid an empty path.
  -- XXX Should we keep the trailing separator in the directory components?
  
  {-# INLINE splitRoot #-}
  splitRoot :: (Unbox a, Integral a) => OS -> Array a -> (Array a, Array a)
  -- NOTE: validatePath depends on splitRoot splitting the path without removing
  -- any redundant chars etc. It should just split and do nothing else.
  -- XXX We can put an assert here "arrLen == rootLen + stemLen".
  -- XXX assert (isValidPath path == isValidPath root)
  --
  -- NOTE: we cannot drop the trailing "/" on the root even if we want to -
  -- because "c:/" will become "c:" and the two are not equivalent.
  splitRoot Posix arr
      | isRooted Posix arr
          = unsafeSplitTopLevel Posix arr
      | otherwise = (Array.empty, arr)
  splitRoot Windows arr
      | isRelativeCurDriveRoot arr || isRelativeCurDir Windows arr
          = unsafeSplitTopLevel Windows arr
      | hasDrive arr = unsafeSplitDrive arr
      | isAbsoluteUNC arr = unsafeSplitUNC arr
      | otherwise = (Array.empty, arr)
  
  ------------------------------------------------------------------------------
  -- Split path
  ------------------------------------------------------------------------------
  
  -- | Raw split an array on path separartor word using a filter to filter out
  -- some splits.
  {-# INLINE splitWithFilter #-}
  splitWithFilter
      :: (Unbox a, Integral a, Monad m)
      => ((Int, Int) -> Bool)
      -> Bool
      -> OS
      -> Array a
      -> Stream m (Array a)
  splitWithFilter filt withSep os arr =
        f (isSeparatorWord os) (Array.read arr)
      & Stream.filter filt
      & fmap (\(i, len) -> Array.unsafeSliceOffLen i len arr)
  
      where
  
      f = if withSep then Stream.indexEndBy else Stream.indexEndBy_
  
  -- | Split a path on separator chars and compact contiguous separators and
  -- remove /./ components. Note this does not treat the path root in a special
  -- way.
  {-# INLINE splitCompact #-}
  splitCompact
      :: (Unbox a, Integral a, Monad m)
      => Bool
      -> OS
      -> Array a
      -> Stream m (Array a)
  splitCompact withSep os arr =
      splitWithFilter (not . shouldFilterOut) withSep os arr
  
      where
  
      sepFilter (off, len) =
          ( len == 1
          && isSeparator os (unsafeIndexChar off arr)
          )
          ||
          -- Note, last component may have len == 2 but second char may not
          -- be slash, so we need to check for slash explicitly.
          --
          ( len == 2
          && unsafeIndexChar off arr == '.'
          && isSeparator os (unsafeIndexChar (off + 1) arr)
          )
  
      {-# INLINE shouldFilterOut #-}
      shouldFilterOut (off, len) =
          len == 0
              -- Note this is needed even when withSep is true - for the last
              -- component case.
              || (len == 1 && unsafeIndexChar off arr == '.')
              -- XXX Ensure that these are statically removed by GHC when withSep
              -- is False.
              || (withSep && sepFilter (off, len))
  
  -- Split a path into its components.
  --
  -- Usage:
  -- @
  -- splitPathUsing withSep ignoreLeading os arr
  -- @
  --
  -- if withSep == True then keep the trailing separators.
  --
  -- if ignoreLeading == True we drop all leading separators and relative paths.
  -- Example behaviour (psuedo-code):
  -- @
  -- > f = splitPathUsing (withSep = False) (ignoreLeading = True)
  -- > f "./a/b/c" == ["a","b","c"]
  -- > f "./a/./b/c" == ["a","b","c"]
  -- > f "/a/./b/c" == ["a","b","c"]
  -- > f "/./a/./b/c" == ["a","b","c"]
  -- > f "././a/./b/c" == ["a","b","c"]
  -- > f "a/./b/c" == ["a","b","c"]
  -- @
  --
  -- We can safely set @ignoreLeading = True@ if we splitRoot prior and only pass
  -- the stem of the path to this function.
  {-# INLINE splitPathUsing #-}
  splitPathUsing
      :: (Unbox a, Integral a, Monad m)
      => Bool
      -> Bool
      -> OS
      -> Array a
      -> Stream m (Array a)
  splitPathUsing withSep ignoreLeading os arr =
      let stream = splitCompact withSep os rest
      in if ignoreLeading || Array.null root
         then stream
         else Stream.cons root1 stream
  
      where
  
      -- We should not filter out a leading '.' on Posix or Windows.
      -- We should not filter out a '.' in the middle of a UNC root on windows.
      -- Therefore, we split the root and treat it in a special way.
      (root, rest) = splitRoot os arr
      root1 =
          if withSep
          then compactTrailingBy (isSeparator os . wordToChar) root
          else dropTrailingSeparators os root
  
  {-# INLINE splitPath_ #-}
  splitPath_
      :: (Unbox a, Integral a, Monad m)
      => OS -> Array a -> Stream m (Array a)
  splitPath_ = splitPathUsing False False
  
  {-# INLINE splitPath #-}
  splitPath
      :: (Unbox a, Integral a, Monad m)
      => OS -> Array a -> Stream m (Array a)
  splitPath = splitPathUsing True False
  
  -- | Split the first non-empty path component.
  --
  -- /Unimplemented/
  {-# INLINE splitHead #-}
  splitHead :: -- (Unbox a, Integral a) =>
      OS -> Array a -> (Array a, Maybe (Array a))
  splitHead _os _arr = undefined
  
  -- | Split the last non-empty path component.
  --
  -- /Unimplemented/
  {-# INLINE splitTail #-}
  splitTail :: -- (Unbox a, Integral a) =>
      OS -> Array a -> (Maybe (Array a), Array a)
  splitTail _os _arr = undefined
  
  ------------------------------------------------------------------------------
  -- File or Dir
  ------------------------------------------------------------------------------
  
  -- | Returns () if the path can be a valid file, otherwise throws an
  -- exception.
  validateFile :: (MonadThrow m, Unbox a, Integral a) => OS -> Array a -> m ()
  validateFile os arr = do
      s1 <-
              Stream.toList
                  $ Stream.take 3
                  $ Stream.takeWhile (not . isSeparator os)
                  $ fmap wordToChar
                  $ Array.readRev arr
      -- XXX On posix we just need to check last 3 bytes of the array
      -- XXX Display the path in the exception messages.
      case s1 of
          [] -> throwM $ InvalidPath "A file name cannot have a trailing separator"
          '.' : xs ->
              case xs of
                  [] -> throwM $ InvalidPath "A file name cannot have a trailing \".\""
                  '.' : [] ->
                      throwM $ InvalidPath "A file name cannot have a trailing \"..\""
                  _ -> pure ()
          _ -> pure ()
  
      case os of
          Windows ->
              -- XXX We can exclude a UNC root as well but just the UNC root is
              -- not even a valid path.
              when (isDrive arr)
                  $ throwM $ InvalidPath "A drive root is not a valid file name"
          Posix -> pure ()
  
  {-# INLINE splitFile #-}
  splitFile :: (Unbox a, Integral a) =>
      OS -> Array a -> Maybe (Maybe (Array a), Array a)
  splitFile os arr =
      let p x =
              if os == Windows
              then x == charToWord ':' || isSeparatorWord os x
              else isSeparatorWord os x
          -- XXX Use Array.revBreakEndBy?
          fileLen = runIdentity
                  $ Stream.fold (Fold.takeEndBy_ p Fold.length)
                  $ Array.readRev arr
          arrLen = Array.length arr
          baseLen = arrLen - fileLen
          (base, file) = Array.unsafeBreakAt baseLen arr
          fileFirst = Array.unsafeGetIndex 0 file
          fileSecond = Array.unsafeGetIndex 1 file
       in
          if fileLen > 0
              -- exclude the file == '.' case
              && not (fileLen == 1 && fileFirst == charToWord '.')
              -- exclude the file == '..' case
              && not (fileLen == 2
                  && fileFirst == charToWord '.'
                  && fileSecond == charToWord '.')
          then
              if baseLen <= 0
              then Just (Nothing, arr)
              else Just (Just $ Array.unsafeSliceOffLen 0 baseLen base, file) -- "/"
          else Nothing
  
  -- | Split a multi-component path into (dir, last component). If the path has a
  -- single component and it is a root then return (path, "") otherwise return
  -- ("", path).
  --
  -- Split a single component into (dir, "") if it can be a dir i.e. it is either
  -- a path root, "." or ".." or has a trailing separator.
  --
  -- The only difference between splitFile and splitDir:
  --
  -- >> splitFile "a/b/"
  -- ("a/b/", "")
  -- >> splitDir "a/b/"
  -- ("a/", "b/")
  --
  -- This is equivalent to splitPath and keeping the last component but is usually
  -- faster.
  --
  -- >>> toList (a,b) = (unpackPosix a, unpackPosix b)
  -- >>> splitPosix = toList . Common.splitDir Common.Posix . packPosix
  --
  -- >> splitPosix "/"
  -- ("/","")
  --
  -- >> splitPosix "."
  -- (".","")
  --
  -- >> splitPosix "/."
  -- ("/.","")
  --
  -- >> splitPosix "/x"
  -- ("/","x")
  --
  -- >> splitPosix "/x/"
  -- ("/","x/")
  --
  -- >> splitPosix "//"
  -- ("//","")
  --
  -- >> splitPosix "./x"
  -- ("./","x")
  --
  -- >> splitPosix "x"
  -- ("","x")
  --
  -- >> splitPosix "x/"
  -- ("x/","")
  --
  -- >> splitPosix "x/y"
  -- ("x/","y")
  --
  -- >> splitPosix "x/y/"
  -- ("x/","y/")
  --
  -- >> splitPosix "x/y//"
  -- ("x/","y//")
  --
  -- >> splitPosix "x//y"
  -- ("x//","y")
  --
  -- >> splitPosix "x/./y"
  -- ("x/./","y")
  --
  -- /Unimplemented/
  {-# INLINE splitDir #-}
  splitDir :: -- (Unbox a, Integral a) =>
      OS -> Array a -> (Array a, Array a)
  splitDir _os _arr = undefined
  
  ------------------------------------------------------------------------------
  -- Split extensions
  ------------------------------------------------------------------------------
  
  -- | Like split extension but we can specify the extension char to be used.
  {-# INLINE splitExtensionBy #-}
  splitExtensionBy :: (Unbox a, Integral a) =>
      a -> OS -> Array a -> Maybe (Array a, Array a)
  splitExtensionBy c os arr =
      let p x = x == c || isSeparatorWord os x
          -- XXX Use Array.revBreakEndBy_
          extLen = runIdentity
                  $ Stream.fold (Fold.takeEndBy p Fold.length)
                  $ Array.readRev arr
          arrLen = Array.length arr
          baseLen = arrLen - extLen
          -- XXX We can use reverse split operation on the array
          res@(base, ext) = Array.unsafeBreakAt baseLen arr
          baseLast = Array.unsafeGetIndexRev 0 base
          extFirst = Array.unsafeGetIndex 0 ext
       in
          -- For an extension to be present the path must be at least 3 chars.
          -- non-empty base followed by extension char followed by non-empty
          -- extension.
          if arrLen > 2
              -- If ext is empty, then there is no extension and we should not
              -- strip an extension char if any at the end of base.
              && extLen > 1
              && extFirst == c
              -- baseLast is always either base name char or '/' unless empty
              -- if baseLen is 0 then we have not found an extension.
              && baseLen > 0
              -- If baseLast is '/' then base name is empty which means it is a
              -- dot file and there is no extension.
              && not (isSeparatorWord os baseLast)
              -- On Windows if base is 'c:.' or a UNC path ending in '/c:.' then
              -- it is a dot file, no extension.
              && not (os == Windows && baseLast == charToWord ':')
          then Just res
          else Nothing
  
  {-# INLINE splitExtension #-}
  splitExtension :: (Unbox a, Integral a) => OS -> Array a -> Maybe (Array a, Array a)
  splitExtension = splitExtensionBy extensionWord
  
  {-
  -- Instead of this keep calling splitExtension until there is no more extension
  -- returned.
  {-# INLINE splitAllExtensionsBy #-}
  splitAllExtensionsBy :: (Unbox a, Integral a) =>
      Bool -> a -> OS -> Array a -> (Array a, Array a)
  -- If the isFileName arg is true, it means that the path supplied does not have
  -- any separator chars, so we can do it more efficiently.
  splitAllExtensionsBy isFileName extChar os arr =
      let file =
              if isFileName
              then arr
              else snd $ splitFile os arr
          fileLen = Array.length file
          arrLen = Array.length arr
          baseLen = foldArr (Fold.takeEndBy_ (== extChar) Fold.length) file
          extLen = fileLen - baseLen
       in
          -- XXX unsafeBreakAt itself should use Array.empty in case of no split
          if fileLen > 0 && extLen > 1 && extLen /= fileLen
          then (Array.unsafeBreakAt (arrLen - extLen) arr)
          else (arr, Array.empty)
  
  -- |
  --
  -- TODO: This function needs to be consistent with splitExtension. It should
  -- strip all valid extensions by that definition.
  --
  -- splitAllExtensions "x/y.tar.gz" gives ("x/y", ".tar.gz")
  --
  -- >>> toList (a,b) = (unpackPosix a, unpackPosix b)
  -- >>> splitPosix = toList . Common.splitAllExtensions Common.Posix . packPosix
  --
  -- >>> toListWin (a,b) = (unpackWindows a, unpackWindows b)
  -- >>> splitWin = toListWin . Common.splitAllExtensions Common.Windows . packWindows
  --
  -- >>> splitPosix "/"
  -- ("/","")
  --
  -- >>> splitPosix "."
  -- (".","")
  --
  -- >>> splitPosix "x"
  -- ("x","")
  --
  -- >>> splitPosix "/x"
  -- ("/x","")
  --
  -- >>> splitPosix "x/"
  -- ("x/","")
  --
  -- >>> splitPosix "./x"
  -- ("./x","")
  --
  -- >>> splitPosix "x/."
  -- ("x/.","")
  --
  -- >>> splitPosix "x/y."
  -- ("x/y.","")
  --
  -- >>> splitPosix "/x.y"
  -- ("/x",".y")
  --
  -- >>> splitPosix "x/.y"
  -- ("x/.y","")
  --
  -- >>> splitPosix ".x"
  -- (".x","")
  --
  -- >>> splitPosix "x."
  -- ("x.","")
  --
  -- >>> splitPosix ".x.y"
  -- (".x",".y")
  --
  -- >>> splitPosix "x/y.z"
  -- ("x/y",".z")
  --
  -- >>> splitPosix "x.y.z"
  -- ("x",".y.z")
  --
  -- >>> splitPosix "x..y" -- ??
  -- ("x.",".y")
  --
  -- >>> splitPosix ".."
  -- ("..","")
  --
  -- >>> splitPosix "..."
  -- ("...","")
  --
  -- >>> splitPosix "...x"
  -- ("...x","")
  --
  -- >>> splitPosix "x/y.z/"
  -- ("x/y.z/","")
  --
  -- >>> splitPosix "x/y"
  -- ("x/y","")
  --
  -- >>> splitWin "x:y"
  -- ("x:y","")
  --
  -- >>> splitWin "x:.y"
  -- ("x:.y","")
  --
  {-# INLINE splitAllExtensions #-}
  splitAllExtensions :: (Unbox a, Integral a) =>
      OS -> Array a -> (Array a, Array a)
  splitAllExtensions = splitAllExtensionsBy False extensionWord
  -}
  
  ------------------------------------------------------------------------------
  -- Construction
  ------------------------------------------------------------------------------
  
  {-# INLINE isInvalidPathChar #-}
  isInvalidPathChar :: Integral a => OS -> a -> Bool
  isInvalidPathChar Posix x = x == 0
  isInvalidPathChar Windows x =
      -- case should be faster than list search
      case x of
          34 -> True -- '"'
          42 -> True -- '*'
          58 -> True -- ':'
          60 -> True -- '<'
          62 -> True -- '>'
          63 -> True -- '?'
          124 -> True -- '|'
          _ -> x <= charToWord '\US'
  
  countLeadingValid :: (Unbox a, Integral a) => OS -> Array a -> Int
  countLeadingValid os path =
      let f = Fold.takeEndBy_ (isInvalidPathChar os) Fold.length
       in foldArr f path
  
  -- XXX Supply it an array for checking and use a more efficient prefix matching
  -- check.
  
  -- | Only for windows.
  isInvalidPathComponent :: Integral a => [[a]]
  isInvalidPathComponent = fmap (fmap charToWord)
      [ "CON","PRN","AUX","NUL","CLOCK$"
      , "COM1","COM2","COM3","COM4","COM5","COM6","COM7","COM8","COM9"
      , "LPT1","LPT2","LPT3","LPT4","LPT5","LPT6","LPT7","LPT8","LPT9"
      ]
  
  {- HLINT ignore "Use when" -}
  validatePathWith :: (MonadThrow m, Integral a, Unbox a) =>
      Bool -> OS -> Array a -> m ()
  validatePathWith _ Posix path =
      let pathLen = Array.length path
          validLen = countLeadingValid Posix path
       in if pathLen == 0
          then throwM $ InvalidPath "Empty path"
          else if pathLen /= validLen
          then throwM $ InvalidPath
              $ "Null char found after " ++ show validLen ++ " characters."
          else pure ()
  validatePathWith allowRoot Windows path
    | Array.null path = throwM $ InvalidPath "Empty path"
    | otherwise = do
          if hasDrive path && postDriveSep > 1 -- "C://"
          then throwM $ InvalidPath
              "More than one separators between drive root and the path"
          else if isAbsoluteUNC path
          then
              if postDriveSep > 1 -- "///x"
              then throwM $ InvalidPath
                  "Path starts with more than two separators"
              else if invalidRootComponent -- "//prn/x"
              then throwM $ InvalidPath
                  -- XXX print the invalid component name
                  "Special filename component found in share root"
              else if rootEndSeps /= 1 -- "//share//x"
              then throwM $ InvalidPath
                  $ "Share name is needed and exactly one separator is needed "
                  ++ "after the share root"
              else if not allowRoot && Array.null stem -- "//share/"
              then throwM $ InvalidPath
                  "the share root must be followed by a non-empty path"
              else pure ()
          else pure ()
  
          if stemLen /= validStemLen -- "x/x>y"
          then throwM $ InvalidPath
              $ "Disallowed char found after "
              ++ show (rootLen + validStemLen)
              ++ " characters. The invalid char is: "
              ++ show (chr (fromIntegral invalidVal))
              ++ " [" ++ show invalidVal ++ "]"
          else if invalidComponent -- "x/prn/y"
          -- XXX print the invalid component name
          then throwM $ InvalidPath "Disallowed Windows filename in path"
          else pure ()
  
      where
  
      postDrive = snd $ Array.unsafeBreakAt 2 path
      postDriveSep = countLeadingBy (isSeparatorWord Windows) postDrive
  
      -- XXX check invalid chars in the path root as well - except . and '?'?
      (root, stem) = splitRoot Windows path
      rootLen = Array.length root
      stemLen = Array.length stem
      validStemLen = countLeadingValid Windows stem
      invalidVal = fromIntegral (Array.unsafeGetIndex validStemLen stem) :: Word16
  
      rootEndSeps  = countTrailingBy (isSeparatorWord Windows) root
  
      -- TBD: We are not currently validating the sharenames against disallowed
      -- file names. Apparently windows does not allow even sharenames with those
      -- names. To match against sharenames we will have to strip the separators
      -- and drive etc from the root. Or we can use the parsing routines
      -- themselves to validate.
      toUp w16 =
          if w16 < 256
          then charToWord $ toUpper (wordToChar w16)
          else w16
  
      -- Should we strip all space chars as in Data.Char.isSpace?
      isSpace x = x == charToWord ' '
  
      -- XXX instead of using a list based check, pass the array to the checker.
      -- We do not need to upcase the array, it can be done in the checker. Thus
      -- we do not need to create a new array, the original slice can be checked.
      getBaseName x =
            runIdentity
          $ Stream.toList
          $ fmap toUp
          $ Array.read
          $ Array.dropAround isSpace
          $ fst $ Array.breakEndBy_ (== extensionWord) x
  
      components =
            runIdentity
          . Stream.toList
          . fmap getBaseName
          . splitCompact False Windows
  
      invalidRootComponent =
          List.any (`List.elem` isInvalidPathComponent) (components root)
      invalidComponent =
          List.any (`List.elem` isInvalidPathComponent) (components stem)
  
  -- | A valid root, share root or a valid path.
  {-# INLINE validatePath #-}
  validatePath :: (MonadThrow m, Integral a, Unbox a) => OS -> Array a -> m ()
  validatePath = validatePathWith True
  
  {-# INLINE validatePath' #-}
  validatePath' :: (MonadThrow m, Integral a, Unbox a) => OS -> Array a -> m ()
  validatePath' = validatePathWith False
  
  {-# INLINE unsafeFromArray #-}
  unsafeFromArray :: Array a -> Array a
  unsafeFromArray = id
  
  {-# INLINE fromArray #-}
  fromArray :: forall m a. (MonadThrow m, Unbox a, Integral a) =>
      OS -> Array a -> m (Array a)
  fromArray os arr = validatePath os arr >> pure arr
  {-
      let arr1 = Array.unsafeCast arr :: Array a
       in validatePath os arr1 >> pure arr1
  fromArray Windows arr =
      case Array.cast arr of
          Nothing ->
              throwM
                  $ InvalidPath
                  $ "Encoded path length " ++ show (Array.byteLength arr)
                      ++ " is not a multiple of 16-bit."
          Just x -> validatePath Windows x >> pure x
  -}
  
  {-# INLINE unsafeFromChars #-}
  unsafeFromChars :: (Unbox a) =>
         (Stream Identity Char -> Stream Identity a)
      -> Stream Identity Char
      -> Array a
  unsafeFromChars encode s =
      let n = runIdentity $ Stream.fold Fold.length s
       in Array.fromPureStreamN n (encode s)
  
  -- XXX Writing a custom fold for parsing a Posix path may be better for
  -- efficient bulk parsing when needed. We need the same code to validate a
  -- Chunk where we do not need to create an array.
  {-# INLINE fromChars #-}
  fromChars :: (MonadThrow m, Unbox a, Integral a) =>
         OS
      -> (Stream Identity Char -> Stream Identity a)
      -> Stream Identity Char
      -> m (Array a)
  fromChars os encode s =
      let arr = unsafeFromChars encode s
       in fromArray os (Array.unsafeCast arr)
  
  {-# INLINE toChars #-}
  toChars :: (Monad m, Unbox a) =>
      (Stream m a -> Stream m Char) -> Array a -> Stream m Char
  toChars decode arr = decode $ Array.read arr
  
  {-# INLINE toString #-}
  toString :: Unbox a =>
      (Stream Identity a -> Stream Identity Char) -> Array a -> [Char]
  toString decode = runIdentity . Stream.toList . toChars decode
  
  ------------------------------------------------------------------------------
  -- Statically Verified Literals
  ------------------------------------------------------------------------------
  
  -- XXX pass the quote name for errors?
  mkQ :: (String -> Q Exp) -> QuasiQuoter
  mkQ f =
    QuasiQuoter
    { quoteExp  = f
    , quotePat  = err "pattern"
    , quoteType = err "type"
    , quoteDec  = err "declaration"
    }
  
    where
  
    err x _ = fail $ "QuasiQuote used as a " ++ x
      ++ ", can be used only as an expression"
  
  ------------------------------------------------------------------------------
  -- Operations of Path
  ------------------------------------------------------------------------------
  
  -- See also cstringLength# in GHC.CString in ghc-prim
  foreign import ccall unsafe "string.h strlen" c_strlen_pinned
      :: Addr# -> IO CSize
  
  {-# INLINE appendCStringWith #-}
  appendCStringWith ::
         (Int -> IO (MutArray Word8))
      -> OS
      -> Array Word8
      -> CString
      -> IO (Array Word8)
  appendCStringWith create os a b@(Ptr addrB#) = do
      let lenA = Array.length a
      lenB <- fmap fromIntegral $ c_strlen_pinned addrB#
      assertM(lenA /= 0 && lenB /= 0)
      let len = lenA + 1 + lenB
      arr <- create len
      arr1 <- MutArray.unsafeSplice arr (Array.unsafeThaw a)
      arr2 <- MutArray.unsafeSnoc arr1 (charToWord (primarySeparator os))
      arr3 :: MutArray.MutArray Word8 <-
          MutArray.unsafeAppendPtrN arr2 (castPtr b) lenB
      return (Array.unsafeFreeze arr3)
  
  {-# INLINE appendCString #-}
  appendCString :: OS -> Array Word8 -> CString -> IO (Array Word8)
  appendCString = appendCStringWith MutArray.emptyOf
  
  {-# INLINE appendCString' #-}
  appendCString' :: OS -> Array Word8 -> CString -> IO (Array Word8)
  appendCString' = appendCStringWith MutArray.emptyOf'
  
  {-# INLINE doAppend #-}
  doAppend :: (Unbox a, Integral a) => OS -> Array a -> Array a -> Array a
  doAppend os a b = unsafePerformIO $ do
      let lenA = Array.length a
          lenB = Array.length b
      assertM(lenA /= 0 && lenB /= 0)
      let lastA = Array.unsafeGetIndexRev 0 a
          sepA = isSeparatorWord os lastA
          sepB = isSeparatorWord os (Array.unsafeGetIndex 0 b)
      let len = lenA + 1 + lenB
      arr <- MutArray.emptyOf len
      arr1 <- MutArray.unsafeSplice arr (Array.unsafeThaw a)
      arr2 <-
              if     lenA /= 0
                  && lenB /= 0
                  && not sepA
                  && not sepB
                  && not (os == Windows && lastA == charToWord ':')
              then MutArray.unsafeSnoc arr1 (charToWord (primarySeparator os))
              else pure arr1
      -- Note: if the last char on the first array is ":" and first char on the
      -- second array is "/" then we cannot drop the "/". We drop only if both
      -- are separators excluding ":".
      let arrB =
              if sepA && sepB
              then snd $ Array.unsafeBreakAt 1 b
              else b
      arr3 <- MutArray.unsafeSplice arr2 (Array.unsafeThaw arrB)
      return (Array.unsafeFreeze arr3)
  
  {-# INLINE withAppendCheck #-}
  withAppendCheck :: (Unbox b, Integral b) =>
      OS -> (Array b -> String) -> Array b -> a -> a
  withAppendCheck os toStr arr f =
      if isRooted os arr
      then error $ "append: cannot append a rooted path " ++ toStr arr
      else f
  
  {-# INLINE unsafeAppend #-}
  unsafeAppend :: (Unbox a, Integral a) =>
      OS -> (Array a -> String) -> Array a -> Array a -> Array a
  unsafeAppend os _toStr = doAppend os
  
  {-# INLINE append #-}
  append :: (Unbox a, Integral a) =>
      OS -> (Array a -> String) -> Array a -> Array a -> Array a
  append os toStr a b = withAppendCheck os toStr b (doAppend os a b)
  
  {-# INLINE append' #-}
  append' :: (Unbox a, Integral a) =>
      OS -> (Array a -> String) -> Array a -> Array a -> Array a
  append' os toStr a b =
      let hasSep = countTrailingBy (isSeparatorWord os) a > 0
          hasColon =
                 os == Windows
              && Array.getIndexRev 0 a == Just (charToWord ':')
       in if hasSep || hasColon
          then withAppendCheck os toStr b (doAppend os a b)
          else error
                  $ "append': first path must be dir like i.e. must have a "
                  ++ "trailing separator or colon on windows: " ++ toStr a
  
  -- XXX MonadIO?
  
  -- | Join paths by path separator. Does not check if the paths being appended
  -- are rooted or path segments. Note that splitting and joining may not give
  -- exactly the original path but an equivalent, normalized path.
  {-# INLINE unsafeJoinPaths #-}
  unsafeJoinPaths
      :: (Unbox a, Integral a, MonadIO m)
      => OS -> Stream m (Array a) -> m (Array a)
  unsafeJoinPaths os =
      -- XXX This can be implemented more efficiently using an Array intersperse
      -- operation. Which can be implemented by directly copying arrays rather
      -- than converting them to stream first. Also fromStreamN would be more
      -- efficient if we have to use streams.
      -- XXX We can remove leading and trailing separators first, if any, except
      -- the leading separator from the first path. But it is not necessary.
      -- Instead we can avoid adding a separator if it is already present.
      Array.fromStream . Array.concatSepBy (charToWord $ primarySeparator os)
  
  ------------------------------------------------------------------------------
  -- Equality
  ------------------------------------------------------------------------------
  
  eqPathBytes :: Array a -> Array a -> Bool
  eqPathBytes = Array.byteEq
  
  -- On posix macOs can have case insensitive comparison. On Windows also
  -- case sensitive behavior may depend on the file system being used.
  
  -- Use eq prefix?
  
  -- | 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
      -- ^ A leading dot is ignored, thus ".\/x" == ".\/x" and ".\/x" == "x".
      -- On Windows allows "\/x" == \/x" and "C:x == C:x"
  
      -- , resolveParentReferences -- "x\/..\/y" == "y"
      -- , noIgnoreRedundantSeparators -- "x\/\/y" \/= "x\/y"
      -- , noIgnoreRedundantDot -- "x\/.\/" \/= "x"
      }
  
  data PosixRoot = PosixRootAbs | PosixRootRel deriving Eq
  
  data WindowsRoot =
        WindowsRootPosix -- /x or ./x
      | WindowsRootNonPosix -- C:... or \\...
      deriving Eq
  
  -- | Change to upper case and replace separators by primary separator
  {-# INLINE normalizeCaseAndSeparators #-}
  normalizeCaseAndSeparators :: Monad m => Array Word16 -> Stream m Char
  normalizeCaseAndSeparators =
        fmap toUpper
      . Unicode.decodeUtf16le'
      . fmap toDefaultSeparator
      . Array.read
  
  {-# INLINE normalizeCaseWith #-}
  normalizeCaseWith :: (Monad m, Unbox a) =>
      (Stream m a -> Stream m Char) -> Array a -> Stream m Char
  normalizeCaseWith decoder =
        fmap toUpper
      . decoder
      . Array.read
  
  eqWindowsRootStrict :: (Unbox a, Integral a) =>
      Bool -> Array a -> Array a -> Bool
  eqWindowsRootStrict ignCase a b =
      let f = normalizeCaseAndSeparators
       in if ignCase
          then
              -- XXX We probably do not want to equate UNC with UnC etc.
              runIdentity
                  $ Stream.eqBy (==)
                      (f $ Array.unsafeCast a) (f $ Array.unsafeCast b)
          else
              runIdentity
                  $ Stream.eqBy (==)
                      (fmap toDefaultSeparator $ Array.read a)
                      (fmap toDefaultSeparator $ Array.read b)
  
  {-# INLINE eqRootStrict #-}
  eqRootStrict :: (Unbox a, Integral a) =>
      Bool -> OS -> Array a -> Array a -> Bool
  eqRootStrict _ Posix a b =
      -- a can be "/" and b can be "//"
      -- We call this only when the roots are either absolute or null.
      Array.null a == Array.null b
  eqRootStrict ignCase Windows a b = eqWindowsRootStrict ignCase a b
  
  -- | Compare Posix roots or Windows roots without a drive or share name.
  {-# INLINE eqPosixRootLax #-}
  eqPosixRootLax :: (Unbox a, Integral a) => Array a -> Array a -> Bool
  eqPosixRootLax a b = getRoot a == getRoot b
  
      where
  
      -- Can only be either "", '.', './' or '/' (or Windows separators)
      getRoot arr =
          if Array.null arr || unsafeIndexChar 0 arr == '.'
          then PosixRootRel
          else PosixRootAbs
  
  {-# INLINABLE eqRootLax #-}
  eqRootLax :: (Unbox a, Integral a) => Bool -> OS -> Array a -> Array a -> Bool
  eqRootLax _ Posix a b = eqPosixRootLax a b
  eqRootLax ignCase Windows a b =
      let aType = getRootType a
          bType = getRootType b
       in aType == bType
          && (
              (aType == WindowsRootPosix && eqPosixRootLax a b)
              || eqWindowsRootStrict ignCase a b
             )
  
      where
  
      getRootType arr =
          if isAbsoluteUNC arr || hasDrive arr
          then WindowsRootNonPosix
          else WindowsRootPosix
  
  {-# INLINE eqComponentsWith #-}
  eqComponentsWith :: (Unbox a, Integral a) =>
         EqCfg
      -> (Stream Identity a -> Stream Identity Char)
      -> OS
      -> Array a
      -> Array a
      -> Bool
  eqComponentsWith EqCfg{..} decoder os a b =
      if _ignoreCase
      then
          let streamEq x y = runIdentity $ Stream.eqBy (==) x y
              toComponents = fmap (normalizeCaseWith decoder) . splitter os
          -- XXX check perf/fusion
           in runIdentity
                  $ Stream.eqBy streamEq (toComponents a) (toComponents b)
      else
          runIdentity
              $ Stream.eqBy
                  Array.byteEq (splitter os a) (splitter os b)
      where
      splitter = splitPathUsing False _allowRelativeEquality
  
  -- XXX can we do something like SpecConstr for such functions e.g. without
  -- 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 eqPath #-}
  eqPath :: (Unbox a, Integral a) =>
      (Stream Identity a -> Stream Identity Char)
      -> OS -> EqCfg -> Array a -> Array a -> Bool
  eqPath decoder os eqCfg@(EqCfg{..}) a b =
      let (rootA, stemA) = splitRoot os a
          (rootB, stemB) = splitRoot os b
  
          eqRelative =
                 if _allowRelativeEquality
                 then eqRootLax _ignoreCase os rootA rootB
                 else (not (isRootRelative os rootA)
                      && not (isRootRelative os 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
                  || hasTrailingSeparator os a == hasTrailingSeparator os b
  
       in
             eqRelative
          && eqTrailingSep
          && eqComponentsWith eqCfg decoder os stemA stemB
  