@@ -0,0 +1,483 @@
1+{-# LANGUAGE TemplateHaskell #-}
2+
3+-- |
4+-- Module : Streamly.Internal.FileSystem.Path
5+-- Copyright : (c) 2023 Composewell Technologies
6+-- License : BSD3
7+-- Maintainer : streamly@composewell.com
8+-- Portability : GHC
9+--
10+-- Well typed and flexible file systems paths, preserving the OS and filesystem
11+-- encoding.
12+--
13+-- You can choose the level of type safety you want. 'Path' is the basic path
14+-- type which can represent a file, directory, absolute or relative path with
15+-- no restrictions. Depending on how much type safety you want you can choose
16+-- appropriate type wrappers to wrap 'Path'. @File Path@ mandates the path to
17+-- be a file whereas @Abs (File Path)@ mandates it to be an absolute path
18+-- representing a file.
19+--
20+-- You can upgrade or downgrade the safety. Whenever a less restrictive path
21+-- type is converted to a more restrctive path type the conversion involves
22+-- checks and it may fail. However, a more restrictive path type can be freely
23+-- converted to a less restrictive one.
24+--
25+-- See the @streamly-filepath@ package for interworking with the 'OsPath' type.
26+-- The 'Path' type can be converted to and from 'OsPath' type at zero cost
27+-- since the underlying representation of both is the same.
28+
29+-- Conventions: A trailing separator on a path indicates that it is a directory.
30+-- However, the absence of a trailing separator does not convey any
31+-- information, it could either be a directory or a file.
32+
33+-- You may also find the 'str' quasiquoter from "Streamly.Unicode.String" to be
34+-- useful in creating paths.
35+--
36+module Streamly.Internal.FileSystem.Path
37+ (
38+ -- * Path Types
39+ Path
40+ , File
41+ , Dir
42+ , Abs
43+ , Rel
44+
45+ -- * Conversions
46+ , IsPath (..)
47+ , adaptPath
48+
49+ -- * Construction
50+ , fromChunk
51+ , fromChunkUnsafe
52+ , fromString
53+ , fromChars
54+
55+ -- * Statically Verified Literals
56+ -- quasiquoters
57+ , path
58+ , abs
59+ , rel
60+ , dir
61+ , file
62+ , absdir
63+ , reldir
64+ , absfile
65+ , relfile
66+
67+ -- * Statically Verified Strings
68+ -- TH macros
69+ , mkPath
70+ , mkAbs
71+ , mkRel
72+ , mkDir
73+ , mkFile
74+ , mkAbsDir
75+ , mkRelDir
76+ , mkAbsFile
77+ , mkRelFile
78+
79+ -- * Elimination
80+ , toChunk
81+ , toString
82+ , toChars
83+
84+ -- * Operations
85+ , extendPath
86+ , extendDir
87+ )
88+where
89+
90+import Control.Exception (Exception)
91+import Control.Monad.Catch (MonadThrow(..))
92+import Data.Functor.Identity (Identity(..))
93+import Data.Word (Word8)
94+#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
95+import Data.Word (Word16)
96+#endif
97+import Language.Haskell.TH (Q, Exp)
98+import Language.Haskell.TH.Quote (QuasiQuoter)
99+import Streamly.Internal.Data.Array (Array)
100+import Streamly.Internal.Data.Stream (Stream)
101+import System.IO.Unsafe (unsafePerformIO)
102+
103+import qualified Streamly.Internal.Data.Array as Array
104+import qualified Streamly.Internal.Data.Fold as Fold
105+import qualified Streamly.Internal.Data.MutArray as MutArray
106+import qualified Streamly.Internal.Data.Stream as Stream
107+import qualified Streamly.Internal.Unicode.Stream as Unicode
108+
109+import Prelude hiding (abs)
110+
111+#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
112+#define WORD_TYPE Word16
113+#define SEPARATOR 92
114+#else
115+#define WORD_TYPE Word8
116+#define SEPARATOR 47
117+#endif
118+
119+------------------------------------------------------------------------------
120+-- Exceptions
121+------------------------------------------------------------------------------
122+
123+-- | Exceptions thrown by path operations.
124+data PathException =
125+ InvalidPath String
126+ | InvalidAbsPath String
127+ | InvalidRelPath String
128+ | InvalidFilePath String
129+ | InvalidDirPath String
130+ deriving (Show,Eq)
131+
132+instance Exception PathException
133+
134+-- XXX Path must not contain null char on Posix. System calls consider the path
135+-- as null terminated.
136+-- XXX Maintain the Array with null termination because Unix system calls
137+-- require a null terminated string, also they return null terminated strings
138+-- as paths. Implementation of path append will have to handle the null
139+-- termination. Or we can choose to always copy the array when using it in
140+-- system calls.
141+
142+-- XXX The eq instance needs to make sure that the paths are equivalent. If we
143+-- normalize the paths we can do a byte comparison. However, on windows paths
144+-- are case insensitive but the case is preserved, therefore, we cannot
145+-- normalize and need to do case insensitive comparison.
146+
147+------------------------------------------------------------------------------
148+-- Types
149+------------------------------------------------------------------------------
150+
151+-- | A type representing file system paths for directories or files.
152+newtype Path = Path (Array WORD_TYPE) -- deriving Eq
153+
154+-- XXX Do we need a type for file or dir Name as names cannot have the
155+-- separator char and there may be other restrictions on names? For example,
156+-- length restriction. A file name cannot be "." or "..". We can use the types
157+-- "File Name" and "Dir Name" to represent names. Also, file systems may put
158+-- limits on names. Can have an IsName type class with members Name, (File
159+-- Name), (Dir Name).
160+
161+-- | A type representing a file path.
162+newtype File a = File a
163+
164+-- | A type representing a directory path.
165+newtype Dir a = Dir a
166+
167+-- | A type representing absolute paths.
168+newtype Abs a = Abs a
169+
170+-- | A type representing relative paths.
171+newtype Rel a = Rel a
172+
173+------------------------------------------------------------------------------
174+-- Conversions
175+------------------------------------------------------------------------------
176+
177+-- | A member of 'IsPath' knows how to convert to and from the 'Path' type.
178+class IsPath a where
179+ -- | Like 'fromPath' but does not check the properties of 'Path'. Provides
180+ -- performance and simplicity when we know that the properties of the path
181+ -- are already verified, for example, when we get the path from the file
182+ -- system or the OS APIs.
183+ fromPathUnsafe :: Path -> a
184+
185+ -- | Convert a raw 'Path' to other forms of well-typed paths. It may fail
186+ -- if the path does not satisfy the properties of the target type.
187+ --
188+ -- Path components may have limits.
189+ -- Total path length may have a limit.
190+ fromPath :: MonadThrow m => Path -> m a
191+
192+ -- | Convert a well-typed path to a raw 'Path'. Never fails.
193+ toPath :: a -> Path
194+
195+instance IsPath Path where
196+ fromPathUnsafe = id
197+ fromPath = pure
198+ toPath = id
199+
200+instance IsPath (File Path) where
201+ fromPathUnsafe p = File p
202+ fromPath p = pure (File p)
203+ toPath (File p) = p
204+
205+instance IsPath (Dir Path) where
206+ fromPathUnsafe p = Dir p
207+ fromPath p = pure (Dir p)
208+ toPath (Dir p) = p
209+
210+instance IsPath (Abs Path) where
211+ fromPathUnsafe p = Abs p
212+ fromPath p = pure (Abs p)
213+ toPath (Abs p) = p
214+
215+instance IsPath (Rel Path) where
216+ fromPathUnsafe p = Rel p
217+ fromPath p = pure (Rel p)
218+ toPath (Rel p) = p
219+
220+instance IsPath (Abs (File Path)) where
221+ fromPathUnsafe p = Abs (File p)
222+ fromPath p = pure (Abs (File p))
223+ toPath (Abs (File p)) = p
224+
225+instance IsPath (Abs (Dir Path)) where
226+ fromPathUnsafe p = Abs (Dir p)
227+ fromPath p = pure (Abs (Dir p))
228+ toPath (Abs (Dir p)) = p
229+
230+instance IsPath (Rel (File Path)) where
231+ fromPathUnsafe p = Rel (File p)
232+ fromPath p = pure (Rel (File p))
233+ toPath (Rel (File p)) = p
234+
235+instance IsPath (Rel (Dir Path)) where
236+ fromPathUnsafe p = Rel (Dir p)
237+ fromPath p = pure (Rel (Dir p))
238+ toPath (Rel (Dir p)) = p
239+
240+-- XXX Use rewrite rules to eliminate intermediate conversions for better
241+-- efficiency.
242+
243+-- | Convert a path type to another path type. This operation may fail with a
244+-- 'PathException' when converting a less restrictive path type to a more
245+-- restrictive one.
246+adaptPath :: (MonadThrow m, IsPath a, IsPath b) => a -> m b
247+adaptPath p = fromPath $ toPath p
248+
249+------------------------------------------------------------------------------
250+-- Construction
251+------------------------------------------------------------------------------
252+
253+-- A chunk is essentially an untyped Array i.e. Array Word8. We can either use
254+-- the term ByteArray for that or just Chunk. The latter is shorter and we have
255+-- been using it consistently in streamly.
256+
257+-- | /Unsafe/: On Posix, a path cannot contain null characters. On Windows, the
258+-- array passed must be a multiple of 2 bytes as the underlying representation
259+-- uses 'Word16'.
260+{-# INLINE fromChunkUnsafe #-}
261+fromChunkUnsafe :: Array Word8 -> Path
262+fromChunkUnsafe arr = Path (Array.castUnsafe arr)
263+
264+-- | On Posix it may fail if the byte array contains null characters. On
265+-- Windows the array passed must be a multiple of 2 bytes as the underlying
266+-- representation uses 'Word16'.
267+--
268+-- Throws 'InvalidPath'.
269+fromChunk :: MonadThrow m => Array Word8 -> m Path
270+fromChunk arr =
271+ case Array.cast arr of
272+ Nothing ->
273+ -- XXX Windows only message.
274+ throwM
275+ $ InvalidPath
276+ $ "Encoded path length " ++ show (Array.byteLength arr)
277+ ++ " is not a multiple of 16-bit."
278+ Just x -> pure (Path x)
279+
280+-- | Convert 'Path' to an array of bytes.
281+toChunk :: Path -> Array Word8
282+toChunk (Path arr) = Array.asBytes arr
283+
284+-- | Encode a Unicode char stream to 'Path' using strict UTF-8 encoding on
285+-- Posix. On Posix it may fail if the stream contains null characters.
286+-- TBD: Use UTF16LE on Windows.
287+fromChars :: MonadThrow m => Stream Identity Char -> m Path
288+fromChars s =
289+ let n = runIdentity $ Stream.fold Fold.length s
290+#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
291+ in pure $ Path (Array.fromPureStreamN n (Unicode.encodeUtf16le' s))
292+#else
293+ in pure $ Path (Array.fromPureStreamN n (Unicode.encodeUtf8' s))
294+#endif
295+
296+-- | Decode the path to a stream of Unicode chars using strict UTF-8 decoding
297+-- on Posix.
298+-- TBD: Use UTF16LE on Windows.
299+toChars :: Monad m => Path -> Stream m Char
300+toChars (Path arr) =
301+#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
302+ Unicode.decodeUtf16le' $ Array.read arr
303+#else
304+ Unicode.decodeUtf8' $ Array.read arr
305+#endif
306+
307+-- | Encode a Unicode string to 'Path' using strict UTF-8 encoding on Posix.
308+-- On Posix it may fail if the stream contains null characters.
309+-- TBD: Use UTF16LE on Windows.
310+fromString :: MonadThrow m => [Char] -> m Path
311+fromString = fromChars . Stream.fromList
312+
313+-- | Decode the path to a Unicode string using strict UTF-8 decoding on Posix.
314+-- TBD: Use UTF16LE on Windows.
315+toString :: Path -> [Char]
316+toString = runIdentity . Stream.toList . toChars
317+
318+------------------------------------------------------------------------------
319+-- Statically Verified Literals
320+------------------------------------------------------------------------------
321+
322+-- XXX Build these on top of the str quasiquoter so that we get the
323+-- interpolation for free.
324+
325+-- | Generates a 'Path' type from an interpolated string literal.
326+--
327+-- /Unimplemented/
328+path :: QuasiQuoter
329+path = undefined
330+
331+-- | Generates an @Abs Path@ type from an interpolated string literal.
332+--
333+-- /Unimplemented/
334+abs :: QuasiQuoter
335+abs = undefined
336+
337+-- | Generates an @Rel Path@ type from an interpolated string literal.
338+--
339+-- /Unimplemented/
340+rel :: QuasiQuoter
341+rel = undefined
342+
343+-- | Generates an @Dir Path@ type from an interpolated string literal.
344+--
345+-- /Unimplemented/
346+dir :: QuasiQuoter
347+dir = undefined
348+
349+-- | Generates an @File Path@ type from an interpolated string literal.
350+--
351+-- /Unimplemented/
352+file :: QuasiQuoter
353+file = undefined
354+
355+-- | Generates an @Abs (Dir Path)@ type from an interpolated string literal.
356+--
357+-- /Unimplemented/
358+absdir :: QuasiQuoter
359+absdir = undefined
360+
361+-- | Generates an @Rel (Dir Path)@ type from an interpolated string literal.
362+--
363+-- /Unimplemented/
364+reldir :: QuasiQuoter
365+reldir = undefined
366+
367+-- | Generates an @Abs (File Path)@ type from an interpolated string literal.
368+--
369+-- /Unimplemented/
370+absfile :: QuasiQuoter
371+absfile = undefined
372+
373+-- | Generates an @Rel (File Path)@ type from an interpolated string literal.
374+--
375+-- /Unimplemented/
376+relfile :: QuasiQuoter
377+relfile = undefined
378+
379+------------------------------------------------------------------------------
380+-- Statically Verified Strings
381+------------------------------------------------------------------------------
382+
383+-- | Generates a 'Path' type.
384+--
385+-- /Unimplemented/
386+mkPath :: String -> Q Exp
387+mkPath = undefined
388+
389+-- | Generates an @Abs Path@ type.
390+--
391+-- /Unimplemented/
392+mkAbs :: String -> Q Exp
393+mkAbs = undefined
394+
395+-- | Generates an @Rel Path@ type.
396+--
397+-- /Unimplemented/
398+mkRel :: String -> Q Exp
399+mkRel = undefined
400+
401+-- | Generates an @Dir Path@ type.
402+--
403+-- /Unimplemented/
404+mkDir :: String -> Q Exp
405+mkDir = undefined
406+
407+-- | Generates an @File Path@ type.
408+--
409+-- /Unimplemented/
410+mkFile :: String -> Q Exp
411+mkFile = undefined
412+
413+-- | Generates an @Abs (Dir Path)@ type.
414+--
415+-- /Unimplemented/
416+mkAbsDir :: String -> Q Exp
417+mkAbsDir = undefined
418+
419+-- | Generates an @Rel (Dir Path)@ type.
420+--
421+-- /Unimplemented/
422+mkRelDir :: String -> Q Exp
423+mkRelDir = undefined
424+
425+-- | Generates an @Abs (File Path)@ type.
426+--
427+-- /Unimplemented/
428+mkAbsFile :: String -> Q Exp
429+mkAbsFile = undefined
430+
431+-- | Generates an @Rel (File Path)@ type.
432+--
433+-- /Unimplemented/
434+mkRelFile :: String -> Q Exp
435+mkRelFile = undefined
436+
437+------------------------------------------------------------------------------
438+-- Operations
439+------------------------------------------------------------------------------
440+
441+separator :: WORD_TYPE
442+separator = SEPARATOR
443+
444+-- If we append an absolute path it may fail with an error if the 'Path'
445+-- implementation stores absolute path information (a leading separator char).
446+-- However, the implementation may choose to store the path as a list of
447+-- components in which case we cannot distinguish an absolute path from
448+-- relative.
449+
450+-- | Like 'extendDir' but for the less restrictive 'Path' type which will always
451+-- create a syntactically valid 'Path' type but it may not be semantically valid
452+-- because we may append an absolute path or we may append to a file path.
453+-- The onus lies on the user to ensure that the first path is not a file and
454+-- the second path is not absolute.
455+extendPath :: Path -> Path -> Path
456+extendPath (Path a) (Path b) =
457+ let len = Array.byteLength a + 1 + Array.byteLength b
458+ -- XXX Check the leading separator or drive identifier. However,
459+ -- checking the drive letter may add an additional overhead (can it be
460+ -- arbitrarily long?), if it is significant we may want to have a
461+ -- separate combinePathChecked API for that.
462+ --
463+ -- Also, do not add a separator char if the first path has a trailing
464+ -- separator.
465+ newArr = unsafePerformIO $ do
466+ arr <- MutArray.new len
467+ arr1 <- MutArray.spliceUnsafe arr (Array.unsafeThaw a)
468+ arr2 <- MutArray.snocUnsafe arr1 separator
469+ arr3 <- MutArray.spliceUnsafe arr2 (Array.unsafeThaw b)
470+ return (Array.unsafeFreeze arr3)
471+ in Path newArr
472+
473+-- The only safety we need for paths is: (1) The first path can only be a Dir
474+-- type path, and (2) second path can only be a Rel path.
475+-- Can this be coerced to create unsafe versions?
476+
477+-- | Extend a directory path by appending a relative path to it. This is the
478+-- equivalent to the @</>@ operator from the @filepath@ package.
479+{-# INLINE extendDir #-}
480+extendDir :: (IsPath (a (Dir Path)), IsPath b, IsPath (a b)) =>
481+ (a (Dir Path)) -> Rel b -> a b
482+extendDir a (Rel b) =
483+ fromPathUnsafe $ extendPath (toPath a) (toPath b)