-- |
-- Module      : Foundation.VFS.Path
-- License     : BSD-style
-- Maintainer  : foundation
-- Stability   : experimental
-- Portability : portable
--

{-# LANGUAGE FlexibleContexts #-}

module Foundation.VFS.Path
    (
      -- * Path class
      Path(..)

    , parent
    , filename
    , prefix
    , suffix
    ) where

import Basement.Compat.Base

-- $setup
-- >>> import Basement.Compat.Base
-- >>> import Foundation.VFS.FilePath
-- >>> import Foundation.VFS.Path

-- | Path type class
--
-- defines the Path associated types and basic functions to implement related
-- to the path manipulation
--
-- # TODO, add missing enhancement:
--
-- @
-- splitExtension :: PathEnt path -> (PathEnt path, PathEnt path)
-- addExtension  :: PathEnt path -> PathEnt path -> PathEnt path
-- (<.>) :: path -> PathEnt path -> path
-- (-<.>) :: path -> PathEnt path -> path
-- @
--
class Path path where
    -- | the associated PathEntity of the given `path`
    -- this type is the minimal element contained in the Path
    -- a Path is not a collection but it is possible to see this
    -- associated type equivalent to the `Foundation.Collection.Element` type family
    type PathEnt path

    -- | the associated prefix of the given `path`
    --
    -- in the case of a `Foundation.VFS.FilePath`, it is a void (i.e. `()`)
    -- in the case of a `Foundation.VFS.URI`, it is the schema, host, port...
    type PathPrefix path

    -- | the associated suffix of the given path
    --
    -- in the case of the `Foundation.VFS.FilePath`, it is a void (i.e. `()`)
    -- in the case of the `Foundation.VFS.URI`, it is a the query, the fragment
    type PathSuffix path

    -- | join a path entity to a given path
    (</>) :: path -> PathEnt path -> path

    -- | split the path into the associated elements
    splitPath :: path -> ( PathPrefix path
                         , [PathEnt path]
                         , PathSuffix path
                         )

    -- | build the path from the associated elements
    buildPath :: ( PathPrefix path
                 , [PathEnt path]
                 , PathSuffix path
                 )
              -> path


-- | parent is only going to drop the filename.
--
-- if you actually want to reference to the parent directory, simply uses:
--
-- @
-- parent "." /= "." </> ".."
-- @
--
-- >>> parent ("foo.hs" :: FilePath)
-- .
--
-- >>> parent ("foo/bar/baz.hs" :: FilePath)
-- foo/bar
parent :: Path path => path -> path
parent :: path -> path
parent path
path = (PathPrefix path, [PathEnt path], PathSuffix path) -> path
forall path.
Path path =>
(PathPrefix path, [PathEnt path], PathSuffix path) -> path
buildPath (PathPrefix path
p, [PathEnt path] -> [PathEnt path]
forall a. [a] -> [a]
init [PathEnt path]
ps, PathSuffix path
s)
  where
    (PathPrefix path
p, [PathEnt path]
ps, PathSuffix path
s) = path -> (PathPrefix path, [PathEnt path], PathSuffix path)
forall path.
Path path =>
path -> (PathPrefix path, [PathEnt path], PathSuffix path)
splitPath path
path


-- | get the filename of the given path
--
-- If there is no filename, you will receive the 'mempty' of the 'PathEnt'
--
-- >>> filename ("foo.hs" :: FilePath)
-- foo.hs
--
-- >>> filename ("foo/bar/baz.hs" :: FilePath)
-- baz.hs
filename :: (Path path, Monoid (PathEnt path)) => path -> PathEnt path
filename :: path -> PathEnt path
filename path
path = case [PathEnt path]
ps of
    [] -> PathEnt path
forall a. Monoid a => a
mempty
    [PathEnt path]
_  -> [PathEnt path] -> PathEnt path
forall a. [a] -> a
last [PathEnt path]
ps
  where
    (PathPrefix path
_, [PathEnt path]
ps , PathSuffix path
_) = path -> (PathPrefix path, [PathEnt path], PathSuffix path)
forall path.
Path path =>
path -> (PathPrefix path, [PathEnt path], PathSuffix path)
splitPath path
path

-- TODO: this might be better in Sequential ?
init :: [a] -> [a]
init :: [a] -> [a]
init [] = []
init [a
_] = []
init (a
x:[a]
xs) = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
forall a. [a] -> [a]
init [a]
xs

-- TODO: this might be better in Sequential ?
last :: [a] -> a
last :: [a] -> a
last [] = a
forall a. HasCallStack => a
undefined
last [a
x] = a
x
last (a
_:[a]
xs) = [a] -> a
forall a. [a] -> a
last [a]
xs


-- | get the path prefix information
--
-- >>> prefix ("/home/tab" :: FilePath)
-- Absolute
--
-- >>> prefix ("home/tab" :: FilePath)
-- Relative
--
-- or for URI (TODO, not yet accurate)
--
-- @
-- prefix "http://github.com/vincenthz/hs-foundation?w=1"
--    == URISchema http Nothing Nothing "github.com" Nothing
-- @
prefix :: Path path => path -> PathPrefix path
prefix :: path -> PathPrefix path
prefix path
p = PathPrefix path
pre
  where
    (PathPrefix path
pre, [PathEnt path]
_, PathSuffix path
_) = path -> (PathPrefix path, [PathEnt path], PathSuffix path)
forall path.
Path path =>
path -> (PathPrefix path, [PathEnt path], PathSuffix path)
splitPath path
p

-- | get the path suffix information
--
-- >>> suffix ("/home/tab" :: FilePath)
-- ()
--
-- or for URI (TODO, not yet accurate)
--
-- @
-- suffix "http://github.com/vincenthz/hs-foundation?w=1"
--    == URISuffix (["w", "1"], Nothing)
-- @
suffix :: Path path => path -> PathSuffix path
suffix :: path -> PathSuffix path
suffix path
p = PathSuffix path
suf
  where
    (PathPrefix path
_, [PathEnt path]
_, PathSuffix path
suf) = path -> (PathPrefix path, [PathEnt path], PathSuffix path)
forall path.
Path path =>
path -> (PathPrefix path, [PathEnt path], PathSuffix path)
splitPath path
p