{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-|
Module      : HsLua.Module.Path
Copyright   : © 2021 Albert Krewinkel
License     : MIT
Maintainer  : Albert Krewinkel <albert+hslua@zeitkraut.de>

Lua module to work with file paths.
-}
module HsLua.Module.Path (
  -- * Module
    documentedModule

  -- * Fields
  , separator
  , search_path_separator

  -- * Path manipulation
  , 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(..))  -- includes (<>)
#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, peekBool, peekList, peekString
  , pushBool, pushList, pushName, pushString )
import HsLua.Packaging

import qualified Data.Text as T
import qualified System.FilePath as Path

-- | The @path@ module specification.
documentedModule :: LuaError e => Module e
documentedModule :: 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
--

-- | Exported fields.
fields :: [Field e]
fields :: [Field e]
fields =
  [ Field e
forall e. Field e
separator
  , Field e
forall e. Field e
search_path_separator
  ]

-- | Wrapper for @'Path.pathSeparator'@.
separator :: Field e
separator :: 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 = String -> LuaE e ()
forall e. String -> LuaE e ()
pushString [Char
Path.pathSeparator]
  }

-- | Wrapper for @'Path.searchPathSeparator'@.
search_path_separator :: Field e
search_path_separator :: 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 = String -> LuaE e ()
forall e. String -> LuaE e ()
pushString [Char
Path.searchPathSeparator]
  }

--
-- Functions
--

functions :: LuaError e => [DocumentedFunction e]
functions :: [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
  ]

-- | See @Path.takeDirectory@
directory :: DocumentedFunction e
directory :: DocumentedFunction e
directory = Name
-> (String -> LuaE e String)
-> HsFnPrecursor e (String -> LuaE e String)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"directory"
  ### liftPure Path.takeDirectory
  HsFnPrecursor e (String -> LuaE e String)
-> Parameter e String -> HsFnPrecursor e (LuaE e String)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter e String
forall e. Parameter e String
filepathParam
  HsFnPrecursor e (LuaE e String)
-> FunctionResults e String -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> [Text -> FunctionResult e String
forall e. Text -> FunctionResult e String
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

-- | See @Path.takeFilename@
filename :: DocumentedFunction e
filename :: DocumentedFunction e
filename = Name
-> (String -> LuaE e String)
-> HsFnPrecursor e (String -> LuaE e String)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"filename"
  ### liftPure Path.takeFileName
  HsFnPrecursor e (String -> LuaE e String)
-> Parameter e String -> HsFnPrecursor e (LuaE e String)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter e String
forall e. Parameter e String
filepathParam
  HsFnPrecursor e (LuaE e String)
-> FunctionResults e String -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> [Text -> FunctionResult e String
forall e. Text -> FunctionResult e String
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

-- | See @Path.isAbsolute@
is_absolute :: DocumentedFunction e
is_absolute :: DocumentedFunction e
is_absolute = Name
-> (String -> LuaE e Bool)
-> HsFnPrecursor e (String -> LuaE e Bool)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"is_absolute"
  ### liftPure Path.isAbsolute
  HsFnPrecursor e (String -> LuaE e Bool)
-> Parameter e String -> HsFnPrecursor e (LuaE e Bool)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter e String
forall e. Parameter e String
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 -> FunctionResult e Bool
forall e. Text -> FunctionResult e Bool
booleanResult (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

-- | See @Path.isRelative@
is_relative :: DocumentedFunction e
is_relative :: DocumentedFunction e
is_relative = Name
-> (String -> LuaE e Bool)
-> HsFnPrecursor e (String -> LuaE e Bool)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"is_relative"
  ### liftPure Path.isRelative
  HsFnPrecursor e (String -> LuaE e Bool)
-> Parameter e String -> HsFnPrecursor e (LuaE e Bool)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter e String
forall e. Parameter e String
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 -> FunctionResult e Bool
forall e. Text -> FunctionResult e Bool
booleanResult (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

-- | See @Path.joinPath@
join :: LuaError e => DocumentedFunction e
join :: DocumentedFunction e
join = Name
-> ([String] -> LuaE e String)
-> HsFnPrecursor e ([String] -> LuaE e String)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"join"
  ### liftPure Path.joinPath
  HsFnPrecursor e ([String] -> LuaE e String)
-> Parameter e [String] -> HsFnPrecursor e (LuaE e String)
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 [String]
parameterPeeker = Peeker e String -> Peeker e [String]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e String
forall e. Peeker e String
peekFilePath
      , parameterDoc :: ParameterDoc
parameterDoc = ParameterDoc :: Text -> Text -> Text -> Bool -> ParameterDoc
ParameterDoc
        { parameterName :: Text
parameterName = Text
"filepaths"
        , parameterType :: Text
parameterType = Text
"list of strings"
        , parameterDescription :: Text
parameterDescription = Text
"path components"
        , parameterIsOptional :: Bool
parameterIsOptional = Bool
False
        }
      }
  HsFnPrecursor e (LuaE e String)
-> FunctionResults e String -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> [Text -> FunctionResult e String
forall e. Text -> FunctionResult e String
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 :: DocumentedFunction e
make_relative = Name
-> (String -> String -> Maybe Bool -> LuaE e String)
-> HsFnPrecursor
     e (String -> String -> Maybe Bool -> LuaE e String)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"make_relative"
  ### liftPure3 makeRelative
  HsFnPrecursor e (String -> String -> Maybe Bool -> LuaE e String)
-> Parameter e String
-> HsFnPrecursor e (String -> Maybe Bool -> LuaE e String)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e String -> Text -> Text -> Text -> Parameter e String
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter
        Peeker e String
forall e. Peeker e String
peekFilePath
        Text
"string"
        Text
"path"
        Text
"path to be made relative"
  HsFnPrecursor e (String -> Maybe Bool -> LuaE e String)
-> Parameter e String
-> HsFnPrecursor e (Maybe Bool -> LuaE e String)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e String -> Text -> Text -> Text -> Parameter e String
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter
        Peeker e String
forall e. Peeker e String
peekFilePath
        Text
"string"
        Text
"root"
        Text
"root path"
  HsFnPrecursor e (Maybe Bool -> LuaE e String)
-> Parameter e (Maybe Bool) -> HsFnPrecursor e (LuaE e String)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e Bool -> Text -> Text -> Text -> Parameter e (Maybe Bool)
forall e a.
Peeker e a -> Text -> Text -> Text -> Parameter e (Maybe a)
optionalParameter
        Peeker e Bool
forall e. Peeker e Bool
peekBool
        Text
"boolean"
        Text
"unsafe"
        Text
"whether to allow `..` in the result."
  HsFnPrecursor e (LuaE e String)
-> FunctionResults e String -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> [Text -> FunctionResult e String
forall e. Text -> FunctionResult e String
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

-- | See @Path.normalise@
normalize :: DocumentedFunction e
normalize :: DocumentedFunction e
normalize = Name
-> (String -> LuaE e String)
-> HsFnPrecursor e (String -> LuaE e String)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"normalize"
  ### liftPure Path.normalise
  HsFnPrecursor e (String -> LuaE e String)
-> Parameter e String -> HsFnPrecursor e (LuaE e String)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter e String
forall e. Parameter e String
filepathParam
  HsFnPrecursor e (LuaE e String)
-> FunctionResults e String -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> [Text -> FunctionResult e String
forall e. Text -> FunctionResult e String
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

-- | See @Path.splitDirectories@.
--
-- Note that this does /not/ wrap @'Path.splitPath'@, as that function
-- adds trailing slashes to each directory, which is often inconvenient.
split :: LuaError e => DocumentedFunction e
split :: DocumentedFunction e
split = Name
-> (String -> LuaE e [String])
-> HsFnPrecursor e (String -> LuaE e [String])
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"split"
  ### liftPure Path.splitDirectories
  HsFnPrecursor e (String -> LuaE e [String])
-> Parameter e String -> HsFnPrecursor e (LuaE e [String])
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter e String
forall e. Parameter e String
filepathParam
  HsFnPrecursor e (LuaE e [String])
-> FunctionResults e [String] -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> [Text -> FunctionResult e [String]
forall e. LuaError e => Text -> FunctionResult e [String]
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

-- | See @Path.splitExtension@
split_extension :: DocumentedFunction e
split_extension :: DocumentedFunction e
split_extension = Name
-> (String -> LuaE e (String, String))
-> HsFnPrecursor e (String -> LuaE e (String, String))
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"split_extension"
  ### liftPure Path.splitExtension
  HsFnPrecursor e (String -> LuaE e (String, String))
-> Parameter e String -> HsFnPrecursor e (LuaE e (String, String))
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter e String
forall e. Parameter e String
filepathParam
  HsFnPrecursor e (LuaE e (String, String))
-> FunctionResults e (String, String) -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> [ FunctionResult :: forall e a. Pusher e a -> ResultValueDoc -> FunctionResult e a
FunctionResult
        { fnResultPusher :: Pusher e (String, String)
fnResultPusher = String -> LuaE e ()
forall e. String -> LuaE e ()
pushString (String -> LuaE e ())
-> ((String, String) -> String) -> Pusher e (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> String
forall a b. (a, b) -> a
fst
        , fnResultDoc :: ResultValueDoc
fnResultDoc = ResultValueDoc :: Text -> Text -> ResultValueDoc
ResultValueDoc
          { resultValueType :: Text
resultValueType = Text
"string"
          , resultValueDescription :: Text
resultValueDescription = Text
"filepath without extension"
          }
        },
        FunctionResult :: forall e a. Pusher e a -> ResultValueDoc -> FunctionResult e a
FunctionResult
        { fnResultPusher :: Pusher e (String, String)
fnResultPusher = String -> LuaE e ()
forall e. String -> LuaE e ()
pushString (String -> LuaE e ())
-> ((String, String) -> String) -> Pusher e (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> String
forall a b. (a, b) -> b
snd
        , fnResultDoc :: ResultValueDoc
fnResultDoc = ResultValueDoc :: Text -> Text -> ResultValueDoc
ResultValueDoc
          { resultValueType :: Text
resultValueType = Text
"string"
          , resultValueDescription :: Text
resultValueDescription = 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

-- | Wraps function @'Path.splitSearchPath'@.
split_search_path :: LuaError e => DocumentedFunction e
split_search_path :: DocumentedFunction e
split_search_path = Name
-> (String -> LuaE e [String])
-> HsFnPrecursor e (String -> LuaE e [String])
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"split_search_path"
  ### liftPure Path.splitSearchPath
  HsFnPrecursor e (String -> LuaE e [String])
-> Parameter e String -> HsFnPrecursor e (LuaE e [String])
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 String
parameterPeeker = Peeker e String
forall e. Peeker e String
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 [String])
-> FunctionResults e [String] -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> [Text -> FunctionResult e [String]
forall e. LuaError e => Text -> FunctionResult e [String]
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

-- | Join two paths with a directory separator. Wraps @'Path.combine'@.
combine :: DocumentedFunction e
combine :: DocumentedFunction e
combine = Name
-> (String -> String -> LuaE e String)
-> HsFnPrecursor e (String -> String -> LuaE e String)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"combine"
  ### liftPure2 Path.combine
  HsFnPrecursor e (String -> String -> LuaE e String)
-> Parameter e String -> HsFnPrecursor e (String -> LuaE e String)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter e String
forall e. Parameter e String
filepathParam
  HsFnPrecursor e (String -> LuaE e String)
-> Parameter e String -> HsFnPrecursor e (LuaE e String)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter e String
forall e. Parameter e String
filepathParam
  HsFnPrecursor e (LuaE e String)
-> FunctionResults e String -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> [Text -> FunctionResult e String
forall e. Text -> FunctionResult e String
filepathResult Text
"combined paths"]
  #? "Combine two paths with a path separator."

-- | Adds an extension to a file path. Wraps @'Path.addExtension'@.
add_extension :: DocumentedFunction e
add_extension :: DocumentedFunction e
add_extension = Name
-> (String -> String -> LuaE e String)
-> HsFnPrecursor e (String -> String -> LuaE e String)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"add_extension"
  ### liftPure2 Path.addExtension
  HsFnPrecursor e (String -> String -> LuaE e String)
-> Parameter e String -> HsFnPrecursor e (String -> LuaE e String)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter e String
forall e. Parameter e String
filepathParam
  HsFnPrecursor e (String -> LuaE e String)
-> Parameter e String -> HsFnPrecursor e (LuaE e String)
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 String
parameterPeeker = Peeker e String
forall e. Peeker e String
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 String)
-> FunctionResults e String -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> [Text -> FunctionResult e String
forall e. Text -> FunctionResult e String
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 :: [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 :: 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)
         -- for some reason we can't just dump all functions into the
         -- string metatable, but have to use the string module for
         -- non-metamethods.
         pushString "" *> getmetatable top *> remove (nth 2)
         mapM_ addFunction
           [setName "__add" add_extension, setName "__div" combine]
         pop 1  -- string metatable

         _ <- getglobal "string"
         mapM_ addFunction stringAugmentationFunctions
         pop 1 -- string module
  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

--
-- Parameters
--

-- | Retrieves a file path from the stack.
peekFilePath :: Peeker e FilePath
peekFilePath :: Peeker e String
peekFilePath = Peeker e String
forall e. Peeker e String
peekString

-- | Filepath function parameter.
filepathParam :: Parameter e FilePath
filepathParam :: Parameter e String
filepathParam = Parameter :: forall e a. Peeker e a -> ParameterDoc -> Parameter e a
Parameter
  { parameterPeeker :: Peeker e String
parameterPeeker = Peeker e String
forall e. Peeker e String
peekFilePath
  , parameterDoc :: ParameterDoc
parameterDoc = ParameterDoc :: Text -> Text -> Text -> Bool -> ParameterDoc
ParameterDoc
    { parameterName :: Text
parameterName = Text
"filepath"
    , parameterType :: Text
parameterType = Text
"string"
    , parameterDescription :: Text
parameterDescription = Text
"path"
    , parameterIsOptional :: Bool
parameterIsOptional = Bool
False
    }
  }

-- | Result of a function returning a file path.
filepathResult :: Text -- ^ Description
               -> FunctionResult e FilePath
filepathResult :: Text -> FunctionResult e String
filepathResult Text
desc = FunctionResult :: forall e a. Pusher e a -> ResultValueDoc -> FunctionResult e a
FunctionResult
  { fnResultPusher :: Pusher e String
fnResultPusher = Pusher e String
forall e. String -> LuaE e ()
pushString
  , fnResultDoc :: ResultValueDoc
fnResultDoc = ResultValueDoc :: Text -> Text -> ResultValueDoc
ResultValueDoc
    { resultValueType :: Text
resultValueType = Text
"string"
    , resultValueDescription :: Text
resultValueDescription = Text
desc
    }
  }

-- | List of filepaths function result.
filepathListResult :: LuaError e
                   => Text -- ^ Description
                   -> FunctionResult e [FilePath]
filepathListResult :: Text -> FunctionResult e [String]
filepathListResult Text
desc = FunctionResult :: forall e a. Pusher e a -> ResultValueDoc -> FunctionResult e a
FunctionResult
  { fnResultPusher :: Pusher e [String]
fnResultPusher = Pusher e String -> Pusher e [String]
forall e a. LuaError e => Pusher e a -> [a] -> LuaE e ()
pushList Pusher e String
forall e. String -> LuaE e ()
pushString
  , fnResultDoc :: ResultValueDoc
fnResultDoc = ResultValueDoc :: Text -> Text -> ResultValueDoc
ResultValueDoc
    { resultValueType :: Text
resultValueType = Text
"list of strings"
    , resultValueDescription :: Text
resultValueDescription = Text
desc
    }
  }

-- | Boolean function result.
booleanResult :: Text -- ^ Description
              -> FunctionResult e Bool
booleanResult :: Text -> FunctionResult e Bool
booleanResult Text
desc = FunctionResult :: forall e a. Pusher e a -> ResultValueDoc -> FunctionResult e a
FunctionResult
  { fnResultPusher :: Pusher e Bool
fnResultPusher = Pusher e Bool
forall e. Pusher e Bool
pushBool
  , fnResultDoc :: ResultValueDoc
fnResultDoc = ResultValueDoc :: Text -> Text -> ResultValueDoc
ResultValueDoc
    { resultValueType :: Text
resultValueType = Text
"boolean"
    , resultValueDescription :: Text
resultValueDescription = Text
desc
    }
  }

--
-- Helpers
--

-- | Alternative version of @'Path.makeRelative'@, which introduces @..@
-- paths if desired.
makeRelative :: FilePath      -- ^ path to be made relative
             -> FilePath      -- ^ root directory from which to start
             -> Maybe Bool    -- ^ whether to use unsafe relative paths.
             -> FilePath
makeRelative :: String -> String -> Maybe Bool -> String
makeRelative String
path String
root Maybe Bool
unsafe
 | String -> String -> Bool
Path.equalFilePath String
root String
path = String
"."
 | String -> String
takeAbs String
root String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String -> String
takeAbs String
path = String
path
 | Bool
otherwise = String -> String -> String
go (String -> String
dropAbs String
path) (String -> String
dropAbs String
root)
  where
    go :: String -> String -> String
go String
x String
"" = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
Path.isPathSeparator String
x
    go String
x String
y =
      let (String
x1, String
x2) = String -> (String, String)
breakPath String
x
          (String
y1, String
y2) = String -> (String, String)
breakPath String
y
      in case () of
        ()
_ | String -> String -> Bool
Path.equalFilePath String
x1 String
y1 -> String -> String -> String
go String
x2 String
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      -> [String] -> String
Path.joinPath [String
"..", String
x1, String -> String -> String
go String
x2 String
y2]
        ()
_                            -> String
path

    breakPath :: String -> (String, String)
breakPath = (String -> String) -> (String, String) -> (String, String)
forall t b. (t -> b) -> (t, t) -> (b, b)
both ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
Path.isPathSeparator)
              ((String, String) -> (String, String))
-> (String -> (String, String)) -> String -> (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
Path.isPathSeparator
              (String -> (String, String))
-> (String -> String) -> String -> (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
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 :: String -> Bool
leadingPathSepOnWindows = \case
      String
""                  -> Bool
False
      String
x | String -> Bool
Path.hasDrive String
x -> Bool
False
      Char
c:String
_                 -> Char -> Bool
Path.isPathSeparator Char
c

    dropAbs :: String -> String
dropAbs String
x = if String -> Bool
leadingPathSepOnWindows String
x then String -> String
forall a. [a] -> [a]
tail String
x else String -> String
Path.dropDrive String
x

    takeAbs :: String -> String
takeAbs String
x = if String -> Bool
leadingPathSepOnWindows String
x
                then [Char
Path.pathSeparator]
                else (Char -> Char) -> String -> String
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)
                         (String -> String
Path.takeDrive String
x)

-- | First published version of this library.
initialVersion :: Version
initialVersion :: Version
initialVersion = [Int] -> Version
makeVersion [Int
0,Int
1,Int
0]