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