Script 'mail_helper' called by obssrc
Hello community,
here is the log from the commit of package ghc-hslua-module-path for
openSUSE:Factory checked in at 2021-11-11 21:36:32
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ghc-hslua-module-path (Old)
and /work/SRC/openSUSE:Factory/.ghc-hslua-module-path.new.1890 (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-hslua-module-path"
Thu Nov 11 21:36:32 2021 rev:2 rq:930332 version:1.0.0
Changes:
--------
---
/work/SRC/openSUSE:Factory/ghc-hslua-module-path/ghc-hslua-module-path.changes
2021-03-17 20:19:30.167280439 +0100
+++
/work/SRC/openSUSE:Factory/.ghc-hslua-module-path.new.1890/ghc-hslua-module-path.changes
2021-11-11 21:36:46.928904411 +0100
@@ -1,0 +2,7 @@
+Mon Nov 1 08:26:33 UTC 2021 - [email protected]
+
+- Update hslua-module-path to version 1.0.0.
+ Upstream has not updated the file "CHANGELOG.md" since the last
+ release.
+
+-------------------------------------------------------------------
Old:
----
hslua-module-path-0.1.0.1.tar.gz
New:
----
hslua-module-path-1.0.0.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-hslua-module-path.spec ++++++
--- /var/tmp/diff_new_pack.Y9djhy/_old 2021-11-11 21:36:47.436904782 +0100
+++ /var/tmp/diff_new_pack.Y9djhy/_new 2021-11-11 21:36:47.436904782 +0100
@@ -19,7 +19,7 @@
%global pkg_name hslua-module-path
%bcond_with tests
Name: ghc-%{pkg_name}
-Version: 0.1.0.1
+Version: 1.0.0
Release: 0
Summary: Lua module to work with file paths
License: MIT
@@ -28,6 +28,8 @@
BuildRequires: ghc-Cabal-devel
BuildRequires: ghc-filepath-devel
BuildRequires: ghc-hslua-devel
+BuildRequires: ghc-hslua-marshalling-devel
+BuildRequires: ghc-hslua-packaging-devel
BuildRequires: ghc-rpm-macros
BuildRequires: ghc-text-devel
ExcludeArch: %{ix86}
++++++ hslua-module-path-0.1.0.1.tar.gz -> hslua-module-path-1.0.0.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hslua-module-path-0.1.0.1/LICENSE
new/hslua-module-path-1.0.0/LICENSE
--- old/hslua-module-path-0.1.0.1/LICENSE 2001-09-09 03:46:40.000000000
+0200
+++ new/hslua-module-path-1.0.0/LICENSE 2001-09-09 03:46:40.000000000 +0200
@@ -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
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hslua-module-path-0.1.0.1/hslua-module-path.cabal
new/hslua-module-path-1.0.0/hslua-module-path.cabal
--- old/hslua-module-path-0.1.0.1/hslua-module-path.cabal 2001-09-09
03:46:40.000000000 +0200
+++ new/hslua-module-path-1.0.0/hslua-module-path.cabal 2001-09-09
03:46:40.000000000 +0200
@@ -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
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/hslua-module-path-0.1.0.1/src/Foreign/Lua/Module/Path.hs
new/hslua-module-path-1.0.0/src/Foreign/Lua/Module/Path.hs
--- old/hslua-module-path-0.1.0.1/src/Foreign/Lua/Module/Path.hs
2001-09-09 03:46:40.000000000 +0200
+++ new/hslua-module-path-1.0.0/src/Foreign/Lua/Module/Path.hs 1970-01-01
01:00:00.000000000 +0100
@@ -1,432 +0,0 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-|
-Module : Foreign.Lua.Module.Path
-Copyright : ?? 2020 Albert Krewinkel
-License : MIT
-Maintainer : Albert Krewinkel <[email protected]>
-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)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hslua-module-path-0.1.0.1/src/HsLua/Module/Path.hs
new/hslua-module-path-1.0.0/src/HsLua/Module/Path.hs
--- old/hslua-module-path-0.1.0.1/src/HsLua/Module/Path.hs 1970-01-01
01:00:00.000000000 +0100
+++ new/hslua-module-path-1.0.0/src/HsLua/Module/Path.hs 2001-09-09
03:46:40.000000000 +0200
@@ -0,0 +1,433 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-|
+Module : HsLua.Module.Path
+Copyright : ?? 2021 Albert Krewinkel
+License : MIT
+Maintainer : Albert Krewinkel <[email protected]>
+
+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]
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/hslua-module-path-0.1.0.1/test/test-hslua-module-path.hs
new/hslua-module-path-1.0.0/test/test-hslua-module-path.hs
--- old/hslua-module-path-0.1.0.1/test/test-hslua-module-path.hs
2001-09-09 03:46:40.000000000 +0200
+++ new/hslua-module-path-1.0.0/test/test-hslua-module-path.hs 2001-09-09
03:46:40.000000000 +0200
@@ -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'"
]
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hslua-module-path-0.1.0.1/test/test-path.lua
new/hslua-module-path-1.0.0/test/test-path.lua
--- old/hslua-module-path-0.1.0.1/test/test-path.lua 2001-09-09
03:46:40.000000000 +0200
+++ new/hslua-module-path-1.0.0/test/test-path.lua 2001-09-09
03:46:40.000000000 +0200
@@ -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()
