1-- |
2-- Module      : Foundation.VFS.FilePath
3-- License     : BSD-style
4-- Maintainer  : foundation
5-- Stability   : experimental
6-- Portability : portable
7--
8-- # Opaque implementation for FilePath
9--
10-- The underlying type of a FilePath is a `Foundation.ByteArray`. It is indeed like
11-- this because for some systems (Unix systems) a `FilePath` is a null
12-- terminated array of bytes.
13--
14-- # FilePath and FileName for type checking validation
15--
16-- In order to add some constraint at compile time, it is not possible to
17-- append (`</>`) a `FilePath` to another `FilePath`.
18-- You can only append (`</>`) a `FileName` to a given `FilePath`.
19--
20
21{-# LANGUAGE CPP #-}
22
23module Foundation.VFS.FilePath
24    ( FilePath
25    , Relativity(..)
26    , FileName
27      -- * conversion
28    , filePathToString
29    , filePathToLString
30
31      -- ** unsafe
32    , unsafeFilePath
33    , unsafeFileName
34    , extension
35    ) where
36
37import Basement.Compat.Base
38import Basement.Compat.Semigroup
39import Foundation.Collection
40import Foundation.Array
41import Foundation.String (Encoding(..), ValidationFailure, toBytes, fromBytes, String)
42import Foundation.VFS.Path(Path(..))
43
44import qualified Data.List
45-- ------------------------------------------------------------------------- --
46--                           System related helpers                          --
47-- ------------------------------------------------------------------------- --
48
49#ifdef mingw32_HOST_OS
50pathSeparatorWINC :: Char
51pathSeparatorWINC = '\\'
52
53-- | define the Path separator for Windows systems : '\\'
54pathSeparatorWIN :: String
55pathSeparatorWIN = fromString [pathSeparatorWINC]
56#else
57pathSeparatorPOSIXC :: Char
58pathSeparatorPOSIXC = '/'
59
60-- | define the Path separator for POSIX systems : '/'
61pathSeparatorPOSIX :: String
62pathSeparatorPOSIX = fromString [pathSeparatorPOSIXC]
63#endif
64
65pathSeparatorC :: Char
66pathSeparator :: String
67#ifdef mingw32_HOST_OS
68pathSeparatorC = pathSeparatorWINC
69pathSeparator = pathSeparatorWIN
70#else
71pathSeparatorC = pathSeparatorPOSIXC
72pathSeparator = pathSeparatorPOSIX
73#endif
74
75-- ------------------------------------------------------------------------- --
76--                              FilePath                                     --
77-- ------------------------------------------------------------------------- --
78
79-- | information about type of FilePath
80--
81-- A file path being only `Relative` or `Absolute`.
82data Relativity = Absolute | Relative
83  deriving (Eq, Show)
84
85-- | FilePath is a collection of FileName
86--
87-- TODO: Eq and Ord are implemented using Show
88--       This is not very efficient and would need to be improved
89--       Also, it is possible the ordering is not necessary what we want
90--       in this case.
91--
92-- A FilePath is one of the following:
93--
94-- * An Absolute:
95--   * starts with one of the follwing "/"
96-- * A relative:
97--   * don't start with a "/"
98--
99-- * authorised:
100--   * "/"
101--   * "/file/path"
102--   * "."
103--   * ".."
104--   * "work/haskell/hs-foundation"
105--
106-- * unauthorised
107--   * "path//"
108data FilePath = FilePath Relativity [FileName]
109
110instance Show FilePath where
111    show = filePathToLString
112instance Eq FilePath where
113  (==) a b = (==) (show a) (show b)
114instance Ord FilePath where
115  compare a b = compare (show a) (show b)
116
117-- | error associated to filepath manipulation
118data FilePath_Invalid
119      = ContiguousPathSeparator
120          -- ^ this mean there were 2 contiguous path separators.
121          --
122          -- This is not valid in Foundation's FilePath specifications
123    deriving (Typeable, Show)
124instance Exception FilePath_Invalid
125
126instance IsString FilePath where
127    fromString [] = FilePath Absolute mempty
128    fromString s@(x:xs)
129        | hasContigueSeparators s = throw ContiguousPathSeparator
130        | otherwise = FilePath relativity $ case relativity of
131            Absolute -> fromString <$> splitOn isSeparator xs
132            Relative -> fromString <$> splitOn isSeparator s
133      where
134        relativity :: Relativity
135        relativity = if isSeparator x then Absolute else Relative
136
137-- | A filename (or path entity) in the FilePath
138--
139-- * Authorised
140--   * ""
141--   * "."
142--   * ".."
143--   * "foundation"
144-- * Unauthorised
145--   * "/"
146--   * "file/"
147--   * "/file"
148--   * "file/path"
149--
150data FileName = FileName (UArray Word8)
151  deriving (Eq)
152-- | errors related to FileName manipulation
153data FileName_Invalid
154    = ContainsNullByte
155        -- ^ this means a null byte was found in the FileName
156    | ContainsSeparator
157        -- ^ this means a path separator was found in the FileName
158    | EncodingError ValidationFailure
159        -- ^ encoding error
160    | UnknownTrailingBytes (UArray Word8)
161        -- ^ some unknown trainling bytes found
162  deriving (Typeable, Show)
163instance Exception FileName_Invalid
164
165instance Show FileName where
166    show = fileNameToLString
167instance IsString FileName where
168  fromString [] = FileName mempty
169  fromString xs | hasNullByte  xs = throw ContainsNullByte
170                | hasSeparator xs = throw ContainsSeparator
171                | otherwise       = FileName $ toBytes UTF8 $ fromString xs
172
173hasNullByte :: [Char] -> Bool
174hasNullByte = Data.List.elem '\0'
175
176hasSeparator :: [Char] -> Bool
177hasSeparator = Data.List.elem pathSeparatorC
178
179isSeparator :: Char -> Bool
180isSeparator = (==) pathSeparatorC
181
182hasContigueSeparators :: [Char] -> Bool
183hasContigueSeparators [] = False
184hasContigueSeparators [_] = False
185hasContigueSeparators (x1:x2:xs) =
186    (isSeparator x1 && x1 == x2) || hasContigueSeparators xs
187
188instance Semigroup FileName where
189    (<>) (FileName a) (FileName b) = FileName $ a `mappend` b
190instance Monoid FileName where
191    mempty = FileName mempty
192    mappend (FileName a) (FileName b) = FileName $ a `mappend` b
193
194instance Path FilePath where
195    type PathEnt FilePath = FileName
196    type PathPrefix FilePath = Relativity
197    type PathSuffix FilePath = ()
198    (</>) = join
199    splitPath (FilePath r xs) = (r, xs, ())
200    buildPath (r, xs , _) = FilePath r xs
201
202-- compare to the original </>, this type disallow to be able to append an absolute filepath to a filepath
203join :: FilePath -> FileName -> FilePath
204join p              (FileName x) | null x = p
205join (FilePath r xs) x          = FilePath r $ snoc xs x
206
207filePathToString :: FilePath -> String
208filePathToString (FilePath Absolute []) = fromString [pathSeparatorC]
209filePathToString (FilePath Relative []) = fromString "."
210filePathToString (FilePath Absolute fns) = cons pathSeparatorC $ filenameIntercalate fns
211filePathToString (FilePath Relative fns) = filenameIntercalate fns
212
213filenameIntercalate :: [FileName] -> String
214filenameIntercalate = mconcat . Data.List.intersperse pathSeparator . fmap fileNameToString
215
216-- | convert a FileName into a String
217--
218-- This function may throw an exception associated to the encoding
219fileNameToString :: FileName -> String
220fileNameToString (FileName fp) =
221    -- FIXME probably incorrect considering windows.
222    -- this is just to get going to be able to be able to reuse System.IO functions which
223    -- works on [Char]
224    case fromBytes UTF8 fp of
225        (s, Nothing, bs)
226            | null bs -> s
227            | otherwise -> throw $ UnknownTrailingBytes bs
228        (_, Just err, _) -> throw $ EncodingError err
229
230-- | conversion of FileName into a list of Char
231--
232-- this function may throw exceptions
233fileNameToLString :: FileName -> [Char]
234fileNameToLString = toList . fileNameToString
235
236-- | conversion of a FilePath into a list of Char
237--
238-- this function may throw exceptions
239filePathToLString :: FilePath -> [Char]
240filePathToLString = toList . filePathToString
241
242-- | build a file path from a given list of filename
243--
244-- this is unsafe and is mainly needed for testing purpose
245unsafeFilePath :: Relativity -> [FileName] -> FilePath
246unsafeFilePath = FilePath
247
248-- | build a file name from a given ByteArray
249--
250-- this is unsafe and is mainly needed for testing purpose
251unsafeFileName :: UArray Word8 -> FileName
252unsafeFileName = FileName
253
254extension :: FileName -> Maybe FileName
255extension (FileName fn) = case splitOn (\c -> c == 0x2E) fn of
256                            []  -> Nothing
257                            [_] -> Nothing
258                            xs  -> Just $ FileName $ last $ nonEmpty_ xs
259