{-# LANGUAGE TemplateHaskell #-}
module Streamly.Internal.FileSystem.Path
(
Path (..)
, File
, Dir
, Abs
, Rel
, IsPath (..)
, adaptPath
, fromChunk
, fromChunkUnsafe
, fromString
, fromChars
, path
, abs
, rel
, dir
, file
, absdir
, reldir
, absfile
, relfile
, mkPath
, mkAbs
, mkRel
, mkDir
, mkFile
, mkAbsDir
, mkRelDir
, mkAbsFile
, mkRelFile
, toChunk
, toString
, toChars
, 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
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
showList :: [PathException] -> ShowS
$cshowList :: [PathException] -> ShowS
show :: PathException -> String
$cshow :: PathException -> String
showsPrec :: Int -> PathException -> ShowS
$cshowsPrec :: Int -> PathException -> ShowS
Show,PathException -> PathException -> Bool
(PathException -> PathException -> Bool)
-> (PathException -> PathException -> Bool) -> Eq PathException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PathException -> PathException -> Bool
$c/= :: PathException -> PathException -> Bool
== :: PathException -> PathException -> Bool
$c== :: PathException -> PathException -> Bool
Eq)
instance Exception PathException
newtype Path = Path (Array WORD_TYPE)
newtype File a = File a
newtype Dir a = Dir a
newtype Abs a = Abs a
newtype Rel a = Rel a
class IsPath a where
fromPathUnsafe :: Path -> a
fromPath :: MonadThrow m => Path -> m a
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 (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 (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 (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 (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 (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 (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 (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 (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 (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
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
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
{-# 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)
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 ->
PathException -> m Path
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 (f :: * -> *) a. Applicative f => a -> f a
pure (Array Word8 -> Path
Path Array Word8
x)
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
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 (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
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
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
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
path :: QuasiQuoter
path :: QuasiQuoter
path = QuasiQuoter
forall a. HasCallStack => a
undefined
abs :: QuasiQuoter
abs :: QuasiQuoter
abs = QuasiQuoter
forall a. HasCallStack => a
undefined
rel :: QuasiQuoter
rel :: QuasiQuoter
rel = QuasiQuoter
forall a. HasCallStack => a
undefined
dir :: QuasiQuoter
dir :: QuasiQuoter
dir = QuasiQuoter
forall a. HasCallStack => a
undefined
file :: QuasiQuoter
file :: QuasiQuoter
file = QuasiQuoter
forall a. HasCallStack => a
undefined
absdir :: QuasiQuoter
absdir :: QuasiQuoter
absdir = QuasiQuoter
forall a. HasCallStack => a
undefined
reldir :: QuasiQuoter
reldir :: QuasiQuoter
reldir = QuasiQuoter
forall a. HasCallStack => a
undefined
absfile :: QuasiQuoter
absfile :: QuasiQuoter
absfile = QuasiQuoter
forall a. HasCallStack => a
undefined
relfile :: QuasiQuoter
relfile :: QuasiQuoter
relfile = QuasiQuoter
forall a. HasCallStack => a
undefined
mkPath :: String -> Q Exp
mkPath :: String -> Q Exp
mkPath = String -> Q Exp
forall a. HasCallStack => a
undefined
mkAbs :: String -> Q Exp
mkAbs :: String -> Q Exp
mkAbs = String -> Q Exp
forall a. HasCallStack => a
undefined
mkRel :: String -> Q Exp
mkRel :: String -> Q Exp
mkRel = String -> Q Exp
forall a. HasCallStack => a
undefined
mkDir :: String -> Q Exp
mkDir :: String -> Q Exp
mkDir = String -> Q Exp
forall a. HasCallStack => a
undefined
mkFile :: String -> Q Exp
mkFile :: String -> Q Exp
mkFile = String -> Q Exp
forall a. HasCallStack => a
undefined
mkAbsDir :: String -> Q Exp
mkAbsDir :: String -> Q Exp
mkAbsDir = String -> Q Exp
forall a. HasCallStack => a
undefined
mkRelDir :: String -> Q Exp
mkRelDir :: String -> Q Exp
mkRelDir = String -> Q Exp
forall a. HasCallStack => a
undefined
mkAbsFile :: String -> Q Exp
mkAbsFile :: String -> Q Exp
mkAbsFile = String -> Q Exp
forall a. HasCallStack => a
undefined
mkRelFile :: String -> Q Exp
mkRelFile :: String -> Q Exp
mkRelFile = String -> Q Exp
forall a. HasCallStack => a
undefined
separatorWord :: WORD_TYPE
separatorWord :: Word8
separatorWord = SEPARATOR
primarySeparator :: Char
primarySeparator :: Char
primarySeparator = Int -> Char
chr (SEPARATOR)
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
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
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 (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
{-# 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)