hslua-module-path 0.1.0.1 → 1.0.0

raw patch · 6 files changed

+459/−451 lines, 6 filesdep +hslua-marshallingdep +hslua-packagingdep ~hsluadep ~tasty-luaPVP ok

version bump matches the API change (PVP)

Dependencies added: hslua-marshalling, hslua-packaging

Dependency ranges changed: hslua, tasty-lua

API changes (from Hackage documentation)

Files

• LICENSE +1/−1
• hslua-module-path.cabal +12/−9
• src/Foreign/Lua/Module/Path.hs +0/−432
• src/HsLua/Module/Path.hs +433/−0
• test/test-hslua-module-path.hs +12/−8
• test/test-path.lua +1/−1

@@ -1,6 +1,6 @@ MIT License -Copyright (c) 2020 Albert Krewinkel+Copyright © 2020-2021 Albert Krewinkel  Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal

@@ -1,6 +1,6 @@ cabal-version:       2.2 name:                hslua-module-path-version:             0.1.0.1+version:             1.0.0 synopsis:            Lua module to work with file paths. description:         Lua module to work with file paths in a platform                      independent way.@@ -21,18 +21,21 @@                    , GHC == 8.4.4                    , GHC == 8.6.5                    , GHC == 8.8.4-                   , GHC == 8.10.2+                   , GHC == 8.10.4+                   , GHC == 9.0.1  source-repository head   type:                git   location:            https://github.com/hslua/hslua-module-path.git  common common-options-  build-depends:       base       >= 4.9.1  && < 5-                     , filepath   >= 1.4    && < 1.5-                     , hslua      >= 1.2    && < 1.4-                     , text       >= 1.0    && < 1.3-  +  build-depends:       base              >= 4.9.1  && < 5+                     , filepath          >= 1.4    && < 1.5+                     , hslua             >= 2.0    && < 2.1+                     , hslua-marshalling >= 2.0    && < 2.1+                     , hslua-packaging   >= 2.0    && < 2.1+                     , text              >= 1.0    && < 1.3+   ghc-options:         -Wall                        -Wcompat                        -Widentities@@ -53,7 +56,7 @@ library   import:              common-options   hs-source-dirs:      src-  exposed-modules:     Foreign.Lua.Module.Path+  exposed-modules:     HsLua.Module.Path  test-suite hslua-module-path-test   import:              common-options@@ -64,7 +67,7 @@                      , hslua-module-path                      , tasty                      , tasty-hunit-                     , tasty-lua  >= 0.2    && < 0.3+                     , tasty-lua  >= 1.0    && < 1.1                      , text   ghc-options:         -threaded                        -rtsopts

@@ -1,432 +0,0 @@-{-# 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 = "Module for file path manipulations."--documentedModule :: Module-documentedModule = Module-  { moduleName = "path"-  , moduleFields = fields-  , moduleDescription = description-  , moduleFunctions = functions-  }---- | Pushes the @path@ module to the Lua stack.-pushModule :: Lua NumResults-pushModule = 1 <$ pushModule' documentedModule---- | Add the @path@ module under the given name to the table of--- preloaded packages.-preloadModule :: String -> Lua ()-preloadModule name = Module.preloadModule $-  documentedModule { moduleName = T.pack 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' mdl = do-  Module.pushModule mdl-  forM_ (moduleFields mdl) $ \field -> do-    pushText (fieldName field)-    fieldPushValue field-    rawset (nth 3)------- Fields------- | Exported fields.-fields :: [Field]-fields =-  [ separator-  , search_path_separator-  ]---- | Wrapper for @'Path.pathSeparator'@.-separator :: Field-separator = Field-  { fieldName = "separator"-  , fieldDescription = "The character that separates directories."-  , fieldPushValue = pushString [Path.pathSeparator]-  }---- | Wrapper for @'Path.searchPathSeparator'@.-search_path_separator :: Field-search_path_separator = Field-  { fieldName = "search_path_separator"-  , fieldDescription = "The character that is used to separate the entries in "-                    <> "the `PATH` environment variable."-  , fieldPushValue = pushString [Path.searchPathSeparator]-  }------- Functions-----functions :: [(Text, HaskellFunction)]-functions =-  [ ("directory", directory)-  , ("filename", filename)-  , ("is_absolute", is_absolute)-  , ("is_relative", is_relative)-  , ("join", join)-  , ("make_relative", make_relative)-  , ("normalize", normalize)-  , ("split", split)-  , ("split_extension", split_extension)-  , ("split_search_path", split_search_path)-  , ("treat_strings_as_paths", treat_strings_as_paths)-  ]---- | See @Path.takeDirectory@-directory :: HaskellFunction-directory = toHsFnPrecursor Path.takeDirectory-  <#> filepathParam-  =#> [filepathResult "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.")---- | See @Path.takeFilename@-filename :: HaskellFunction-filename = toHsFnPrecursor Path.takeFileName-  <#> filepathParam-  =#> [filepathResult "File name part of the input path."]-  #? "Get the file name."---- | See @Path.isAbsolute@-is_absolute :: HaskellFunction-is_absolute = toHsFnPrecursor Path.isAbsolute-  <#> filepathParam-  =#> [booleanResult ("`true` iff `filepath` is an absolute path, " <>-                      "`false` otherwise.")]-  #? "Checks whether a path is absolute, i.e. not fixed to a root."---- | See @Path.isRelative@-is_relative :: HaskellFunction-is_relative = toHsFnPrecursor Path.isRelative-  <#> filepathParam-  =#> [booleanResult ("`true` iff `filepath` is a relative path, " <>-                      "`false` otherwise.")]-  #? "Checks whether a path is relative or fixed to a root."---- | See @Path.joinPath@-join :: HaskellFunction-join = toHsFnPrecursor Path.joinPath-  <#> Parameter-      { parameterPeeker = peekList peekFilePath-      , parameterDoc = ParameterDoc-        { parameterName = "filepaths"-        , parameterType = "list of strings"-        , parameterDescription = "path components"-        , parameterIsOptional = False-        }-      }-  =#> [filepathResult "The joined path."]-  #? "Join path elements back together by the directory separator."--make_relative :: HaskellFunction-make_relative = toHsFnPrecursor makeRelative-  <#> parameter-        peekFilePath-        "string"-        "path"-        "path to be made relative"-  <#> parameter-        peekFilePath-        "string"-        "root"-        "root path"-  <#> optionalParameter-        peekBool-        "boolean"-        "unsafe"-        "whether to allow `..` in the result."-  =#> [filepathResult "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 = toHsFnPrecursor Path.normalise-  <#> filepathParam-  =#> [filepathResult "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 `.`"-     ]---- | 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 = toHsFnPrecursor Path.splitDirectories-  <#> filepathParam-  =#> [filepathListResult "List of all path components."]-  #? "Splits a path by the directory separator."---- | See @Path.splitExtension@-split_extension :: HaskellFunction-split_extension = toHsFnPrecursor Path.splitExtension-  <#> filepathParam-  =#> [ FunctionResult-        { fnResultPusher = pushString . fst-        , fnResultDoc = FunctionResultDoc-          { functionResultType = "string"-          , functionResultDescription = "filepath without extension"-          }-        },-        FunctionResult-        { fnResultPusher = pushString . snd-        , fnResultDoc = FunctionResultDoc-          { functionResultType = "string"-          , functionResultDescription = "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 = toHsFnPrecursor Path.splitSearchPath-  <#> Parameter-      { parameterPeeker = peekString-      , parameterDoc = ParameterDoc-        { parameterName = "search_path"-        , parameterType = "string"-        , parameterDescription = "platform-specific search path"-        , parameterIsOptional = False-        }-      }-  =#> [filepathListResult "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 = toHsFnPrecursor Path.combine-  <#> filepathParam-  <#> filepathParam-  =#> [filepathResult "combined paths"]-  #? "Combine two paths with a path separator."---- | Adds an extension to a file path. Wraps @'Path.addExtension'@.-add_extension :: HaskellFunction-add_extension = toHsFnPrecursor Path.addExtension-  <#> filepathParam-  <#> Parameter-      { parameterPeeker = peekString-      , parameterDoc = ParameterDoc-        { parameterName = "extension"-        , parameterType = "string"-        , parameterDescription = "an extension, with or without separator dot"-        , parameterIsOptional = False-        }-      }-  =#> [filepathResult "filepath with extension"]-  #? "Adds an extension, even if there is already one."--stringAugmentationFunctions :: [(String, HaskellFunction)]-stringAugmentationFunctions =-  [ ("directory", directory)-  , ("filename", filename)-  , ("is_absolute", is_absolute)-  , ("is_relative", is_relative)-  , ("normalize", normalize)-  , ("split", split)-  , ("split_extension", split_extension)-  , ("split_search_path", split_search_path)-  ]--treat_strings_as_paths :: HaskellFunction-treat_strings_as_paths = HaskellFunction-  { callFunction = do-      let addField (k, v) =-            pushString k *> pushHaskellFunction v *> 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_ addField $ [("__add", add_extension), ("__div", combine)]-      pop 1  -- string metatable--      getglobal "string"-      mapM_ addField stringAugmentationFunctions-      pop 1 -- string module--      return (0 :: NumResults)-  , functionDoc = 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 = peekString---- | Filepath function parameter.-filepathParam :: Parameter FilePath-filepathParam = Parameter-  { parameterPeeker = peekFilePath-  , parameterDoc = ParameterDoc-    { parameterName = "filepath"-    , parameterType = "string"-    , parameterDescription = "path"-    , parameterIsOptional = False-    }-  }---- | Result of a function returning a file path.-filepathResult :: Text -- ^ Description-               -> FunctionResult FilePath-filepathResult desc = FunctionResult-  { fnResultPusher = \fp -> pushString fp-  , fnResultDoc = FunctionResultDoc-    { functionResultType = "string"-    , functionResultDescription = desc-    }-  }---- | List of filepaths function result.-filepathListResult :: Text -- ^ Description-                   -> FunctionResult [FilePath]-filepathListResult desc = FunctionResult-  { fnResultPusher = \fp -> pushList pushString fp-  , fnResultDoc = FunctionResultDoc-    { functionResultType = "list of strings"-    , functionResultDescription = desc-    }-  }---- | Boolean function result.-booleanResult :: Text -- ^ Description-              -> FunctionResult Bool-booleanResult desc = FunctionResult-  { fnResultPusher = \b -> pushBool b-  , fnResultDoc = FunctionResultDoc-    { functionResultType = "boolean"-    , functionResultDescription = 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 path root unsafe- | Path.equalFilePath root path = "."- | takeAbs root /= takeAbs path = path- | otherwise = go (dropAbs path) (dropAbs root)-  where-    go x "" = dropWhile Path.isPathSeparator x-    go x y =-      let (x1, x2) = breakPath x-          (y1, y2) = breakPath y-      in case () of-        _ | Path.equalFilePath x1 y1 -> go x2 y2-        _ | unsafe == Just True      -> Path.joinPath ["..", x1, go x2 y2]-        _                            -> path--    breakPath = both (dropWhile Path.isPathSeparator)-              . break Path.isPathSeparator-              . dropWhile Path.isPathSeparator--    both f (a, b) = (f a, f b)--    leadingPathSepOnWindows = \case-      ""                  -> False-      x | Path.hasDrive x -> False-      c:_                 -> Path.isPathSeparator c--    dropAbs x = if leadingPathSepOnWindows x then tail x else Path.dropDrive x--    takeAbs x = if leadingPathSepOnWindows x-                then [Path.pathSeparator]-                else map (\y ->-                            if Path.isPathSeparator y-                            then Path.pathSeparator-                            else toLower y)-                         (Path.takeDrive x)

@@ -0,0 +1,433 @@+{-# 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+  { moduleName = "path"+  , moduleDescription = "Module for file path manipulations."+  , moduleFields = fields+  , moduleFunctions = functions+  , moduleOperations = []+  }++--+-- Fields+--++-- | Exported fields.+fields :: [Field e]+fields =+  [ separator+  , search_path_separator+  ]++-- | Wrapper for @'Path.pathSeparator'@.+separator :: Field e+separator = Field+  { fieldName = "separator"+  , fieldDescription = "The character that separates directories."+  , fieldPushValue = pushString [Path.pathSeparator]+  }++-- | Wrapper for @'Path.searchPathSeparator'@.+search_path_separator :: Field e+search_path_separator = Field+  { fieldName = "search_path_separator"+  , fieldDescription = "The character that is used to separate the entries in "+                    <> "the `PATH` environment variable."+  , fieldPushValue = pushString [Path.searchPathSeparator]+  }++--+-- Functions+--++functions :: LuaError e => [DocumentedFunction e]+functions =+  [ directory+  , filename+  , is_absolute+  , is_relative+  , join+  , make_relative+  , normalize+  , split+  , split_extension+  , split_search_path+  , treat_strings_as_paths+  ]++-- | See @Path.takeDirectory@+directory :: DocumentedFunction e+directory = defun "directory"+  ### liftPure Path.takeDirectory+  <#> filepathParam+  =#> [filepathResult "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.")+  `since` initialVersion++-- | See @Path.takeFilename@+filename :: DocumentedFunction e+filename = defun "filename"+  ### liftPure Path.takeFileName+  <#> filepathParam+  =#> [filepathResult "File name part of the input path."]+  #? "Get the file name."+  `since` initialVersion++-- | See @Path.isAbsolute@+is_absolute :: DocumentedFunction e+is_absolute = defun "is_absolute"+  ### liftPure Path.isAbsolute+  <#> filepathParam+  =#> [booleanResult ("`true` iff `filepath` is an absolute path, " <>+                      "`false` otherwise.")]+  #? "Checks whether a path is absolute, i.e. not fixed to a root."+  `since` initialVersion++-- | See @Path.isRelative@+is_relative :: DocumentedFunction e+is_relative = defun "is_relative"+  ### liftPure Path.isRelative+  <#> filepathParam+  =#> [booleanResult ("`true` iff `filepath` is a relative path, " <>+                      "`false` otherwise.")]+  #? "Checks whether a path is relative or fixed to a root."+  `since` initialVersion++-- | See @Path.joinPath@+join :: LuaError e => DocumentedFunction e+join = defun "join"+  ### liftPure Path.joinPath+  <#> Parameter+      { parameterPeeker = peekList peekFilePath+      , parameterDoc = ParameterDoc+        { parameterName = "filepaths"+        , parameterType = "list of strings"+        , parameterDescription = "path components"+        , parameterIsOptional = False+        }+      }+  =#> [filepathResult "The joined path."]+  #? "Join path elements back together by the directory separator."+  `since` initialVersion++make_relative :: DocumentedFunction e+make_relative = defun "make_relative"+  ### liftPure3 makeRelative+  <#> parameter+        peekFilePath+        "string"+        "path"+        "path to be made relative"+  <#> parameter+        peekFilePath+        "string"+        "root"+        "root path"+  <#> optionalParameter+        peekBool+        "boolean"+        "unsafe"+        "whether to allow `..` in the result."+  =#> [filepathResult "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)."+     ]+  `since` initialVersion++-- | See @Path.normalise@+normalize :: DocumentedFunction e+normalize = defun "normalize"+  ### liftPure Path.normalise+  <#> filepathParam+  =#> [filepathResult "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 `.`"+     ]+  `since` 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 = defun "split"+  ### liftPure Path.splitDirectories+  <#> filepathParam+  =#> [filepathListResult "List of all path components."]+  #? "Splits a path by the directory separator."+  `since` initialVersion++-- | See @Path.splitExtension@+split_extension :: DocumentedFunction e+split_extension = defun "split_extension"+  ### liftPure Path.splitExtension+  <#> filepathParam+  =#> [ FunctionResult+        { fnResultPusher = pushString . fst+        , fnResultDoc = ResultValueDoc+          { resultValueType = "string"+          , resultValueDescription = "filepath without extension"+          }+        },+        FunctionResult+        { fnResultPusher = pushString . snd+        , fnResultDoc = ResultValueDoc+          { resultValueType = "string"+          , resultValueDescription = "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.")+  `since` initialVersion++-- | Wraps function @'Path.splitSearchPath'@.+split_search_path :: LuaError e => DocumentedFunction e+split_search_path = defun "split_search_path"+  ### liftPure Path.splitSearchPath+  <#> Parameter+      { parameterPeeker = peekString+      , parameterDoc = ParameterDoc+        { parameterName = "search_path"+        , parameterType = "string"+        , parameterDescription = "platform-specific search path"+        , parameterIsOptional = False+        }+      }+  =#> [filepathListResult "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.")+  `since` initialVersion++-- | Join two paths with a directory separator. Wraps @'Path.combine'@.+combine :: DocumentedFunction e+combine = defun "combine"+  ### liftPure2 Path.combine+  <#> filepathParam+  <#> filepathParam+  =#> [filepathResult "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 = defun "add_extension"+  ### liftPure2 Path.addExtension+  <#> filepathParam+  <#> Parameter+      { parameterPeeker = peekString+      , parameterDoc = ParameterDoc+        { parameterName = "extension"+        , parameterType = "string"+        , parameterDescription = "an extension, with or without separator dot"+        , parameterIsOptional = False+        }+      }+  =#> [filepathResult "filepath with extension"]+  #? "Adds an extension, even if there is already one."+  `since` initialVersion++stringAugmentationFunctions :: LuaError e => [DocumentedFunction e]+stringAugmentationFunctions =+  [ directory+  , filename+  , is_absolute+  , is_relative+  , normalize+  , split+  , split_extension+  , split_search_path+  ]++treat_strings_as_paths :: LuaError e => DocumentedFunction e+treat_strings_as_paths = defun "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+  =#> []+  #? ("Augment the string module such that strings can be used as "+      <> "path objects.")+  `since` initialVersion++--+-- Parameters+--++-- | Retrieves a file path from the stack.+peekFilePath :: Peeker e FilePath+peekFilePath = peekString++-- | Filepath function parameter.+filepathParam :: Parameter e FilePath+filepathParam = Parameter+  { parameterPeeker = peekFilePath+  , parameterDoc = ParameterDoc+    { parameterName = "filepath"+    , parameterType = "string"+    , parameterDescription = "path"+    , parameterIsOptional = False+    }+  }++-- | Result of a function returning a file path.+filepathResult :: Text -- ^ Description+               -> FunctionResult e FilePath+filepathResult desc = FunctionResult+  { fnResultPusher = pushString+  , fnResultDoc = ResultValueDoc+    { resultValueType = "string"+    , resultValueDescription = desc+    }+  }++-- | List of filepaths function result.+filepathListResult :: LuaError e+                   => Text -- ^ Description+                   -> FunctionResult e [FilePath]+filepathListResult desc = FunctionResult+  { fnResultPusher = pushList pushString+  , fnResultDoc = ResultValueDoc+    { resultValueType = "list of strings"+    , resultValueDescription = desc+    }+  }++-- | Boolean function result.+booleanResult :: Text -- ^ Description+              -> FunctionResult e Bool+booleanResult desc = FunctionResult+  { fnResultPusher = pushBool+  , fnResultDoc = ResultValueDoc+    { resultValueType = "boolean"+    , resultValueDescription = 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 path root unsafe+ | Path.equalFilePath root path = "."+ | takeAbs root /= takeAbs path = path+ | otherwise = go (dropAbs path) (dropAbs root)+  where+    go x "" = dropWhile Path.isPathSeparator x+    go x y =+      let (x1, x2) = breakPath x+          (y1, y2) = breakPath y+      in case () of+        _ | Path.equalFilePath x1 y1 -> go x2 y2+        _ | unsafe == Just True      -> Path.joinPath ["..", x1, go x2 y2]+        _                            -> path++    breakPath = both (dropWhile Path.isPathSeparator)+              . break Path.isPathSeparator+              . dropWhile Path.isPathSeparator++    both f (a, b) = (f a, f b)++    leadingPathSepOnWindows = \case+      ""                  -> False+      x | Path.hasDrive x -> False+      c:_                 -> Path.isPathSeparator c++    dropAbs x = if leadingPathSepOnWindows x then tail x else Path.dropDrive x++    takeAbs x = if leadingPathSepOnWindows x+                then [Path.pathSeparator]+                else map (\y ->+                            if Path.isPathSeparator y+                            then Path.pathSeparator+                            else toLower y)+                         (Path.takeDrive x)++-- | First published version of this library.+initialVersion :: Version+initialVersion = makeVersion [0,1,0]

@@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications  #-} {-| Module      : Main Copyright   : © 2021 Albert Krewinkel@@ -10,21 +11,24 @@  Tests for the `path` Lua module. -}+module Main (main) where  import Control.Monad (void)-import Foreign.Lua (Lua)-import Foreign.Lua.Module.Path (preloadModule, pushModule)+import HsLua (Lua)+import HsLua.Packaging.Module (preloadModule, preloadModuleWithName, pushModule)+import HsLua.Module.Path (documentedModule) import Test.Tasty (TestTree, defaultMain, testGroup) import Test.Tasty.HUnit (assertEqual, testCase) import Test.Tasty.Lua (translateResultsFromFile) -import qualified Foreign.Lua as Lua+import qualified HsLua as Lua  main :: IO () main = do-  luaTestResults <- Lua.run $ do+  luaTestResults <- Lua.run @Lua.Exception $ do     Lua.openlibs-    Lua.requirehs "path" (void pushModule)+    Lua.registerModule documentedModule+    Lua.pop 1     translateResultsFromFile "test/test-path.lua"   defaultMain $ testGroup "hslua-module-path" [tests, luaTestResults] @@ -32,18 +36,18 @@ tests :: TestTree tests = testGroup "HsLua path module"   [ testCase "path module can be pushed to the stack" $-      Lua.run (void pushModule)+      Lua.run (void (pushModule documentedModule) :: Lua ())    , testCase "path module can be added to the preloader" . Lua.run $ do       Lua.openlibs-      preloadModule "path"+      preloadModule documentedModule       assertEqual' "function not added to preloader" Lua.TypeFunction =<< do         Lua.getglobal' "package.preload.path"         Lua.ltype (-1)    , testCase "path module can be loaded as hspath" . Lua.run $ do       Lua.openlibs-      preloadModule "hspath"+      preloadModuleWithName documentedModule "hspath"       assertEqual' "loading the module fails " Lua.OK =<<         Lua.dostring "require 'hspath'"   ]

@@ -160,7 +160,7 @@     test('use `..` when allowing unsafe operation', function()       assert.are_equal(         path.make_relative('/foo/baz/file.txt', '/foo/bar', true),-        '../baz/file.txt'+        path.join{'..', 'baz', 'file.txt'}       )     end),     test('return dot if both paths are the same', function()