-- |
-- Module      : Foundation.VFS.FilePath
-- License     : BSD-style
-- Maintainer  : foundation
-- Stability   : experimental
-- Portability : portable
--
-- # Opaque implementation for FilePath
--
-- The underlying type of a FilePath is a `Foundation.ByteArray`. It is indeed like
-- this because for some systems (Unix systems) a `FilePath` is a null
-- terminated array of bytes.
--
-- # FilePath and FileName for type checking validation
--
-- In order to add some constraint at compile time, it is not possible to
-- append (`</>`) a `FilePath` to another `FilePath`.
-- You can only append (`</>`) a `FileName` to a given `FilePath`.
--

{-# LANGUAGE CPP #-}

module Foundation.VFS.FilePath
    ( FilePath
    , Relativity(..)
    , FileName
      -- * conversion
    , filePathToString
    , filePathToLString

      -- ** unsafe
    , unsafeFilePath
    , unsafeFileName
    , extension
    ) where

import Basement.Compat.Base
import Basement.Compat.Semigroup
import Foundation.Collection
import Foundation.Array
import Foundation.String (Encoding(..), ValidationFailure, toBytes, fromBytes, String)
import Foundation.VFS.Path(Path(..))

import qualified Data.List
-- ------------------------------------------------------------------------- --
--                           System related helpers                          --
-- ------------------------------------------------------------------------- --

#ifdef mingw32_HOST_OS
pathSeparatorWINC :: Char
pathSeparatorWINC = '\\'

-- | define the Path separator for Windows systems : '\\'
pathSeparatorWIN :: String
pathSeparatorWIN = fromString [pathSeparatorWINC]
#else
pathSeparatorPOSIXC :: Char
pathSeparatorPOSIXC :: Char
pathSeparatorPOSIXC = Char
'/'

-- | define the Path separator for POSIX systems : '/'
pathSeparatorPOSIX :: String
pathSeparatorPOSIX :: String
pathSeparatorPOSIX = String -> String
forall a. IsString a => String -> a
fromString [Char
pathSeparatorPOSIXC]
#endif

pathSeparatorC :: Char
pathSeparator :: String
#ifdef mingw32_HOST_OS
pathSeparatorC = pathSeparatorWINC
pathSeparator = pathSeparatorWIN
#else
pathSeparatorC :: Char
pathSeparatorC = Char
pathSeparatorPOSIXC
pathSeparator :: String
pathSeparator = String
pathSeparatorPOSIX
#endif

-- ------------------------------------------------------------------------- --
--                              FilePath                                     --
-- ------------------------------------------------------------------------- --

-- | information about type of FilePath
--
-- A file path being only `Relative` or `Absolute`.
data Relativity = Absolute | Relative
  deriving (Relativity -> Relativity -> Bool
(Relativity -> Relativity -> Bool)
-> (Relativity -> Relativity -> Bool) -> Eq Relativity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Relativity -> Relativity -> Bool
$c/= :: Relativity -> Relativity -> Bool
== :: Relativity -> Relativity -> Bool
$c== :: Relativity -> Relativity -> Bool
Eq, Int -> Relativity -> ShowS
[Relativity] -> ShowS
Relativity -> String
(Int -> Relativity -> ShowS)
-> (Relativity -> String)
-> ([Relativity] -> ShowS)
-> Show Relativity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Relativity] -> ShowS
$cshowList :: [Relativity] -> ShowS
show :: Relativity -> String
$cshow :: Relativity -> String
showsPrec :: Int -> Relativity -> ShowS
$cshowsPrec :: Int -> Relativity -> ShowS
Show)

-- | FilePath is a collection of FileName
--
-- TODO: Eq and Ord are implemented using Show
--       This is not very efficient and would need to be improved
--       Also, it is possible the ordering is not necessary what we want
--       in this case.
--
-- A FilePath is one of the following:
--
-- * An Absolute:
--   * starts with one of the follwing "/"
-- * A relative:
--   * don't start with a "/"
--
-- * authorised:
--   * "/"
--   * "/file/path"
--   * "."
--   * ".."
--   * "work/haskell/hs-foundation"
--
-- * unauthorised
--   * "path//"
data FilePath = FilePath Relativity [FileName]

instance Show FilePath where
    show :: FilePath -> String
show = FilePath -> String
filePathToLString
instance Eq FilePath where
  == :: FilePath -> FilePath -> Bool
(==) FilePath
a FilePath
b = String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(==) (FilePath -> String
forall a. Show a => a -> String
show FilePath
a) (FilePath -> String
forall a. Show a => a -> String
show FilePath
b)
instance Ord FilePath where
  compare :: FilePath -> FilePath -> Ordering
compare FilePath
a FilePath
b = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (FilePath -> String
forall a. Show a => a -> String
show FilePath
a) (FilePath -> String
forall a. Show a => a -> String
show FilePath
b)

-- | error associated to filepath manipulation
data FilePath_Invalid
      = ContiguousPathSeparator
          -- ^ this mean there were 2 contiguous path separators.
          --
          -- This is not valid in Foundation's FilePath specifications
    deriving (Typeable, Int -> FilePath_Invalid -> ShowS
[FilePath_Invalid] -> ShowS
FilePath_Invalid -> String
(Int -> FilePath_Invalid -> ShowS)
-> (FilePath_Invalid -> String)
-> ([FilePath_Invalid] -> ShowS)
-> Show FilePath_Invalid
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FilePath_Invalid] -> ShowS
$cshowList :: [FilePath_Invalid] -> ShowS
show :: FilePath_Invalid -> String
$cshow :: FilePath_Invalid -> String
showsPrec :: Int -> FilePath_Invalid -> ShowS
$cshowsPrec :: Int -> FilePath_Invalid -> ShowS
Show)
instance Exception FilePath_Invalid

instance IsString FilePath where
    fromString :: String -> FilePath
fromString [] = Relativity -> [FileName] -> FilePath
FilePath Relativity
Absolute [FileName]
forall a. Monoid a => a
mempty
    fromString s :: String
s@(Char
x:String
xs)
        | String -> Bool
hasContigueSeparators String
s = FilePath_Invalid -> FilePath
forall a e. Exception e => e -> a
throw FilePath_Invalid
ContiguousPathSeparator
        | Bool
otherwise = Relativity -> [FileName] -> FilePath
FilePath Relativity
relativity ([FileName] -> FilePath) -> [FileName] -> FilePath
forall a b. (a -> b) -> a -> b
$ case Relativity
relativity of
            Relativity
Absolute -> String -> FileName
forall a. IsString a => String -> a
fromString (String -> FileName) -> [String] -> [FileName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element String -> Bool) -> String -> [String]
forall c. Sequential c => (Element c -> Bool) -> c -> [c]
splitOn Char -> Bool
Element String -> Bool
isSeparator String
xs
            Relativity
Relative -> String -> FileName
forall a. IsString a => String -> a
fromString (String -> FileName) -> [String] -> [FileName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element String -> Bool) -> String -> [String]
forall c. Sequential c => (Element c -> Bool) -> c -> [c]
splitOn Char -> Bool
Element String -> Bool
isSeparator String
s
      where
        relativity :: Relativity
        relativity :: Relativity
relativity = if Char -> Bool
isSeparator Char
x then Relativity
Absolute else Relativity
Relative

-- | A filename (or path entity) in the FilePath
--
-- * Authorised
--   * ""
--   * "."
--   * ".."
--   * "foundation"
-- * Unauthorised
--   * "/"
--   * "file/"
--   * "/file"
--   * "file/path"
--
data FileName = FileName (UArray Word8)
  deriving (FileName -> FileName -> Bool
(FileName -> FileName -> Bool)
-> (FileName -> FileName -> Bool) -> Eq FileName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileName -> FileName -> Bool
$c/= :: FileName -> FileName -> Bool
== :: FileName -> FileName -> Bool
$c== :: FileName -> FileName -> Bool
Eq)
-- | errors related to FileName manipulation
data FileName_Invalid
    = ContainsNullByte
        -- ^ this means a null byte was found in the FileName
    | ContainsSeparator
        -- ^ this means a path separator was found in the FileName
    | EncodingError ValidationFailure
        -- ^ encoding error
    | UnknownTrailingBytes (UArray Word8)
        -- ^ some unknown trainling bytes found
  deriving (Typeable, Int -> FileName_Invalid -> ShowS
[FileName_Invalid] -> ShowS
FileName_Invalid -> String
(Int -> FileName_Invalid -> ShowS)
-> (FileName_Invalid -> String)
-> ([FileName_Invalid] -> ShowS)
-> Show FileName_Invalid
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileName_Invalid] -> ShowS
$cshowList :: [FileName_Invalid] -> ShowS
show :: FileName_Invalid -> String
$cshow :: FileName_Invalid -> String
showsPrec :: Int -> FileName_Invalid -> ShowS
$cshowsPrec :: Int -> FileName_Invalid -> ShowS
Show)
instance Exception FileName_Invalid

instance Show FileName where
    show :: FileName -> String
show = FileName -> String
fileNameToLString
instance IsString FileName where
  fromString :: String -> FileName
fromString [] = UArray Word8 -> FileName
FileName UArray Word8
forall a. Monoid a => a
mempty
  fromString String
xs | String -> Bool
hasNullByte  String
xs = FileName_Invalid -> FileName
forall a e. Exception e => e -> a
throw FileName_Invalid
ContainsNullByte
                | String -> Bool
hasSeparator String
xs = FileName_Invalid -> FileName
forall a e. Exception e => e -> a
throw FileName_Invalid
ContainsSeparator
                | Bool
otherwise       = UArray Word8 -> FileName
FileName (UArray Word8 -> FileName) -> UArray Word8 -> FileName
forall a b. (a -> b) -> a -> b
$ Encoding -> String -> UArray Word8
toBytes Encoding
UTF8 (String -> UArray Word8) -> String -> UArray Word8
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. IsString a => String -> a
fromString String
xs

hasNullByte :: [Char] -> Bool
hasNullByte :: String -> Bool
hasNullByte = Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
Data.List.elem Char
'\0'

hasSeparator :: [Char] -> Bool
hasSeparator :: String -> Bool
hasSeparator = Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
Data.List.elem Char
pathSeparatorC

isSeparator :: Char -> Bool
isSeparator :: Char -> Bool
isSeparator = Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
(==) Char
pathSeparatorC

hasContigueSeparators :: [Char] -> Bool
hasContigueSeparators :: String -> Bool
hasContigueSeparators [] = Bool
False
hasContigueSeparators [Char
_] = Bool
False
hasContigueSeparators (Char
x1:Char
x2:String
xs) =
    (Char -> Bool
isSeparator Char
x1 Bool -> Bool -> Bool
&& Char
x1 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
x2) Bool -> Bool -> Bool
|| String -> Bool
hasContigueSeparators String
xs

instance Semigroup FileName where
    <> :: FileName -> FileName -> FileName
(<>) (FileName UArray Word8
a) (FileName UArray Word8
b) = UArray Word8 -> FileName
FileName (UArray Word8 -> FileName) -> UArray Word8 -> FileName
forall a b. (a -> b) -> a -> b
$ UArray Word8
a UArray Word8 -> UArray Word8 -> UArray Word8
forall a. Monoid a => a -> a -> a
`mappend` UArray Word8
b
instance Monoid FileName where
    mempty :: FileName
mempty = UArray Word8 -> FileName
FileName UArray Word8
forall a. Monoid a => a
mempty

instance Path FilePath where
    type PathEnt FilePath = FileName
    type PathPrefix FilePath = Relativity
    type PathSuffix FilePath = ()
    </> :: FilePath -> PathEnt FilePath -> FilePath
(</>) = FilePath -> PathEnt FilePath -> FilePath
FilePath -> FileName -> FilePath
join
    splitPath :: FilePath
-> (PathPrefix FilePath, [PathEnt FilePath], PathSuffix FilePath)
splitPath (FilePath Relativity
r [FileName]
xs) = (PathPrefix FilePath
Relativity
r, [PathEnt FilePath]
[FileName]
xs, ())
    buildPath :: (PathPrefix FilePath, [PathEnt FilePath], PathSuffix FilePath)
-> FilePath
buildPath (PathPrefix FilePath
r, [PathEnt FilePath]
xs , PathSuffix FilePath
_) = Relativity -> [FileName] -> FilePath
FilePath PathPrefix FilePath
Relativity
r [PathEnt FilePath]
[FileName]
xs

-- compare to the original </>, this type disallow to be able to append an absolute filepath to a filepath
join :: FilePath -> FileName -> FilePath
join :: FilePath -> FileName -> FilePath
join FilePath
p              (FileName UArray Word8
x) | UArray Word8 -> Bool
forall c. Collection c => c -> Bool
null UArray Word8
x = FilePath
p
join (FilePath Relativity
r [FileName]
xs) FileName
x          = Relativity -> [FileName] -> FilePath
FilePath Relativity
r ([FileName] -> FilePath) -> [FileName] -> FilePath
forall a b. (a -> b) -> a -> b
$ [FileName] -> Element [FileName] -> [FileName]
forall c. Sequential c => c -> Element c -> c
snoc [FileName]
xs Element [FileName]
FileName
x

filePathToString :: FilePath -> String
filePathToString :: FilePath -> String
filePathToString (FilePath Relativity
Absolute []) = String -> String
forall a. IsString a => String -> a
fromString [Char
pathSeparatorC]
filePathToString (FilePath Relativity
Relative []) = String -> String
forall a. IsString a => String -> a
fromString String
"."
filePathToString (FilePath Relativity
Absolute [FileName]
fns) = Element String -> String -> String
forall c. Sequential c => Element c -> c -> c
cons Char
Element String
pathSeparatorC (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ [FileName] -> String
filenameIntercalate [FileName]
fns
filePathToString (FilePath Relativity
Relative [FileName]
fns) = [FileName] -> String
filenameIntercalate [FileName]
fns

filenameIntercalate :: [FileName] -> String
filenameIntercalate :: [FileName] -> String
filenameIntercalate = [String] -> String
forall a. Monoid a => [a] -> a
mconcat ([String] -> String)
-> ([FileName] -> [String]) -> [FileName] -> String
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> [String] -> [String]
forall a. a -> [a] -> [a]
Data.List.intersperse String
pathSeparator ([String] -> [String])
-> ([FileName] -> [String]) -> [FileName] -> [String]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (FileName -> String) -> [FileName] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FileName -> String
fileNameToString

-- | convert a FileName into a String
--
-- This function may throw an exception associated to the encoding
fileNameToString :: FileName -> String
fileNameToString :: FileName -> String
fileNameToString (FileName UArray Word8
fp) =
    -- FIXME probably incorrect considering windows.
    -- this is just to get going to be able to be able to reuse System.IO functions which
    -- works on [Char]
    case Encoding
-> UArray Word8 -> (String, Maybe ValidationFailure, UArray Word8)
fromBytes Encoding
UTF8 UArray Word8
fp of
        (String
s, Maybe ValidationFailure
Nothing, UArray Word8
bs)
            | UArray Word8 -> Bool
forall c. Collection c => c -> Bool
null UArray Word8
bs -> String
s
            | Bool
otherwise -> FileName_Invalid -> String
forall a e. Exception e => e -> a
throw (FileName_Invalid -> String) -> FileName_Invalid -> String
forall a b. (a -> b) -> a -> b
$ UArray Word8 -> FileName_Invalid
UnknownTrailingBytes UArray Word8
bs
        (String
_, Just ValidationFailure
err, UArray Word8
_) -> FileName_Invalid -> String
forall a e. Exception e => e -> a
throw (FileName_Invalid -> String) -> FileName_Invalid -> String
forall a b. (a -> b) -> a -> b
$ ValidationFailure -> FileName_Invalid
EncodingError ValidationFailure
err

-- | conversion of FileName into a list of Char
--
-- this function may throw exceptions
fileNameToLString :: FileName -> [Char]
fileNameToLString :: FileName -> String
fileNameToLString = String -> String
forall l. IsList l => l -> [Item l]
toList (String -> String) -> (FileName -> String) -> FileName -> String
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. FileName -> String
fileNameToString

-- | conversion of a FilePath into a list of Char
--
-- this function may throw exceptions
filePathToLString :: FilePath -> [Char]
filePathToLString :: FilePath -> String
filePathToLString = String -> String
forall l. IsList l => l -> [Item l]
toList (String -> String) -> (FilePath -> String) -> FilePath -> String
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. FilePath -> String
filePathToString

-- | build a file path from a given list of filename
--
-- this is unsafe and is mainly needed for testing purpose
unsafeFilePath :: Relativity -> [FileName] -> FilePath
unsafeFilePath :: Relativity -> [FileName] -> FilePath
unsafeFilePath = Relativity -> [FileName] -> FilePath
FilePath

-- | build a file name from a given ByteArray
--
-- this is unsafe and is mainly needed for testing purpose
unsafeFileName :: UArray Word8 -> FileName
unsafeFileName :: UArray Word8 -> FileName
unsafeFileName = UArray Word8 -> FileName
FileName

extension :: FileName -> Maybe FileName
extension :: FileName -> Maybe FileName
extension (FileName UArray Word8
fn) = case (Element (UArray Word8) -> Bool) -> UArray Word8 -> [UArray Word8]
forall c. Sequential c => (Element c -> Bool) -> c -> [c]
splitOn (\Element (UArray Word8)
c -> Word8
Element (UArray Word8)
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x2E) UArray Word8
fn of
                            []  -> Maybe FileName
forall a. Maybe a
Nothing
                            [UArray Word8
_] -> Maybe FileName
forall a. Maybe a
Nothing
                            [UArray Word8]
xs  -> FileName -> Maybe FileName
forall a. a -> Maybe a
Just (FileName -> Maybe FileName) -> FileName -> Maybe FileName
forall a b. (a -> b) -> a -> b
$ UArray Word8 -> FileName
FileName (UArray Word8 -> FileName) -> UArray Word8 -> FileName
forall a b. (a -> b) -> a -> b
$ NonEmpty [UArray Word8] -> Element [UArray Word8]
forall c. Sequential c => NonEmpty c -> Element c
last (NonEmpty [UArray Word8] -> Element [UArray Word8])
-> NonEmpty [UArray Word8] -> Element [UArray Word8]
forall a b. (a -> b) -> a -> b
$ [UArray Word8] -> NonEmpty [UArray Word8]
forall c. Collection c => c -> NonEmpty c
nonEmpty_ [UArray Word8]
xs