{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module HsLua.Module.Path (
documentedModule
, separator
, search_path_separator
, add_extension
, combine
, directory
, filename
, is_absolute
, is_relative
, join
, make_relative
, normalize
, split
, split_extension
, split_search_path
, treat_strings_as_paths
)
where
import Data.Char (toLower)
#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup (Semigroup(..))
#endif
import Data.Text (Text)
import Data.Version (Version, makeVersion)
import HsLua.Core
( LuaError, getglobal, getmetatable, nth, pop, rawset, remove, top )
import HsLua.Marshalling
( Peeker, peekList, peekString, pushList, pushName, pushString )
import HsLua.Packaging
import qualified Data.Text as T
import qualified System.FilePath as Path
documentedModule :: LuaError e => Module e
documentedModule :: forall e. LuaError e => Module e
documentedModule = Module :: forall e.
Name
-> Text
-> [Field e]
-> [DocumentedFunction e]
-> [(Operation, DocumentedFunction e)]
-> Module e
Module
{ moduleName :: Name
moduleName = Name
"path"
, moduleDescription :: Text
moduleDescription = Text
"Module for file path manipulations."
, moduleFields :: [Field e]
moduleFields = [Field e]
forall e. [Field e]
fields
, moduleFunctions :: [DocumentedFunction e]
moduleFunctions = [DocumentedFunction e]
forall e. LuaError e => [DocumentedFunction e]
functions
, moduleOperations :: [(Operation, DocumentedFunction e)]
moduleOperations = []
}
fields :: [Field e]
fields :: forall e. [Field e]
fields =
[ Field e
forall e. Field e
separator
, Field e
forall e. Field e
search_path_separator
]
separator :: Field e
separator :: forall e. Field e
separator = Field :: forall e. Text -> Text -> LuaE e () -> Field e
Field
{ fieldName :: Text
fieldName = Text
"separator"
, fieldDescription :: Text
fieldDescription = Text
"The character that separates directories."
, fieldPushValue :: LuaE e ()
fieldPushValue = [Char] -> LuaE e ()
forall e. [Char] -> LuaE e ()
pushString [Char
Path.pathSeparator]
}
search_path_separator :: Field e
search_path_separator :: forall e. Field e
search_path_separator = Field :: forall e. Text -> Text -> LuaE e () -> Field e
Field
{ fieldName :: Text
fieldName = Text
"search_path_separator"
, fieldDescription :: Text
fieldDescription = Text
"The character that is used to separate the entries in "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"the `PATH` environment variable."
, fieldPushValue :: LuaE e ()
fieldPushValue = [Char] -> LuaE e ()
forall e. [Char] -> LuaE e ()
pushString [Char
Path.searchPathSeparator]
}
functions :: LuaError e => [DocumentedFunction e]
functions :: forall e. LuaError e => [DocumentedFunction e]
functions =
[ DocumentedFunction e
forall e. DocumentedFunction e
directory
, DocumentedFunction e
forall e. DocumentedFunction e
filename
, DocumentedFunction e
forall e. DocumentedFunction e
is_absolute
, DocumentedFunction e
forall e. DocumentedFunction e
is_relative
, DocumentedFunction e
forall e. LuaError e => DocumentedFunction e
join
, DocumentedFunction e
forall e. DocumentedFunction e
make_relative
, DocumentedFunction e
forall e. DocumentedFunction e
normalize
, DocumentedFunction e
forall e. LuaError e => DocumentedFunction e
split
, DocumentedFunction e
forall e. DocumentedFunction e
split_extension
, DocumentedFunction e
forall e. LuaError e => DocumentedFunction e
split_search_path
, DocumentedFunction e
forall e. LuaError e => DocumentedFunction e
treat_strings_as_paths
]
directory :: DocumentedFunction e
directory :: forall e. DocumentedFunction e
directory = Name
-> ([Char] -> LuaE e [Char])
-> HsFnPrecursor e ([Char] -> LuaE e [Char])
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"directory"
### liftPure Path.takeDirectory
HsFnPrecursor e ([Char] -> LuaE e [Char])
-> Parameter e [Char] -> HsFnPrecursor e (LuaE e [Char])
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter e [Char]
forall e. Parameter e [Char]
filepathParam
HsFnPrecursor e (LuaE e [Char])
-> FunctionResults e [Char] -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e [Char]
forall e. Text -> FunctionResults e [Char]
filepathResult Text
"The filepath up to the last directory separator."
#? ("Gets the directory name, i.e., removes the last directory " <>
"separator and everything after from the given path.")
DocumentedFunction e -> Version -> DocumentedFunction e
forall e. DocumentedFunction e -> Version -> DocumentedFunction e
`since` Version
initialVersion
filename :: DocumentedFunction e
filename :: forall e. DocumentedFunction e
filename = Name
-> ([Char] -> LuaE e [Char])
-> HsFnPrecursor e ([Char] -> LuaE e [Char])
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"filename"
### liftPure Path.takeFileName
HsFnPrecursor e ([Char] -> LuaE e [Char])
-> Parameter e [Char] -> HsFnPrecursor e (LuaE e [Char])
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter e [Char]
forall e. Parameter e [Char]
filepathParam
HsFnPrecursor e (LuaE e [Char])
-> FunctionResults e [Char] -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e [Char]
forall e. Text -> FunctionResults e [Char]
filepathResult Text
"File name part of the input path."
#? "Get the file name."
DocumentedFunction e -> Version -> DocumentedFunction e
forall e. DocumentedFunction e -> Version -> DocumentedFunction e
`since` Version
initialVersion
is_absolute :: DocumentedFunction e
is_absolute :: forall e. DocumentedFunction e
is_absolute = Name
-> ([Char] -> LuaE e Bool)
-> HsFnPrecursor e ([Char] -> LuaE e Bool)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"is_absolute"
### liftPure Path.isAbsolute
HsFnPrecursor e ([Char] -> LuaE e Bool)
-> Parameter e [Char] -> HsFnPrecursor e (LuaE e Bool)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter e [Char]
forall e. Parameter e [Char]
filepathParam
HsFnPrecursor e (LuaE e Bool)
-> FunctionResults e Bool -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e Bool
forall e. Text -> FunctionResults e Bool
boolResult (Text
"`true` iff `filepath` is an absolute path, " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
"`false` otherwise.")
#? "Checks whether a path is absolute, i.e. not fixed to a root."
DocumentedFunction e -> Version -> DocumentedFunction e
forall e. DocumentedFunction e -> Version -> DocumentedFunction e
`since` Version
initialVersion
is_relative :: DocumentedFunction e
is_relative :: forall e. DocumentedFunction e
is_relative = Name
-> ([Char] -> LuaE e Bool)
-> HsFnPrecursor e ([Char] -> LuaE e Bool)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"is_relative"
### liftPure Path.isRelative
HsFnPrecursor e ([Char] -> LuaE e Bool)
-> Parameter e [Char] -> HsFnPrecursor e (LuaE e Bool)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter e [Char]
forall e. Parameter e [Char]
filepathParam
HsFnPrecursor e (LuaE e Bool)
-> FunctionResults e Bool -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e Bool
forall e. Text -> FunctionResults e Bool
boolResult (Text
"`true` iff `filepath` is a relative path, " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
"`false` otherwise.")
#? "Checks whether a path is relative or fixed to a root."
DocumentedFunction e -> Version -> DocumentedFunction e
forall e. DocumentedFunction e -> Version -> DocumentedFunction e
`since` Version
initialVersion
join :: LuaError e => DocumentedFunction e
join :: forall e. LuaError e => DocumentedFunction e
join = Name
-> ([[Char]] -> LuaE e [Char])
-> HsFnPrecursor e ([[Char]] -> LuaE e [Char])
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"join"
### liftPure Path.joinPath
HsFnPrecursor e ([[Char]] -> LuaE e [Char])
-> Parameter e [[Char]] -> HsFnPrecursor e (LuaE e [Char])
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e [[Char]] -> Text -> Text -> Text -> Parameter e [[Char]]
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter (Peeker e [Char] -> Peeker e [[Char]]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e [Char]
forall e. Peeker e [Char]
peekFilePath) Text
"{string,...}"
Text
"filepaths" Text
"path components"
HsFnPrecursor e (LuaE e [Char])
-> FunctionResults e [Char] -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e [Char]
forall e. Text -> FunctionResults e [Char]
filepathResult Text
"The joined path."
#? "Join path elements back together by the directory separator."
DocumentedFunction e -> Version -> DocumentedFunction e
forall e. DocumentedFunction e -> Version -> DocumentedFunction e
`since` Version
initialVersion
make_relative :: DocumentedFunction e
make_relative :: forall e. DocumentedFunction e
make_relative = Name
-> ([Char] -> [Char] -> Maybe Bool -> LuaE e [Char])
-> HsFnPrecursor
e ([Char] -> [Char] -> Maybe Bool -> LuaE e [Char])
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"make_relative"
### liftPure3 makeRelative
HsFnPrecursor e ([Char] -> [Char] -> Maybe Bool -> LuaE e [Char])
-> Parameter e [Char]
-> HsFnPrecursor e ([Char] -> Maybe Bool -> LuaE e [Char])
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e [Char] -> Text -> Text -> Text -> Parameter e [Char]
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter
Peeker e [Char]
forall e. Peeker e [Char]
peekFilePath
Text
"string"
Text
"path"
Text
"path to be made relative"
HsFnPrecursor e ([Char] -> Maybe Bool -> LuaE e [Char])
-> Parameter e [Char]
-> HsFnPrecursor e (Maybe Bool -> LuaE e [Char])
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e [Char] -> Text -> Text -> Text -> Parameter e [Char]
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter
Peeker e [Char]
forall e. Peeker e [Char]
peekFilePath
Text
"string"
Text
"root"
Text
"root path"
HsFnPrecursor e (Maybe Bool -> LuaE e [Char])
-> Parameter e (Maybe Bool) -> HsFnPrecursor e (LuaE e [Char])
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter e Bool -> Parameter e (Maybe Bool)
forall e a. Parameter e a -> Parameter e (Maybe a)
opt (Text -> Text -> Parameter e Bool
forall e. Text -> Text -> Parameter e Bool
boolParam Text
"unsafe" Text
"whether to allow `..` in the result.")
HsFnPrecursor e (LuaE e [Char])
-> FunctionResults e [Char] -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e [Char]
forall e. Text -> FunctionResults e [Char]
filepathResult Text
"contracted filename"
#? mconcat
[ "Contract a filename, based on a relative path. Note that the "
, "resulting path will never introduce `..` paths, as the "
, "presence of symlinks means `../b` may not reach `a/b` if it "
, "starts from `a/c`. For a worked example see "
, "[this blog post](http://neilmitchell.blogspot.co.uk"
, "/2015/10/filepaths-are-subtle-symlinks-are-hard.html)."
]
DocumentedFunction e -> Version -> DocumentedFunction e
forall e. DocumentedFunction e -> Version -> DocumentedFunction e
`since` Version
initialVersion
normalize :: DocumentedFunction e
normalize :: forall e. DocumentedFunction e
normalize = Name
-> ([Char] -> LuaE e [Char])
-> HsFnPrecursor e ([Char] -> LuaE e [Char])
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"normalize"
### liftPure Path.normalise
HsFnPrecursor e ([Char] -> LuaE e [Char])
-> Parameter e [Char] -> HsFnPrecursor e (LuaE e [Char])
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter e [Char]
forall e. Parameter e [Char]
filepathParam
HsFnPrecursor e (LuaE e [Char])
-> FunctionResults e [Char] -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e [Char]
forall e. Text -> FunctionResults e [Char]
filepathResult Text
"The normalized path."
#? T.unlines
[ "Normalizes a path."
, ""
, " - `//` makes sense only as part of a (Windows) network drive;"
, " elsewhere, multiple slashes are reduced to a single"
, " `path.separator` (platform dependent)."
, " - `/` becomes `path.separator` (platform dependent)."
, " - `./` is removed."
, " - an empty path becomes `.`"
]
DocumentedFunction e -> Version -> DocumentedFunction e
forall e. DocumentedFunction e -> Version -> DocumentedFunction e
`since` Version
initialVersion
split :: LuaError e => DocumentedFunction e
split :: forall e. LuaError e => DocumentedFunction e
split = Name
-> ([Char] -> LuaE e [[Char]])
-> HsFnPrecursor e ([Char] -> LuaE e [[Char]])
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"split"
### liftPure Path.splitDirectories
HsFnPrecursor e ([Char] -> LuaE e [[Char]])
-> Parameter e [Char] -> HsFnPrecursor e (LuaE e [[Char]])
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter e [Char]
forall e. Parameter e [Char]
filepathParam
HsFnPrecursor e (LuaE e [[Char]])
-> FunctionResults e [[Char]] -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e [[Char]]
forall e. LuaError e => Text -> FunctionResults e [[Char]]
filepathListResult Text
"List of all path components."
#? "Splits a path by the directory separator."
DocumentedFunction e -> Version -> DocumentedFunction e
forall e. DocumentedFunction e -> Version -> DocumentedFunction e
`since` Version
initialVersion
split_extension :: DocumentedFunction e
split_extension :: forall e. DocumentedFunction e
split_extension = Name
-> ([Char] -> LuaE e ([Char], [Char]))
-> HsFnPrecursor e ([Char] -> LuaE e ([Char], [Char]))
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"split_extension"
### liftPure Path.splitExtension
HsFnPrecursor e ([Char] -> LuaE e ([Char], [Char]))
-> Parameter e [Char] -> HsFnPrecursor e (LuaE e ([Char], [Char]))
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter e [Char]
forall e. Parameter e [Char]
filepathParam
HsFnPrecursor e (LuaE e ([Char], [Char]))
-> FunctionResults e ([Char], [Char]) -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> (Pusher e ([Char], [Char])
-> Text -> Text -> FunctionResults e ([Char], [Char])
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult ([Char] -> LuaE e ()
forall e. [Char] -> LuaE e ()
pushString ([Char] -> LuaE e ())
-> (([Char], [Char]) -> [Char]) -> Pusher e ([Char], [Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char], [Char]) -> [Char]
forall a b. (a, b) -> a
fst) Text
"string" Text
"filepath without extension"
FunctionResults e ([Char], [Char])
-> FunctionResults e ([Char], [Char])
-> FunctionResults e ([Char], [Char])
forall a. [a] -> [a] -> [a]
++
Pusher e ([Char], [Char])
-> Text -> Text -> FunctionResults e ([Char], [Char])
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult ([Char] -> LuaE e ()
forall e. [Char] -> LuaE e ()
pushString ([Char] -> LuaE e ())
-> (([Char], [Char]) -> [Char]) -> Pusher e ([Char], [Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char], [Char]) -> [Char]
forall a b. (a, b) -> b
snd) Text
"string" Text
"extension or empty string")
#? ("Splits the last extension from a file path and returns the parts. "
<> "The extension, if present, includes the leading separator; "
<> "if the path has no extension, then the empty string is returned "
<> "as the extension.")
DocumentedFunction e -> Version -> DocumentedFunction e
forall e. DocumentedFunction e -> Version -> DocumentedFunction e
`since` Version
initialVersion
split_search_path :: LuaError e => DocumentedFunction e
split_search_path :: forall e. LuaError e => DocumentedFunction e
split_search_path = Name
-> ([Char] -> LuaE e [[Char]])
-> HsFnPrecursor e ([Char] -> LuaE e [[Char]])
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"split_search_path"
### liftPure Path.splitSearchPath
HsFnPrecursor e ([Char] -> LuaE e [[Char]])
-> Parameter e [Char] -> HsFnPrecursor e (LuaE e [[Char]])
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter :: forall e a. Peeker e a -> ParameterDoc -> Parameter e a
Parameter
{ parameterPeeker :: Peeker e [Char]
parameterPeeker = Peeker e [Char]
forall e. Peeker e [Char]
peekString
, parameterDoc :: ParameterDoc
parameterDoc = ParameterDoc :: Text -> Text -> Text -> Bool -> ParameterDoc
ParameterDoc
{ parameterName :: Text
parameterName = Text
"search_path"
, parameterType :: Text
parameterType = Text
"string"
, parameterDescription :: Text
parameterDescription = Text
"platform-specific search path"
, parameterIsOptional :: Bool
parameterIsOptional = Bool
False
}
}
HsFnPrecursor e (LuaE e [[Char]])
-> FunctionResults e [[Char]] -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e [[Char]]
forall e. LuaError e => Text -> FunctionResults e [[Char]]
filepathListResult Text
"list of directories in search path"
#? ("Takes a string and splits it on the `search_path_separator` "
<> "character. Blank items are ignored on Windows, "
<> "and converted to `.` on Posix. "
<> "On Windows path elements are stripped of quotes.")
DocumentedFunction e -> Version -> DocumentedFunction e
forall e. DocumentedFunction e -> Version -> DocumentedFunction e
`since` Version
initialVersion
combine :: DocumentedFunction e
combine :: forall e. DocumentedFunction e
combine = Name
-> ([Char] -> [Char] -> LuaE e [Char])
-> HsFnPrecursor e ([Char] -> [Char] -> LuaE e [Char])
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"combine"
### liftPure2 Path.combine
HsFnPrecursor e ([Char] -> [Char] -> LuaE e [Char])
-> Parameter e [Char] -> HsFnPrecursor e ([Char] -> LuaE e [Char])
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter e [Char]
forall e. Parameter e [Char]
filepathParam
HsFnPrecursor e ([Char] -> LuaE e [Char])
-> Parameter e [Char] -> HsFnPrecursor e (LuaE e [Char])
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter e [Char]
forall e. Parameter e [Char]
filepathParam
HsFnPrecursor e (LuaE e [Char])
-> FunctionResults e [Char] -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e [Char]
forall e. Text -> FunctionResults e [Char]
filepathResult Text
"combined paths"
#? "Combine two paths with a path separator."
add_extension :: DocumentedFunction e
add_extension :: forall e. DocumentedFunction e
add_extension = Name
-> ([Char] -> [Char] -> LuaE e [Char])
-> HsFnPrecursor e ([Char] -> [Char] -> LuaE e [Char])
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"add_extension"
### liftPure2 Path.addExtension
HsFnPrecursor e ([Char] -> [Char] -> LuaE e [Char])
-> Parameter e [Char] -> HsFnPrecursor e ([Char] -> LuaE e [Char])
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter e [Char]
forall e. Parameter e [Char]
filepathParam
HsFnPrecursor e ([Char] -> LuaE e [Char])
-> Parameter e [Char] -> HsFnPrecursor e (LuaE e [Char])
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter :: forall e a. Peeker e a -> ParameterDoc -> Parameter e a
Parameter
{ parameterPeeker :: Peeker e [Char]
parameterPeeker = Peeker e [Char]
forall e. Peeker e [Char]
peekString
, parameterDoc :: ParameterDoc
parameterDoc = ParameterDoc :: Text -> Text -> Text -> Bool -> ParameterDoc
ParameterDoc
{ parameterName :: Text
parameterName = Text
"extension"
, parameterType :: Text
parameterType = Text
"string"
, parameterDescription :: Text
parameterDescription = Text
"an extension, with or without separator dot"
, parameterIsOptional :: Bool
parameterIsOptional = Bool
False
}
}
HsFnPrecursor e (LuaE e [Char])
-> FunctionResults e [Char] -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Text -> FunctionResults e [Char]
forall e. Text -> FunctionResults e [Char]
filepathResult Text
"filepath with extension"
#? "Adds an extension, even if there is already one."
DocumentedFunction e -> Version -> DocumentedFunction e
forall e. DocumentedFunction e -> Version -> DocumentedFunction e
`since` Version
initialVersion
stringAugmentationFunctions :: LuaError e => [DocumentedFunction e]
stringAugmentationFunctions :: forall e. LuaError e => [DocumentedFunction e]
stringAugmentationFunctions =
[ DocumentedFunction e
forall e. DocumentedFunction e
directory
, DocumentedFunction e
forall e. DocumentedFunction e
filename
, DocumentedFunction e
forall e. DocumentedFunction e
is_absolute
, DocumentedFunction e
forall e. DocumentedFunction e
is_relative
, DocumentedFunction e
forall e. DocumentedFunction e
normalize
, DocumentedFunction e
forall e. LuaError e => DocumentedFunction e
split
, DocumentedFunction e
forall e. DocumentedFunction e
split_extension
, DocumentedFunction e
forall e. LuaError e => DocumentedFunction e
split_search_path
]
treat_strings_as_paths :: LuaError e => DocumentedFunction e
treat_strings_as_paths :: forall e. LuaError e => DocumentedFunction e
treat_strings_as_paths = Name -> LuaE e () -> HsFnPrecursor e (LuaE e ())
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"treat_strings_as_paths"
### do let addFunction fn = do
pushName (functionName fn)
pushDocumentedFunction fn
rawset (nth 3)
pushString "" *> getmetatable top *> remove (nth 2)
mapM_ addFunction
[setName "__add" add_extension, setName "__div" combine]
pop 1
_ <- getglobal "string"
mapM_ addFunction stringAugmentationFunctions
pop 1
HsFnPrecursor e (LuaE e ())
-> FunctionResults e () -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> []
#? ("Augment the string module such that strings can be used as "
<> "path objects.")
DocumentedFunction e -> Version -> DocumentedFunction e
forall e. DocumentedFunction e -> Version -> DocumentedFunction e
`since` Version
initialVersion
peekFilePath :: Peeker e FilePath
peekFilePath :: forall e. Peeker e [Char]
peekFilePath = Peeker e [Char]
forall e. Peeker e [Char]
peekString
filepathParam :: Parameter e FilePath
filepathParam :: forall e. Parameter e [Char]
filepathParam = Peeker e [Char] -> Text -> Text -> Text -> Parameter e [Char]
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e [Char]
forall e. Peeker e [Char]
peekFilePath Text
"string" Text
"filepath" Text
"path"
filepathResult :: Text
-> FunctionResults e FilePath
filepathResult :: forall e. Text -> FunctionResults e [Char]
filepathResult = Text -> FunctionResults e [Char]
forall e. Text -> FunctionResults e [Char]
stringResult
filepathListResult :: LuaError e
=> Text
-> FunctionResults e [FilePath]
filepathListResult :: forall e. LuaError e => Text -> FunctionResults e [[Char]]
filepathListResult = Pusher e [[Char]] -> Text -> Text -> FunctionResults e [[Char]]
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult (Pusher e [Char] -> Pusher e [[Char]]
forall e a. LuaError e => Pusher e a -> [a] -> LuaE e ()
pushList Pusher e [Char]
forall e. [Char] -> LuaE e ()
pushString) Text
"{string,...}"
makeRelative :: FilePath
-> FilePath
-> Maybe Bool
-> FilePath
makeRelative :: [Char] -> [Char] -> Maybe Bool -> [Char]
makeRelative [Char]
path [Char]
root Maybe Bool
unsafe
| [Char] -> [Char] -> Bool
Path.equalFilePath [Char]
root [Char]
path = [Char]
"."
| [Char] -> [Char]
takeAbs [Char]
root [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Char] -> [Char]
takeAbs [Char]
path = [Char]
path
| Bool
otherwise = [Char] -> [Char] -> [Char]
go ([Char] -> [Char]
dropAbs [Char]
path) ([Char] -> [Char]
dropAbs [Char]
root)
where
go :: [Char] -> [Char] -> [Char]
go [Char]
x [Char]
"" = (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
Path.isPathSeparator [Char]
x
go [Char]
x [Char]
y =
let ([Char]
x1, [Char]
x2) = [Char] -> ([Char], [Char])
breakPath [Char]
x
([Char]
y1, [Char]
y2) = [Char] -> ([Char], [Char])
breakPath [Char]
y
in case () of
()
_ | [Char] -> [Char] -> Bool
Path.equalFilePath [Char]
x1 [Char]
y1 -> [Char] -> [Char] -> [Char]
go [Char]
x2 [Char]
y2
()
_ | Maybe Bool
unsafe Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True -> [[Char]] -> [Char]
Path.joinPath [[Char]
"..", [Char]
x1, [Char] -> [Char] -> [Char]
go [Char]
x2 [Char]
y2]
()
_ -> [Char]
path
breakPath :: [Char] -> ([Char], [Char])
breakPath = ([Char] -> [Char]) -> ([Char], [Char]) -> ([Char], [Char])
forall {t} {b}. (t -> b) -> (t, t) -> (b, b)
both ((Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
Path.isPathSeparator)
(([Char], [Char]) -> ([Char], [Char]))
-> ([Char] -> ([Char], [Char])) -> [Char] -> ([Char], [Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
Path.isPathSeparator
([Char] -> ([Char], [Char]))
-> ([Char] -> [Char]) -> [Char] -> ([Char], [Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
Path.isPathSeparator
both :: (t -> b) -> (t, t) -> (b, b)
both t -> b
f (t
a, t
b) = (t -> b
f t
a, t -> b
f t
b)
leadingPathSepOnWindows :: [Char] -> Bool
leadingPathSepOnWindows = \case
[Char]
"" -> Bool
False
[Char]
x | [Char] -> Bool
Path.hasDrive [Char]
x -> Bool
False
Char
c:[Char]
_ -> Char -> Bool
Path.isPathSeparator Char
c
dropAbs :: [Char] -> [Char]
dropAbs [Char]
x = if [Char] -> Bool
leadingPathSepOnWindows [Char]
x then [Char] -> [Char]
forall a. [a] -> [a]
tail [Char]
x else [Char] -> [Char]
Path.dropDrive [Char]
x
takeAbs :: [Char] -> [Char]
takeAbs [Char]
x = if [Char] -> Bool
leadingPathSepOnWindows [Char]
x
then [Char
Path.pathSeparator]
else (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map (\Char
y ->
if Char -> Bool
Path.isPathSeparator Char
y
then Char
Path.pathSeparator
else Char -> Char
toLower Char
y)
([Char] -> [Char]
Path.takeDrive [Char]
x)
initialVersion :: Version
initialVersion :: Version
initialVersion = [Int] -> Version
makeVersion [Int
0,Int
1,Int
0]