    -- |
    -- 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
    $c== :: Relativity -> Relativity -> Bool
    == :: Relativity -> Relativity -> Bool
    $c/= :: Relativity -> Relativity -> Bool
    /= :: 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
    $cshowsPrec :: Int -> Relativity -> ShowS
    showsPrec :: Int -> Relativity -> ShowS
    $cshow :: Relativity -> String
    show :: Relativity -> String
    $cshowList :: [Relativity] -> ShowS
    showList :: [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
    $cshowsPrec :: Int -> FilePath_Invalid -> ShowS
    showsPrec :: Int -> FilePath_Invalid -> ShowS
    $cshow :: FilePath_Invalid -> String
    show :: FilePath_Invalid -> String
    $cshowList :: [FilePath_Invalid] -> ShowS
    showList :: [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. (HasCallStack, 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
    $c== :: FileName -> FileName -> Bool
    == :: FileName -> FileName -> Bool
    $c/= :: FileName -> FileName -> Bool
    /= :: 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
    $cshowsPrec :: Int -> FileName_Invalid -> ShowS
    showsPrec :: Int -> FileName_Invalid -> ShowS
    $cshow :: FileName_Invalid -> String
    show :: FileName_Invalid -> String
    $cshowList :: [FileName_Invalid] -> ShowS
    showList :: [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. (HasCallStack, Exception e) => e -> a
    throw FileName_Invalid
    ContainsNullByte
                    | String -> Bool
    hasSeparator String
    xs = FileName_Invalid -> FileName
    forall a e. (HasCallStack, 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 a. Eq a => a -> [a] -> 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 a. Eq a => a -> [a] -> 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 b c a. (b -> c) -> (a -> b) -> a -> c
    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 b c a. (b -> c) -> (a -> b) -> a -> c
    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 a b. (a -> b) -> [a] -> [b]
    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. (HasCallStack, 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. (HasCallStack, 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
    String -> [Item String]
    forall l. IsList l => l -> [Item l]
    toList (String -> String) -> (FileName -> String) -> FileName -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    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
    String -> [Item String]
    forall l. IsList l => l -> [Item l]
    toList (String -> String) -> (FilePath -> String) -> FilePath -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    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