-- | -- 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