{-# LANGUAGE TemplateHaskell #-}

-- |
-- Module      : Streamly.Internal.FileSystem.Path
-- Copyright   : (c) 2023 Composewell Technologies
-- License     : BSD3
-- Maintainer  : streamly@composewell.com
-- Portability : GHC
--
-- Well typed and flexible file systems paths, preserving the OS and filesystem
-- encoding.
--
-- You can choose the level of type safety you want. 'Path' is the basic path
-- type which can represent a file, directory, absolute or relative path with
-- no restrictions. Depending on how much type safety you want you can choose
-- appropriate type wrappers to wrap 'Path'. @File Path@ mandates the path to
-- be a file whereas @Abs (File Path)@ mandates it to be an absolute path
-- representing a file.
--
-- You can upgrade or downgrade the safety. Whenever a less restrictive path
-- type is converted to a more restrctive path type the conversion involves
-- checks and it may fail. However, a more restrictive path type can be freely
-- converted to a less restrictive one.
--
-- See the @streamly-filepath@ package for interworking with the 'OsPath' type.
-- The 'Path' type can be  converted to and from 'OsPath' type at zero cost
-- since the underlying representation of both is the same.

-- Conventions: A trailing separator on a path indicates that it is a directory.
-- However, the absence of a trailing separator does not convey any
-- information, it could either be a directory or a file.

-- You may also find the 'str' quasiquoter from "Streamly.Unicode.String" to be
-- useful in creating paths.
--
module Streamly.Internal.FileSystem.Path
    (
    -- * Path Types
      Path (..)
    , File
    , Dir
    , Abs
    , Rel

    -- * Conversions
    , IsPath (..)
    , adaptPath

    -- * Construction
    , fromChunk
    , fromChunkUnsafe
    , fromString
    , fromChars

    -- * Statically Verified Literals
    -- quasiquoters
    , path
    , abs
    , rel
    , dir
    , file
    , absdir
    , reldir
    , absfile
    , relfile

    -- * Statically Verified Strings
    -- TH macros
    , mkPath
    , mkAbs
    , mkRel
    , mkDir
    , mkFile
    , mkAbsDir
    , mkRelDir
    , mkAbsFile
    , mkRelFile

    -- * Elimination
    , toChunk
    , toString
    , toChars

    -- * Operations
    -- Do we need to export the separator functions? They are not essential if
    -- operations to split and combine paths are provided. If someone wants to
    -- work on paths at low level then they know what they are.
    , primarySeparator
    , isSeparator
    , extendPath
    , extendDir
    )
where

import Control.Exception (Exception)
import Control.Monad.Catch (MonadThrow(..))
import Data.Char (chr)
import Data.Functor.Identity (Identity(..))
import Data.Word (Word8)
#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
import Data.Word (Word16)
#endif
import Language.Haskell.TH (Q, Exp)
import Language.Haskell.TH.Quote (QuasiQuoter)
import Streamly.Internal.Data.Array (Array)
import Streamly.Internal.Data.Stream (Stream)
import System.IO.Unsafe (unsafePerformIO)

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

import Prelude hiding (abs)

#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
#define WORD_TYPE Word16
#define SEPARATOR 92
#else
#define WORD_TYPE Word8
#define SEPARATOR 47
#endif

------------------------------------------------------------------------------
-- Exceptions
------------------------------------------------------------------------------

-- | Exceptions thrown by path operations.
data PathException =
    InvalidPath String
  | InvalidAbsPath String
  | InvalidRelPath String
  | InvalidFilePath String
  | InvalidDirPath String
    deriving (Int -> PathException -> ShowS
[PathException] -> ShowS
PathException -> String
(Int -> PathException -> ShowS)
-> (PathException -> String)
-> ([PathException] -> ShowS)
-> Show PathException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PathException -> ShowS
showsPrec :: Int -> PathException -> ShowS
$cshow :: PathException -> String
show :: PathException -> String
$cshowList :: [PathException] -> ShowS
showList :: [PathException] -> ShowS
Show,PathException -> PathException -> Bool
(PathException -> PathException -> Bool)
-> (PathException -> PathException -> Bool) -> Eq PathException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PathException -> PathException -> Bool
== :: PathException -> PathException -> Bool
$c/= :: PathException -> PathException -> Bool
/= :: PathException -> PathException -> Bool
Eq)

instance Exception PathException

-- XXX Path must not contain null char on Posix. System calls consider the path
-- as null terminated.
-- XXX Maintain the Array with null termination because Unix system calls
-- require a null terminated string, also they return null terminated strings
-- as paths. Implementation of path append will have to handle the null
-- termination. Or we can choose to always copy the array when using it in
-- system calls.

-- XXX The eq instance needs to make sure that the paths are equivalent. If we
-- normalize the paths we can do a byte comparison. However, on windows paths
-- are case insensitive but the case is preserved, therefore, we cannot
-- normalize and need to do case insensitive comparison.

------------------------------------------------------------------------------
-- Types
------------------------------------------------------------------------------

-- | A type representing file system paths for directories or files.
newtype Path = Path (Array WORD_TYPE) -- deriving Eq

-- Show instance prints raw bytes without any decoding for rountdtripping.
-- Should we print this as a string instead, may be useful for ascii chars but
-- utf8 encoded chars may be unprintable. Better use toString if you want to
-- pretty print the path.
{-
instance Show Path where
    show (Path x) = show x
-}

-- XXX Do we need a type for file or dir Name as names cannot have the
-- separator char and there may be other restrictions on names? For example,
-- length restriction.  A file name cannot be "." or "..". We can use the types
-- "File Name" and "Dir Name" to represent names. Also, file systems may put
-- limits on names. Can have an IsName type class with members Name, (File
-- Name), (Dir Name).

-- | A type representing a file path.
newtype File a = File a

-- | A type representing a directory path.
newtype Dir a = Dir a

-- | A type representing absolute paths.
newtype Abs a = Abs a

-- | A type representing relative paths.
newtype Rel a = Rel a

------------------------------------------------------------------------------
-- Conversions
------------------------------------------------------------------------------

-- | A member of 'IsPath' knows how to convert to and from the 'Path' type.
class IsPath a where
    -- | Like 'fromPath' but does not check the properties of 'Path'. Provides
    -- performance and simplicity when we know that the properties of the path
    -- are already verified, for example, when we get the path from the file
    -- system or the OS APIs.
    fromPathUnsafe :: Path -> a

    -- | Convert a raw 'Path' to other forms of well-typed paths. It may fail
    -- if the path does not satisfy the properties of the target type.
    --
    -- Path components may have limits.
    -- Total path length may have a limit.
    fromPath :: MonadThrow m => Path -> m a

    -- | Convert a well-typed path to a raw 'Path'. Never fails.
    toPath :: a -> Path

instance IsPath Path where
    fromPathUnsafe :: Path -> Path
fromPathUnsafe = Path -> Path
forall a. a -> a
id
    fromPath :: forall (m :: * -> *). MonadThrow m => Path -> m Path
fromPath = Path -> m Path
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    toPath :: Path -> Path
toPath = Path -> Path
forall a. a -> a
id

instance IsPath (File Path) where
    fromPathUnsafe :: Path -> File Path
fromPathUnsafe Path
p = Path -> File Path
forall a. a -> File a
File Path
p
    fromPath :: forall (m :: * -> *). MonadThrow m => Path -> m (File Path)
fromPath Path
p = File Path -> m (File Path)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path -> File Path
forall a. a -> File a
File Path
p)
    toPath :: File Path -> Path
toPath (File Path
p) = Path
p

instance IsPath (Dir Path) where
    fromPathUnsafe :: Path -> Dir Path
fromPathUnsafe Path
p = Path -> Dir Path
forall a. a -> Dir a
Dir Path
p
    fromPath :: forall (m :: * -> *). MonadThrow m => Path -> m (Dir Path)
fromPath Path
p = Dir Path -> m (Dir Path)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path -> Dir Path
forall a. a -> Dir a
Dir Path
p)
    toPath :: Dir Path -> Path
toPath (Dir Path
p) = Path
p

instance IsPath (Abs Path) where
    fromPathUnsafe :: Path -> Abs Path
fromPathUnsafe Path
p = Path -> Abs Path
forall a. a -> Abs a
Abs Path
p
    fromPath :: forall (m :: * -> *). MonadThrow m => Path -> m (Abs Path)
fromPath Path
p = Abs Path -> m (Abs Path)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path -> Abs Path
forall a. a -> Abs a
Abs Path
p)
    toPath :: Abs Path -> Path
toPath (Abs Path
p) = Path
p

instance IsPath (Rel Path) where
    fromPathUnsafe :: Path -> Rel Path
fromPathUnsafe Path
p = Path -> Rel Path
forall a. a -> Rel a
Rel Path
p
    fromPath :: forall (m :: * -> *). MonadThrow m => Path -> m (Rel Path)
fromPath Path
p = Rel Path -> m (Rel Path)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path -> Rel Path
forall a. a -> Rel a
Rel Path
p)
    toPath :: Rel Path -> Path
toPath (Rel Path
p) = Path
p

instance IsPath (Abs (File Path)) where
    fromPathUnsafe :: Path -> Abs (File Path)
fromPathUnsafe Path
p = File Path -> Abs (File Path)
forall a. a -> Abs a
Abs (Path -> File Path
forall a. a -> File a
File Path
p)
    fromPath :: forall (m :: * -> *). MonadThrow m => Path -> m (Abs (File Path))
fromPath Path
p = Abs (File Path) -> m (Abs (File Path))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (File Path -> Abs (File Path)
forall a. a -> Abs a
Abs (Path -> File Path
forall a. a -> File a
File Path
p))
    toPath :: Abs (File Path) -> Path
toPath (Abs (File Path
p)) = Path
p

instance IsPath (Abs (Dir Path)) where
    fromPathUnsafe :: Path -> Abs (Dir Path)
fromPathUnsafe Path
p = Dir Path -> Abs (Dir Path)
forall a. a -> Abs a
Abs (Path -> Dir Path
forall a. a -> Dir a
Dir Path
p)
    fromPath :: forall (m :: * -> *). MonadThrow m => Path -> m (Abs (Dir Path))
fromPath Path
p = Abs (Dir Path) -> m (Abs (Dir Path))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Dir Path -> Abs (Dir Path)
forall a. a -> Abs a
Abs (Path -> Dir Path
forall a. a -> Dir a
Dir Path
p))
    toPath :: Abs (Dir Path) -> Path
toPath (Abs (Dir Path
p)) = Path
p

instance IsPath (Rel (File Path)) where
    fromPathUnsafe :: Path -> Rel (File Path)
fromPathUnsafe Path
p = File Path -> Rel (File Path)
forall a. a -> Rel a
Rel (Path -> File Path
forall a. a -> File a
File Path
p)
    fromPath :: forall (m :: * -> *). MonadThrow m => Path -> m (Rel (File Path))
fromPath Path
p = Rel (File Path) -> m (Rel (File Path))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (File Path -> Rel (File Path)
forall a. a -> Rel a
Rel (Path -> File Path
forall a. a -> File a
File Path
p))
    toPath :: Rel (File Path) -> Path
toPath (Rel (File Path
p)) = Path
p

instance IsPath (Rel (Dir Path)) where
    fromPathUnsafe :: Path -> Rel (Dir Path)
fromPathUnsafe Path
p = Dir Path -> Rel (Dir Path)
forall a. a -> Rel a
Rel (Path -> Dir Path
forall a. a -> Dir a
Dir Path
p)
    fromPath :: forall (m :: * -> *). MonadThrow m => Path -> m (Rel (Dir Path))
fromPath Path
p = Rel (Dir Path) -> m (Rel (Dir Path))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Dir Path -> Rel (Dir Path)
forall a. a -> Rel a
Rel (Path -> Dir Path
forall a. a -> Dir a
Dir Path
p))
    toPath :: Rel (Dir Path) -> Path
toPath (Rel (Dir Path
p)) = Path
p

-- XXX Use rewrite rules to eliminate intermediate conversions for better
-- efficiency.

-- | Convert a path type to another path type. This operation may fail with a
-- 'PathException' when converting a less restrictive path type to a more
-- restrictive one.
adaptPath :: (MonadThrow m, IsPath a, IsPath b) => a -> m b
adaptPath :: forall (m :: * -> *) a b.
(MonadThrow m, IsPath a, IsPath b) =>
a -> m b
adaptPath a
p = Path -> m b
forall a (m :: * -> *). (IsPath a, MonadThrow m) => Path -> m a
forall (m :: * -> *). MonadThrow m => Path -> m b
fromPath (Path -> m b) -> Path -> m b
forall a b. (a -> b) -> a -> b
$ a -> Path
forall a. IsPath a => a -> Path
toPath a
p

------------------------------------------------------------------------------
-- Construction
------------------------------------------------------------------------------

-- A chunk is essentially an untyped Array i.e. Array Word8.  We can either use
-- the term ByteArray for that or just Chunk. The latter is shorter and we have
-- been using it consistently in streamly.

-- | /Unsafe/: On Posix, a path cannot contain null characters. On Windows, the
-- array passed must be a multiple of 2 bytes as the underlying representation
-- uses 'Word16'.
{-# INLINE fromChunkUnsafe #-}
fromChunkUnsafe :: Array Word8 -> Path
fromChunkUnsafe :: Array Word8 -> Path
fromChunkUnsafe Array Word8
arr = Array Word8 -> Path
Path (Array Word8 -> Array Word8
forall a b. Array a -> Array b
Array.castUnsafe Array Word8
arr)

-- | On Posix it may fail if the byte array contains null characters. On
-- Windows the array passed must be a multiple of 2 bytes as the underlying
-- representation uses 'Word16'.
--
-- Throws 'InvalidPath'.
fromChunk :: MonadThrow m => Array Word8 -> m Path
fromChunk :: forall (m :: * -> *). MonadThrow m => Array Word8 -> m Path
fromChunk Array Word8
arr =
    case Array Word8 -> Maybe (Array Word8)
forall a b. Unbox b => Array a -> Maybe (Array b)
Array.cast Array Word8
arr of
        Maybe (Array Word8)
Nothing ->
            -- XXX Windows only message.
            PathException -> m Path
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM
                (PathException -> m Path) -> PathException -> m Path
forall a b. (a -> b) -> a -> b
$ String -> PathException
InvalidPath
                (String -> PathException) -> String -> PathException
forall a b. (a -> b) -> a -> b
$ String
"Encoded path length " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Array Word8 -> Int
forall a. Array a -> Int
Array.byteLength Array Word8
arr)
                    String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is not a multiple of 16-bit."
        Just Array Word8
x -> Path -> m Path
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Array Word8 -> Path
Path Array Word8
x)

-- | Convert 'Path' to an array of bytes.
toChunk :: Path -> Array Word8
toChunk :: Path -> Array Word8
toChunk (Path Array Word8
arr) = Array Word8 -> Array Word8
forall a. Array a -> Array Word8
Array.asBytes Array Word8
arr

-- | Encode a Unicode char stream to 'Path' using strict UTF-8 encoding on
-- Posix. On Posix it may fail if the stream contains null characters.
-- TBD: Use UTF16LE on Windows.
fromChars :: MonadThrow m => Stream Identity Char -> m Path
fromChars :: forall (m :: * -> *).
MonadThrow m =>
Stream Identity Char -> m Path
fromChars Stream Identity Char
s =
    let n :: Int
n = Identity Int -> Int
forall a. Identity a -> a
runIdentity (Identity Int -> Int) -> Identity Int -> Int
forall a b. (a -> b) -> a -> b
$ Fold Identity Char Int -> Stream Identity Char -> Identity Int
forall (m :: * -> *) a b.
Monad m =>
Fold m a b -> Stream m a -> m b
Stream.fold Fold Identity Char Int
forall (m :: * -> *) a. Monad m => Fold m a Int
Fold.length Stream Identity Char
s
#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
     in pure $ Path (Array.fromPureStreamN n (Unicode.encodeUtf16le' s))
#else
     in Path -> m Path
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path -> m Path) -> Path -> m Path
forall a b. (a -> b) -> a -> b
$ Array Word8 -> Path
Path (Int -> Stream Identity Word8 -> Array Word8
forall a. Unbox a => Int -> Stream Identity a -> Array a
Array.fromPureStreamN Int
n (Stream Identity Char -> Stream Identity Word8
forall (m :: * -> *). Monad m => Stream m Char -> Stream m Word8
Unicode.encodeUtf8' Stream Identity Char
s))
#endif

-- | Decode the path to a stream of Unicode chars using strict UTF-8 decoding
-- on Posix.
-- TBD: Use UTF16LE on Windows.
toChars :: Monad m => Path -> Stream m Char
toChars :: forall (m :: * -> *). Monad m => Path -> Stream m Char
toChars (Path Array Word8
arr) =
#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
    Unicode.decodeUtf16le' $ Array.read arr
#else
    Stream m Word8 -> Stream m Char
forall (m :: * -> *). Monad m => Stream m Word8 -> Stream m Char
Unicode.decodeUtf8' (Stream m Word8 -> Stream m Char)
-> Stream m Word8 -> Stream m Char
forall a b. (a -> b) -> a -> b
$ Array Word8 -> Stream m Word8
forall (m :: * -> *) a. (Monad m, Unbox a) => Array a -> Stream m a
Array.read Array Word8
arr
#endif

-- | Encode a Unicode string to 'Path' using strict UTF-8 encoding on Posix.
-- On Posix it may fail if the stream contains null characters.
-- TBD: Use UTF16LE on Windows.
fromString :: MonadThrow m => [Char] -> m Path
fromString :: forall (m :: * -> *). MonadThrow m => String -> m Path
fromString = Stream Identity Char -> m Path
forall (m :: * -> *).
MonadThrow m =>
Stream Identity Char -> m Path
fromChars (Stream Identity Char -> m Path)
-> (String -> Stream Identity Char) -> String -> m Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Stream Identity Char
forall (m :: * -> *) a. Applicative m => [a] -> Stream m a
Stream.fromList

-- | Decode the path to a Unicode string using strict UTF-8 decoding on Posix.
-- TBD: Use UTF16LE on Windows.
toString :: Path -> [Char]
toString :: Path -> String
toString = Identity String -> String
forall a. Identity a -> a
runIdentity (Identity String -> String)
-> (Path -> Identity String) -> Path -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stream Identity Char -> Identity String
forall (m :: * -> *) a. Monad m => Stream m a -> m [a]
Stream.toList (Stream Identity Char -> Identity String)
-> (Path -> Stream Identity Char) -> Path -> Identity String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> Stream Identity Char
forall (m :: * -> *). Monad m => Path -> Stream m Char
toChars

------------------------------------------------------------------------------
-- Statically Verified Literals
------------------------------------------------------------------------------

-- XXX Build these on top of the str quasiquoter so that we get the
-- interpolation for free.

-- | Generates a 'Path' type from an interpolated string literal.
--
-- /Unimplemented/
path :: QuasiQuoter
path :: QuasiQuoter
path = QuasiQuoter
forall a. HasCallStack => a
undefined

-- | Generates an @Abs Path@ type from an interpolated string literal.
--
-- /Unimplemented/
abs :: QuasiQuoter
abs :: QuasiQuoter
abs = QuasiQuoter
forall a. HasCallStack => a
undefined

-- | Generates an @Rel Path@ type from an interpolated string literal.
--
-- /Unimplemented/
rel :: QuasiQuoter
rel :: QuasiQuoter
rel = QuasiQuoter
forall a. HasCallStack => a
undefined

-- | Generates an @Dir Path@ type from an interpolated string literal.
--
-- /Unimplemented/
dir :: QuasiQuoter
dir :: QuasiQuoter
dir = QuasiQuoter
forall a. HasCallStack => a
undefined

-- | Generates an @File Path@ type from an interpolated string literal.
--
-- /Unimplemented/
file :: QuasiQuoter
file :: QuasiQuoter
file = QuasiQuoter
forall a. HasCallStack => a
undefined

-- | Generates an @Abs (Dir Path)@ type from an interpolated string literal.
--
-- /Unimplemented/
absdir :: QuasiQuoter
absdir :: QuasiQuoter
absdir = QuasiQuoter
forall a. HasCallStack => a
undefined

-- | Generates an @Rel (Dir Path)@ type from an interpolated string literal.
--
-- /Unimplemented/
reldir :: QuasiQuoter
reldir :: QuasiQuoter
reldir = QuasiQuoter
forall a. HasCallStack => a
undefined

-- | Generates an @Abs (File Path)@ type from an interpolated string literal.
--
-- /Unimplemented/
absfile :: QuasiQuoter
absfile :: QuasiQuoter
absfile = QuasiQuoter
forall a. HasCallStack => a
undefined

-- | Generates an @Rel (File Path)@ type from an interpolated string literal.
--
-- /Unimplemented/
relfile :: QuasiQuoter
relfile :: QuasiQuoter
relfile = QuasiQuoter
forall a. HasCallStack => a
undefined

------------------------------------------------------------------------------
-- Statically Verified Strings
------------------------------------------------------------------------------

-- | Generates a 'Path' type.
--
-- /Unimplemented/
mkPath :: String -> Q Exp
mkPath :: String -> Q Exp
mkPath = String -> Q Exp
forall a. HasCallStack => a
undefined

-- | Generates an @Abs Path@ type.
--
-- /Unimplemented/
mkAbs :: String -> Q Exp
mkAbs :: String -> Q Exp
mkAbs = String -> Q Exp
forall a. HasCallStack => a
undefined

-- | Generates an @Rel Path@ type.
--
-- /Unimplemented/
mkRel :: String -> Q Exp
mkRel :: String -> Q Exp
mkRel = String -> Q Exp
forall a. HasCallStack => a
undefined

-- | Generates an @Dir Path@ type.
--
-- /Unimplemented/
mkDir :: String -> Q Exp
mkDir :: String -> Q Exp
mkDir = String -> Q Exp
forall a. HasCallStack => a
undefined

-- | Generates an @File Path@ type.
--
-- /Unimplemented/
mkFile :: String -> Q Exp
mkFile :: String -> Q Exp
mkFile = String -> Q Exp
forall a. HasCallStack => a
undefined

-- | Generates an @Abs (Dir Path)@ type.
--
-- /Unimplemented/
mkAbsDir :: String -> Q Exp
mkAbsDir :: String -> Q Exp
mkAbsDir = String -> Q Exp
forall a. HasCallStack => a
undefined

-- | Generates an @Rel (Dir Path)@ type.
--
-- /Unimplemented/
mkRelDir :: String -> Q Exp
mkRelDir :: String -> Q Exp
mkRelDir = String -> Q Exp
forall a. HasCallStack => a
undefined

-- | Generates an @Abs (File Path)@ type.
--
-- /Unimplemented/
mkAbsFile :: String -> Q Exp
mkAbsFile :: String -> Q Exp
mkAbsFile = String -> Q Exp
forall a. HasCallStack => a
undefined

-- | Generates an @Rel (File Path)@ type.
--
-- /Unimplemented/
mkRelFile :: String -> Q Exp
mkRelFile :: String -> Q Exp
mkRelFile = String -> Q Exp
forall a. HasCallStack => a
undefined

------------------------------------------------------------------------------
-- Operations
------------------------------------------------------------------------------

separatorWord :: WORD_TYPE
separatorWord :: Word8
separatorWord = SEPARATOR

-- Portable definition for exporting.

-- | 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.
primarySeparator :: Char
primarySeparator :: Char
primarySeparator = Int -> Char
chr (SEPARATOR)

-- | On Posix only @/@ is a path separator but in windows it could be either
-- @/@ or @\\@.
isSeparator :: Char -> Bool
#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
isSeparator c = (c == '/') || (c == '\\')
#else
isSeparator :: Char -> Bool
isSeparator = (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/')
#endif

-- If we append an absolute path it may fail with an error if the 'Path'
-- implementation stores absolute path information (a leading separator char).
-- However, the implementation may choose to store the path as a list of
-- components in which case we cannot distinguish an absolute path from
-- relative.

-- | Like 'extendDir' but for the less restrictive 'Path' type which will always
-- create a syntactically valid 'Path' type but it may not be semantically valid
-- because we may append an absolute path or we may append to a file path.
-- The onus lies on the user to ensure that the first path is not a file and
-- the second path is not absolute.
extendPath :: Path -> Path -> Path
extendPath :: Path -> Path -> Path
extendPath (Path Array Word8
a) (Path Array Word8
b) =
    let len :: Int
len = Array Word8 -> Int
forall a. Array a -> Int
Array.byteLength Array Word8
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Array Word8 -> Int
forall a. Array a -> Int
Array.byteLength Array Word8
b
        -- XXX Check the leading separator or drive identifier. However,
        -- checking the drive letter may add an additional overhead (can it be
        -- arbitrarily long?), if it is significant we may want to have a
        -- separate combinePathChecked API for that.
        --
        -- Also, do not add a separator char if the first path has a trailing
        -- separator.
        newArr :: Array Word8
newArr = IO (Array Word8) -> Array Word8
forall a. IO a -> a
unsafePerformIO (IO (Array Word8) -> Array Word8)
-> IO (Array Word8) -> Array Word8
forall a b. (a -> b) -> a -> b
$ do
            MutArray Word8
arr <- Int -> IO (MutArray Word8)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> m (MutArray a)
MutArray.new Int
len
            MutArray Word8
arr1 <- MutArray Word8 -> MutArray Word8 -> IO (MutArray Word8)
forall (m :: * -> *) a.
MonadIO m =>
MutArray a -> MutArray a -> m (MutArray a)
MutArray.spliceUnsafe MutArray Word8
arr (Array Word8 -> MutArray Word8
forall a. Array a -> MutArray a
Array.unsafeThaw Array Word8
a)
            MutArray Word8
arr2 <- MutArray Word8 -> Word8 -> IO (MutArray Word8)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
MutArray a -> a -> m (MutArray a)
MutArray.snocUnsafe MutArray Word8
arr1 Word8
separatorWord
            MutArray Word8
arr3 <- MutArray Word8 -> MutArray Word8 -> IO (MutArray Word8)
forall (m :: * -> *) a.
MonadIO m =>
MutArray a -> MutArray a -> m (MutArray a)
MutArray.spliceUnsafe MutArray Word8
arr2 (Array Word8 -> MutArray Word8
forall a. Array a -> MutArray a
Array.unsafeThaw Array Word8
b)
            Array Word8 -> IO (Array Word8)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (MutArray Word8 -> Array Word8
forall a. MutArray a -> Array a
Array.unsafeFreeze MutArray Word8
arr3)
        in Array Word8 -> Path
Path Array Word8
newArr

-- The only safety we need for paths is: (1) The first path can only be a Dir
-- type path, and (2) second path can only be a Rel path.
-- Can this be coerced to create unsafe versions?

-- | Extend a directory path by appending a relative path to it. This is the
-- equivalent to the @</>@ operator from the @filepath@ package.
{-# INLINE extendDir #-}
extendDir :: (IsPath (a (Dir Path)), IsPath b, IsPath (a b)) =>
    (a (Dir Path)) -> Rel b -> a b
extendDir :: forall (a :: * -> *) b.
(IsPath (a (Dir Path)), IsPath b, IsPath (a b)) =>
a (Dir Path) -> Rel b -> a b
extendDir a (Dir Path)
a (Rel b
b) =
    Path -> a b
forall a. IsPath a => Path -> a
fromPathUnsafe (Path -> a b) -> Path -> a b
forall a b. (a -> b) -> a -> b
$ Path -> Path -> Path
extendPath (a (Dir Path) -> Path
forall a. IsPath a => a -> Path
toPath a (Dir Path)
a) (b -> Path
forall a. IsPath a => a -> Path
toPath b
b)