{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-|
Module      : Foreign.Lua.Module.Path
Copyright   : © 2020 Albert Krewinkel
License     : MIT
Maintainer  : Albert Krewinkel <albert+hslua@zeitkraut.de>
Stability   : alpha
Portability : Requires GHC 8 or later.

Lua module to work with file paths.
-}
module Foreign.Lua.Module.Path (
  -- * Module
    pushModule
  , preloadModule
  , documentedModule

  -- * Path manipulations
  , 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 Control.Monad (forM_)
import Data.Char (toLower)
#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup (Semigroup(..))  -- includes (<>)
#endif
import Data.Text (Text)
import Foreign.Lua
  ( Lua, NumResults (..), getglobal, getmetatable, nth, pop, rawset
  , remove, top )
import Foreign.Lua.Call
import Foreign.Lua.Module hiding (preloadModule, pushModule)
import Foreign.Lua.Peek (Peeker, peekBool, peekList, peekString)
import Foreign.Lua.Push (pushBool, pushList, pushString, pushText)

import qualified Data.Text as T
import qualified Foreign.Lua.Module as Module
import qualified System.FilePath as Path

--
-- Module
--

description :: Text
description :: Text
description = Text
"Module for file path manipulations."

documentedModule :: Module
documentedModule :: Module
documentedModule = Module :: Text -> Text -> [Field] -> [(Text, HaskellFunction)] -> Module
Module
  { moduleName :: Text
moduleName = Text
"path"
  , moduleFields :: [Field]
moduleFields = [Field]
fields
  , moduleDescription :: Text
moduleDescription = Text
description
  , moduleFunctions :: [(Text, HaskellFunction)]
moduleFunctions = [(Text, HaskellFunction)]
functions
  }

-- | Pushes the @path@ module to the Lua stack.
pushModule :: Lua NumResults
pushModule :: Lua NumResults
pushModule = NumResults
1 NumResults -> Lua () -> Lua NumResults
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Module -> Lua ()
pushModule' Module
documentedModule

-- | Add the @path@ module under the given name to the table of
-- preloaded packages.
preloadModule :: String -> Lua ()
preloadModule :: String -> Lua ()
preloadModule String
name = Module -> Lua ()
Module.preloadModule (Module -> Lua ()) -> Module -> Lua ()
forall a b. (a -> b) -> a -> b
$
  Module
documentedModule { moduleName :: Text
moduleName = String -> Text
T.pack String
name }

-- | Helper function which pushes the module with its fields. This
-- function should be removed once the respective hslua bug has been
-- fixed.
pushModule' :: Module -> Lua ()
pushModule' :: Module -> Lua ()
pushModule' Module
mdl = do
  Module -> Lua ()
Module.pushModule Module
mdl
  [Field] -> (Field -> Lua ()) -> Lua ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Module -> [Field]
moduleFields Module
mdl) ((Field -> Lua ()) -> Lua ()) -> (Field -> Lua ()) -> Lua ()
forall a b. (a -> b) -> a -> b
$ \Field
field -> do
    Pusher Text
pushText (Field -> Text
fieldName Field
field)
    Field -> Lua ()
fieldPushValue Field
field
    StackIndex -> Lua ()
rawset (CInt -> StackIndex
nth CInt
3)

--
-- Fields
--

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

-- | Wrapper for @'Path.pathSeparator'@.
separator :: Field
separator :: Field
separator = Field :: Text -> Text -> Lua () -> Field
Field
  { fieldName :: Text
fieldName = Text
"separator"
  , fieldDescription :: Text
fieldDescription = Text
"The character that separates directories."
  , fieldPushValue :: Lua ()
fieldPushValue = String -> Lua ()
pushString [Char
Path.pathSeparator]
  }

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

--
-- Functions
--

functions :: [(Text, HaskellFunction)]
functions :: [(Text, HaskellFunction)]
functions =
  [ (Text
"directory", HaskellFunction
directory)
  , (Text
"filename", HaskellFunction
filename)
  , (Text
"is_absolute", HaskellFunction
is_absolute)
  , (Text
"is_relative", HaskellFunction
is_relative)
  , (Text
"join", HaskellFunction
join)
  , (Text
"make_relative", HaskellFunction
make_relative)
  , (Text
"normalize", HaskellFunction
normalize)
  , (Text
"split", HaskellFunction
split)
  , (Text
"split_extension", HaskellFunction
split_extension)
  , (Text
"split_search_path", HaskellFunction
split_search_path)
  , (Text
"treat_strings_as_paths", HaskellFunction
treat_strings_as_paths)
  ]

-- | See @Path.takeDirectory@
directory :: HaskellFunction
directory :: HaskellFunction
directory = (String -> String) -> HsFnPrecursor (String -> String)
forall a. a -> HsFnPrecursor a
toHsFnPrecursor String -> String
Path.normalise
  HsFnPrecursor (String -> String)
-> Parameter String -> HsFnPrecursor String
forall a b.
HsFnPrecursor (a -> b) -> Parameter a -> HsFnPrecursor b
<#> Parameter String
filepathParam
  HsFnPrecursor String -> FunctionResults String -> HaskellFunction
forall a. HsFnPrecursor a -> FunctionResults a -> HaskellFunction
=#> [Text -> FunctionResult String
filepathResult Text
"The filepath up to the last directory separator."]
  #? "Get the directory name; move up one level."

-- | See @Path.takeFilename@
filename :: HaskellFunction
filename :: HaskellFunction
filename = (String -> String) -> HsFnPrecursor (String -> String)
forall a. a -> HsFnPrecursor a
toHsFnPrecursor String -> String
Path.takeFileName
  HsFnPrecursor (String -> String)
-> Parameter String -> HsFnPrecursor String
forall a b.
HsFnPrecursor (a -> b) -> Parameter a -> HsFnPrecursor b
<#> Parameter String
filepathParam
  HsFnPrecursor String -> FunctionResults String -> HaskellFunction
forall a. HsFnPrecursor a -> FunctionResults a -> HaskellFunction
=#> [Text -> FunctionResult String
filepathResult Text
"File name part of the input path."]
  #? "Get the file name."

-- | See @Path.isAbsolute@
is_absolute :: HaskellFunction
is_absolute :: HaskellFunction
is_absolute = (String -> Bool) -> HsFnPrecursor (String -> Bool)
forall a. a -> HsFnPrecursor a
toHsFnPrecursor String -> Bool
Path.isAbsolute
  HsFnPrecursor (String -> Bool)
-> Parameter String -> HsFnPrecursor Bool
forall a b.
HsFnPrecursor (a -> b) -> Parameter a -> HsFnPrecursor b
<#> Parameter String
filepathParam
  HsFnPrecursor Bool -> FunctionResults Bool -> HaskellFunction
forall a. HsFnPrecursor a -> FunctionResults a -> HaskellFunction
=#> [Text -> FunctionResult 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."

-- | See @Path.isRelative@
is_relative :: HaskellFunction
is_relative :: HaskellFunction
is_relative = (String -> Bool) -> HsFnPrecursor (String -> Bool)
forall a. a -> HsFnPrecursor a
toHsFnPrecursor String -> Bool
Path.isRelative
  HsFnPrecursor (String -> Bool)
-> Parameter String -> HsFnPrecursor Bool
forall a b.
HsFnPrecursor (a -> b) -> Parameter a -> HsFnPrecursor b
<#> Parameter String
filepathParam
  HsFnPrecursor Bool -> FunctionResults Bool -> HaskellFunction
forall a. HsFnPrecursor a -> FunctionResults a -> HaskellFunction
=#> [Text -> FunctionResult 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."

-- | See @Path.joinPath@
join :: HaskellFunction
join :: HaskellFunction
join = ([String] -> String) -> HsFnPrecursor ([String] -> String)
forall a. a -> HsFnPrecursor a
toHsFnPrecursor [String] -> String
Path.joinPath
  HsFnPrecursor ([String] -> String)
-> Parameter [String] -> HsFnPrecursor String
forall a b.
HsFnPrecursor (a -> b) -> Parameter a -> HsFnPrecursor b
<#> Parameter :: forall a. Peeker a -> ParameterDoc -> Parameter a
Parameter
      { parameterPeeker :: Peeker [String]
parameterPeeker = Peeker String -> Peeker [String]
forall a. Peeker a -> Peeker [a]
peekList Peeker 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 String -> FunctionResults String -> HaskellFunction
forall a. HsFnPrecursor a -> FunctionResults a -> HaskellFunction
=#> [Text -> FunctionResult String
filepathResult Text
"The joined path."]
  #? "Join path elements back together by the directory separator."

make_relative :: HaskellFunction
make_relative :: HaskellFunction
make_relative = (String -> String -> Maybe Bool -> String)
-> HsFnPrecursor (String -> String -> Maybe Bool -> String)
forall a. a -> HsFnPrecursor a
toHsFnPrecursor String -> String -> Maybe Bool -> String
makeRelative
  HsFnPrecursor (String -> String -> Maybe Bool -> String)
-> Parameter String
-> HsFnPrecursor (String -> Maybe Bool -> String)
forall a b.
HsFnPrecursor (a -> b) -> Parameter a -> HsFnPrecursor b
<#> Peeker String -> Text -> Text -> Text -> Parameter String
forall a. Peeker a -> Text -> Text -> Text -> Parameter a
parameter
        Peeker String
peekFilePath
        Text
"string"
        Text
"path"
        Text
"path to be made relative"
  HsFnPrecursor (String -> Maybe Bool -> String)
-> Parameter String -> HsFnPrecursor (Maybe Bool -> String)
forall a b.
HsFnPrecursor (a -> b) -> Parameter a -> HsFnPrecursor b
<#> Peeker String -> Text -> Text -> Text -> Parameter String
forall a. Peeker a -> Text -> Text -> Text -> Parameter a
parameter
        Peeker String
peekFilePath
        Text
"string"
        Text
"root"
        Text
"root path"
  HsFnPrecursor (Maybe Bool -> String)
-> Parameter (Maybe Bool) -> HsFnPrecursor String
forall a b.
HsFnPrecursor (a -> b) -> Parameter a -> HsFnPrecursor b
<#> Peeker Bool -> Text -> Text -> Text -> Parameter (Maybe Bool)
forall a. Peeker a -> Text -> Text -> Text -> Parameter (Maybe a)
optionalParameter
        Peeker Bool
peekBool
        Text
"boolean"
        Text
"unsafe"
        Text
"whether to allow `..` in the result."
  HsFnPrecursor String -> FunctionResults String -> HaskellFunction
forall a. HsFnPrecursor a -> FunctionResults a -> HaskellFunction
=#> [Text -> FunctionResult 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)."
     ]

-- | See @Path.normalise@
normalize :: HaskellFunction
normalize :: HaskellFunction
normalize = (String -> String) -> HsFnPrecursor (String -> String)
forall a. a -> HsFnPrecursor a
toHsFnPrecursor String -> String
Path.normalise
  HsFnPrecursor (String -> String)
-> Parameter String -> HsFnPrecursor String
forall a b.
HsFnPrecursor (a -> b) -> Parameter a -> HsFnPrecursor b
<#> Parameter String
filepathParam
  HsFnPrecursor String -> FunctionResults String -> HaskellFunction
forall a. HsFnPrecursor a -> FunctionResults a -> HaskellFunction
=#> [Text -> FunctionResult String
filepathResult Text
"The normalized path."]
  #? T.unlines
     [ "Normalizes a path."
     , ""
     , "- `//` outside of the drive can be made blank"
     , "- `/` becomes the `path.separator`"
     , "- `./` -> \'\'"
     , "- an empty path becomes `.`"
     ]

-- | 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 :: HaskellFunction
split :: HaskellFunction
split = (String -> [String]) -> HsFnPrecursor (String -> [String])
forall a. a -> HsFnPrecursor a
toHsFnPrecursor String -> [String]
Path.splitDirectories
  HsFnPrecursor (String -> [String])
-> Parameter String -> HsFnPrecursor [String]
forall a b.
HsFnPrecursor (a -> b) -> Parameter a -> HsFnPrecursor b
<#> Parameter String
filepathParam
  HsFnPrecursor [String]
-> FunctionResults [String] -> HaskellFunction
forall a. HsFnPrecursor a -> FunctionResults a -> HaskellFunction
=#> [Text -> FunctionResult [String]
filepathListResult Text
"List of all path components."]
  #? "Splits a path by the directory separator."

-- | See @Path.splitExtension@
split_extension :: HaskellFunction
split_extension :: HaskellFunction
split_extension = (String -> (String, String))
-> HsFnPrecursor (String -> (String, String))
forall a. a -> HsFnPrecursor a
toHsFnPrecursor String -> (String, String)
Path.splitExtension
  HsFnPrecursor (String -> (String, String))
-> Parameter String -> HsFnPrecursor (String, String)
forall a b.
HsFnPrecursor (a -> b) -> Parameter a -> HsFnPrecursor b
<#> Parameter String
filepathParam
  HsFnPrecursor (String, String)
-> FunctionResults (String, String) -> HaskellFunction
forall a. HsFnPrecursor a -> FunctionResults a -> HaskellFunction
=#> [ FunctionResult :: forall a. Pusher a -> FunctionResultDoc -> FunctionResult a
FunctionResult
        { fnResultPusher :: Pusher (String, String)
fnResultPusher = String -> Lua ()
pushString (String -> Lua ())
-> ((String, String) -> String) -> Pusher (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> String
forall a b. (a, b) -> a
fst
        , fnResultDoc :: FunctionResultDoc
fnResultDoc = FunctionResultDoc :: Text -> Text -> FunctionResultDoc
FunctionResultDoc
          { functionResultType :: Text
functionResultType = Text
"string"
          , functionResultDescription :: Text
functionResultDescription = Text
"filepath without extension"
          }
        },
        FunctionResult :: forall a. Pusher a -> FunctionResultDoc -> FunctionResult a
FunctionResult
        { fnResultPusher :: Pusher (String, String)
fnResultPusher = String -> Lua ()
pushString (String -> Lua ())
-> ((String, String) -> String) -> Pusher (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> String
forall a b. (a, b) -> b
snd
        , fnResultDoc :: FunctionResultDoc
fnResultDoc = FunctionResultDoc :: Text -> Text -> FunctionResultDoc
FunctionResultDoc
          { functionResultType :: Text
functionResultType = Text
"string"
          , functionResultDescription :: Text
functionResultDescription = 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.")

-- | Wraps function @'Path.splitSearchPath'@.
split_search_path :: HaskellFunction
split_search_path :: HaskellFunction
split_search_path = (String -> [String]) -> HsFnPrecursor (String -> [String])
forall a. a -> HsFnPrecursor a
toHsFnPrecursor String -> [String]
Path.splitSearchPath
  HsFnPrecursor (String -> [String])
-> Parameter String -> HsFnPrecursor [String]
forall a b.
HsFnPrecursor (a -> b) -> Parameter a -> HsFnPrecursor b
<#> Parameter :: forall a. Peeker a -> ParameterDoc -> Parameter a
Parameter
      { parameterPeeker :: Peeker String
parameterPeeker = Peeker 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 [String]
-> FunctionResults [String] -> HaskellFunction
forall a. HsFnPrecursor a -> FunctionResults a -> HaskellFunction
=#> [Text -> FunctionResult [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.")

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

-- | Adds an extension to a file path. Wraps @'Path.addExtension'@.
add_extension :: HaskellFunction
add_extension :: HaskellFunction
add_extension = (String -> String -> String)
-> HsFnPrecursor (String -> String -> String)
forall a. a -> HsFnPrecursor a
toHsFnPrecursor String -> String -> String
Path.addExtension
  HsFnPrecursor (String -> String -> String)
-> Parameter String -> HsFnPrecursor (String -> String)
forall a b.
HsFnPrecursor (a -> b) -> Parameter a -> HsFnPrecursor b
<#> Parameter String
filepathParam
  HsFnPrecursor (String -> String)
-> Parameter String -> HsFnPrecursor String
forall a b.
HsFnPrecursor (a -> b) -> Parameter a -> HsFnPrecursor b
<#> Parameter :: forall a. Peeker a -> ParameterDoc -> Parameter a
Parameter
      { parameterPeeker :: Peeker String
parameterPeeker = Peeker 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 String -> FunctionResults String -> HaskellFunction
forall a. HsFnPrecursor a -> FunctionResults a -> HaskellFunction
=#> [Text -> FunctionResult String
filepathResult Text
"filepath with extension"]
  #? "Adds an extension, even if there is already one."

stringAugmentationFunctions :: [(String, HaskellFunction)]
stringAugmentationFunctions :: [(String, HaskellFunction)]
stringAugmentationFunctions =
  [ (String
"directory", HaskellFunction
directory)
  , (String
"filename", HaskellFunction
filename)
  , (String
"is_absolute", HaskellFunction
is_absolute)
  , (String
"is_relative", HaskellFunction
is_relative)
  , (String
"normalize", HaskellFunction
normalize)
  , (String
"split", HaskellFunction
split)
  , (String
"split_extension", HaskellFunction
split_extension)
  , (String
"split_search_path", HaskellFunction
split_search_path)
  ]

treat_strings_as_paths :: HaskellFunction
treat_strings_as_paths :: HaskellFunction
treat_strings_as_paths = HaskellFunction :: Lua NumResults -> Maybe FunctionDoc -> HaskellFunction
HaskellFunction
  { callFunction :: Lua NumResults
callFunction = do
      let addField :: (String, HaskellFunction) -> Lua ()
addField (String
k, HaskellFunction
v) =
            String -> Lua ()
pushString String
k Lua () -> Lua () -> Lua ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> HaskellFunction -> Lua ()
pushHaskellFunction HaskellFunction
v Lua () -> Lua () -> Lua ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> StackIndex -> Lua ()
rawset (CInt -> StackIndex
nth CInt
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.
      String -> Lua ()
pushString String
"" Lua () -> Lua Bool -> Lua Bool
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> StackIndex -> Lua Bool
getmetatable StackIndex
top Lua Bool -> Lua () -> Lua ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> StackIndex -> Lua ()
remove (CInt -> StackIndex
nth CInt
2)
      ((String, HaskellFunction) -> Lua ())
-> [(String, HaskellFunction)] -> Lua ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String, HaskellFunction) -> Lua ()
addField ([(String, HaskellFunction)] -> Lua ())
-> [(String, HaskellFunction)] -> Lua ()
forall a b. (a -> b) -> a -> b
$ [(String
"__add", HaskellFunction
add_extension), (String
"__div", HaskellFunction
combine)]
      StackIndex -> Lua ()
pop StackIndex
1  -- string metatable

      String -> Lua ()
getglobal String
"string"
      ((String, HaskellFunction) -> Lua ())
-> [(String, HaskellFunction)] -> Lua ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String, HaskellFunction) -> Lua ()
addField [(String, HaskellFunction)]
stringAugmentationFunctions
      StackIndex -> Lua ()
pop StackIndex
1 -- string module

      NumResults -> Lua NumResults
forall (m :: * -> *) a. Monad m => a -> m a
return (NumResults
0 :: NumResults)
  , functionDoc :: Maybe FunctionDoc
functionDoc = Maybe FunctionDoc
forall a. Maybe a
Nothing
  }
  #? "Augment the string module such that strings can be used as path objects."

--
-- Parameters
--

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

-- | Filepath function parameter.
filepathParam :: Parameter FilePath
filepathParam :: Parameter String
filepathParam = Parameter :: forall a. Peeker a -> ParameterDoc -> Parameter a
Parameter
  { parameterPeeker :: Peeker String
parameterPeeker = Peeker 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 FilePath
filepathResult :: Text -> FunctionResult String
filepathResult Text
desc = FunctionResult :: forall a. Pusher a -> FunctionResultDoc -> FunctionResult a
FunctionResult
  { fnResultPusher :: String -> Lua ()
fnResultPusher = \String
fp -> String -> Lua ()
pushString String
fp
  , fnResultDoc :: FunctionResultDoc
fnResultDoc = FunctionResultDoc :: Text -> Text -> FunctionResultDoc
FunctionResultDoc
    { functionResultType :: Text
functionResultType = Text
"string"
    , functionResultDescription :: Text
functionResultDescription = Text
desc
    }
  }

-- | List of filepaths function result.
filepathListResult :: Text -- ^ Description
                   -> FunctionResult [FilePath]
filepathListResult :: Text -> FunctionResult [String]
filepathListResult Text
desc = FunctionResult :: forall a. Pusher a -> FunctionResultDoc -> FunctionResult a
FunctionResult
  { fnResultPusher :: Pusher [String]
fnResultPusher = \[String]
fp -> (String -> Lua ()) -> Pusher [String]
forall a. Pusher a -> [a] -> Lua ()
pushList String -> Lua ()
pushString [String]
fp
  , fnResultDoc :: FunctionResultDoc
fnResultDoc = FunctionResultDoc :: Text -> Text -> FunctionResultDoc
FunctionResultDoc
    { functionResultType :: Text
functionResultType = Text
"list of strings"
    , functionResultDescription :: Text
functionResultDescription = Text
desc
    }
  }

-- | Boolean function result.
booleanResult :: Text -- ^ Description
              -> FunctionResult Bool
booleanResult :: Text -> FunctionResult Bool
booleanResult Text
desc = FunctionResult :: forall a. Pusher a -> FunctionResultDoc -> FunctionResult a
FunctionResult
  { fnResultPusher :: Pusher Bool
fnResultPusher = \Bool
b -> Pusher Bool
pushBool Bool
b
  , fnResultDoc :: FunctionResultDoc
fnResultDoc = FunctionResultDoc :: Text -> Text -> FunctionResultDoc
FunctionResultDoc
    { functionResultType :: Text
functionResultType = Text
"boolean"
    , functionResultDescription :: Text
functionResultDescription = 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)