diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,18 @@ `hslua-marshalling` uses [PVP Versioning][]. +## hslua-marshalling-2.3.0 + +Released 2023-03-13. + +- `Result` is now an instance of `MonadFail`. + +- New peeker and pusher functions for `NonEmpty`. + +- Peeker combinators for optional values: The new combinators + `peekNilOr`, `peekNoneOr`, and `peekNoneOrNil` can be used to + retrieve optional values. + ## hslua-marshalling-2.2.1 Released 2022-06-19. diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,7 +1,7 @@ Copyright © 1994-2022 Lua.org, PUC-Rio. Copyright © 2007-2012 Gracjan Polak Copyright © 2012-2015 Ömer Sinan Ağacan -Copyright © 2016-2022 Albert Krewinkel +Copyright © 2016-2023 Albert Krewinkel Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the diff --git a/hslua-marshalling.cabal b/hslua-marshalling.cabal --- a/hslua-marshalling.cabal +++ b/hslua-marshalling.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: hslua-marshalling -version: 2.2.1 +version: 2.3.0 synopsis: Marshalling of values between Haskell and Lua. description: Provides functions to marshal values from Haskell to Lua, and /vice versa/. @@ -13,21 +13,20 @@ license: MIT license-file: LICENSE author: Albert Krewinkel, Gracjan Polak, Ömer Sinan Ağacan -maintainer: albert+hslua@zeitkraut.de +maintainer: tarleb@hslua.org copyright: © 2007–2012 Gracjan Polak; © 2012–2016 Ömer Sinan Ağacan; - © 2017-2022 Albert Krewinkel + © 2017-2023 Albert Krewinkel category: Foreign extra-source-files: README.md , CHANGELOG.md -tested-with: GHC == 8.0.2 - , GHC == 8.2.2 - , GHC == 8.4.4 +tested-with: GHC == 8.4.4 , GHC == 8.6.5 , GHC == 8.8.4 , GHC == 8.10.7 , GHC == 9.0.2 - , GHC == 9.2.3 + , GHC == 9.2.5 + , GHC == 9.4.4 source-repository head type: git @@ -36,10 +35,10 @@ common common-options default-language: Haskell2010 - build-depends: base >= 4.8 && < 5 + build-depends: base >= 4.11 && < 5 , bytestring >= 0.10.2 && < 0.12 , containers >= 0.5.9 && < 0.7 - , hslua-core >= 2.2.1 && < 2.3 + , hslua-core >= 2.2.1 && < 2.4 , mtl >= 2.2 && < 2.4 , text >= 1.2 && < 2.1 ghc-options: -Wall diff --git a/src/HsLua/Marshalling.hs b/src/HsLua/Marshalling.hs --- a/src/HsLua/Marshalling.hs +++ b/src/HsLua/Marshalling.hs @@ -2,9 +2,9 @@ Module : HsLua.Marshalling Copyright : © 2007–2012 Gracjan Polak; © 2012–2016 Ömer Sinan Ağacan; - © 2017-2022 Albert Krewinkel + © 2017-2023 Albert Krewinkel License : MIT -Maintainer : Albert Krewinkel +Maintainer : Albert Krewinkel Functions to push and retrieve data to and from Lua. -} @@ -42,6 +42,9 @@ , peekFieldRaw , peekPair , peekTriple + , peekNilOr + , peekNoneOr + , peekNoneOrNilOr -- ** Lua peek monad , Peek (..) , forcePeek diff --git a/src/HsLua/Marshalling/Peek.hs b/src/HsLua/Marshalling/Peek.hs --- a/src/HsLua/Marshalling/Peek.hs +++ b/src/HsLua/Marshalling/Peek.hs @@ -4,9 +4,9 @@ {-# LANGUAGE ScopedTypeVariables #-} {-| Module : HsLua.Marshalling.Peek -Copyright : © 2020-2022 Albert Krewinkel +Copyright : © 2020-2023 Albert Krewinkel License : MIT -Maintainer : Albert Krewinkel +Maintainer : Albert Krewinkel Stability : beta Portability : Portable @@ -40,9 +40,6 @@ #if !MIN_VERSION_base(4,13,0) import Control.Monad.Fail (MonadFail (..)) #endif -#if !MIN_VERSION_base(4,12,0) -import Data.Semigroup (Semigroup ((<>))) -#endif import qualified HsLua.Core.Utf8 as Utf8 -- | Record to keep track of failure contexts while retrieving objects @@ -72,6 +69,10 @@ {-# INLINE (<|>) #-} instance MonadPlus Result + +instance MonadFail Result where + fail = failure . Utf8.fromString + {-# INLINABLE fail #-} -- -- Peek diff --git a/src/HsLua/Marshalling/Peekers.hs b/src/HsLua/Marshalling/Peekers.hs --- a/src/HsLua/Marshalling/Peekers.hs +++ b/src/HsLua/Marshalling/Peekers.hs @@ -1,12 +1,11 @@ {-# LANGUAGE BangPatterns #-} -{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-| Module : HsLua.Marshalling.Peekers -Copyright : © 2020-2022 Albert Krewinkel +Copyright : © 2020-2023 Albert Krewinkel License : MIT -Maintainer : Albert Krewinkel +Maintainer : Albert Krewinkel Stability : beta Portability : Portable @@ -32,12 +31,16 @@ -- ** Collections , peekKeyValuePairs , peekList + , peekNonEmpty , peekMap , peekSet -- ** Combinators , choice , peekFieldRaw , peekIndexRaw + , peekNilOr + , peekNoneOr + , peekNoneOrNilOr , peekPair , peekTriple -- ** Building peek functions @@ -49,6 +52,7 @@ import Control.Applicative (Alternative (..)) import Control.Monad ((<$!>), (>=>), void) import Data.ByteString (ByteString) +import Data.List.NonEmpty (NonEmpty ((:|))) import Data.Map (Map) import Data.Set (Set) import Data.String (IsString (fromString)) @@ -56,10 +60,6 @@ import HsLua.Marshalling.Peek import Text.Read (readMaybe) -#if !MIN_VERSION_base(4,12,0) -import Data.Semigroup (Semigroup ((<>))) -#endif - import qualified Data.ByteString.Lazy as BL import qualified Data.Map as Map import qualified Data.Set as Set @@ -226,8 +226,18 @@ -- the list is equal to @rawlen(t)@. The operation will fail unless all -- numerical fields between @1@ and @rawlen(t)@ can be retrieved. peekList :: forall a e. LuaError e => Peeker e a -> Peeker e [a] -peekList peekElement = fmap (retrieving "list") . - typeChecked "table" istable $ \idx -> do +peekList peekElement = retrieving "list" . peekList' peekElement + +-- | Like 'peekList', but fails if the list is empty. +peekNonEmpty :: LuaError e => Peeker e a -> Peeker e (NonEmpty a) +peekNonEmpty peekElement = retrieving "NonEmpty" . + (peekList' peekElement >=> \case + (x:xs) -> return (x :| xs) + [] -> failPeek "empty list") + +-- | Helper function that retrieves a list, but doesn't set a context. +peekList' :: LuaError e => Peeker e a -> Peeker e [a] +peekList' peekElement = typeChecked "table" istable $ \idx -> do liftLua $ checkstack' 1 "retrieving a list" let elementsAt [] = return [] elementsAt (i : is) = do @@ -309,6 +319,35 @@ liftLua . void $ rawgeti idx i peeker top `lastly` Lua.pop 1 {-# INLINABLE peekIndexRaw #-} + + +-- | Returns 'empty' if the value at the given index is @nil@; +-- otherwise returns the result of peeker @p@. +peekNilOr :: Alternative m + => Peeker e a -- ^ p + -> Peeker e (m a) +peekNilOr p idx = liftLua (ltype idx) >>= \case + TypeNil -> pure empty + _ -> pure <$> p idx + +-- | Returns 'empty' if the value at the given index is @none@; +-- otherwise returns the result of peeker @p@. +peekNoneOr :: Alternative m + => Peeker e a -- ^ p + -> Peeker e (m a) +peekNoneOr p idx = liftLua (ltype idx) >>= \case + TypeNone -> pure empty + _ -> pure <$> p idx + +-- | Returns 'empty' if the value at the given index is @none@ or +-- @nil@; otherwise returns the result of peeker @p@. +peekNoneOrNilOr :: Alternative m + => Peeker e a -- ^ p + -> Peeker e (m a) +peekNoneOrNilOr p idx = liftLua (ltype idx) >>= \case + TypeNil -> pure empty + TypeNone -> pure empty + _ -> pure <$> p idx -- | Retrieves a value pair from a table. Expects the values to be -- stored in a numerically indexed table; does not access metamethods. diff --git a/src/HsLua/Marshalling/Push.hs b/src/HsLua/Marshalling/Push.hs --- a/src/HsLua/Marshalling/Push.hs +++ b/src/HsLua/Marshalling/Push.hs @@ -1,8 +1,8 @@ {-| Module : HsLua.Marshalling.Push -Copyright : © 2020-2022 Albert Krewinkel +Copyright : © 2020-2023 Albert Krewinkel License : MIT -Maintainer : Albert Krewinkel +Maintainer : Albert Krewinkel Stability : beta Portability : Portable @@ -22,6 +22,7 @@ , pushName -- * Collections , pushList + , pushNonEmpty , pushKeyValuePairs , pushMap , pushSet @@ -40,6 +41,7 @@ import qualified Data.Text as T import qualified Data.ByteString.Lazy as BL +import qualified Data.List.NonEmpty as NonEmpty import qualified HsLua.Core.Utf8 as Utf8 -- | Function to push a value to Lua's stack. @@ -113,6 +115,10 @@ let setField i x = push x *> rawseti (-2) i newtable zipWithM_ setField [1..] xs + +-- | Push non-empty list as numerically indexed table. +pushNonEmpty :: LuaError e => Pusher e a -> NonEmpty.NonEmpty a -> LuaE e () +pushNonEmpty push = pushList push . NonEmpty.toList -- | Push 'Map' as default key-value Lua table. pushMap :: LuaError e => Pusher e a -> Pusher e b -> Pusher e (Map a b) diff --git a/src/HsLua/Marshalling/Userdata.hs b/src/HsLua/Marshalling/Userdata.hs --- a/src/HsLua/Marshalling/Userdata.hs +++ b/src/HsLua/Marshalling/Userdata.hs @@ -5,9 +5,9 @@ Module : HsLua.Marshalling.Userdata Copyright : © 2007–2012 Gracjan Polak; © 2012–2016 Ömer Sinan Ağacan; - © 2017-2022 Albert Krewinkel + © 2017-2023 Albert Krewinkel License : MIT -Maintainer : Albert Krewinkel +Maintainer : Albert Krewinkel Stability : beta Portability : non-portable (depends on GHC) diff --git a/test/HsLua/Marshalling/PeekTests.hs b/test/HsLua/Marshalling/PeekTests.hs --- a/test/HsLua/Marshalling/PeekTests.hs +++ b/test/HsLua/Marshalling/PeekTests.hs @@ -2,9 +2,9 @@ {-# LANGUAGE TypeApplications #-} {-| Module : HsLua.Marshalling.PeekTests -Copyright : © 2020-2022 Albert Krewinkel +Copyright : © 2020-2023 Albert Krewinkel License : MIT -Maintainer : Albert Krewinkel +Maintainer : Albert Krewinkel Stability : alpha Portability : OverloadedStrings, TypeApplications diff --git a/test/HsLua/Marshalling/PeekersTests.hs b/test/HsLua/Marshalling/PeekersTests.hs --- a/test/HsLua/Marshalling/PeekersTests.hs +++ b/test/HsLua/Marshalling/PeekersTests.hs @@ -2,9 +2,9 @@ {-# LANGUAGE TypeApplications #-} {-| Module : HsLua.Marshalling.PeekersTests -Copyright : © 2020-2022 Albert Krewinkel +Copyright : © 2020-2023 Albert Krewinkel License : MIT -Maintainer : Albert Krewinkel +Maintainer : Albert Krewinkel Tests for Haskell-value retriever functions. -} @@ -25,6 +25,7 @@ import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as Char8 +import qualified Data.List.NonEmpty as NonEmpty import qualified Data.Map as Map import qualified Data.Set as Set import qualified Data.Text as T @@ -278,6 +279,18 @@ runPeek $ peekList peekByteString Lua.top ] + , testGroup "peekNonEmpty" + [ "empty list" =: + Failure "empty list" ["retrieving NonEmpty"] `shouldBeResultOf` do + Lua.newtable + runPeek $ peekNonEmpty peekBool Lua.top + + , "non-empty list" =: + Success (5 NonEmpty.:| [23]) `shouldBeResultOf` do + pushLuaExpr "{ 5, 23 }" + runPeek $ peekNonEmpty (peekIntegral @Int) Lua.top + ] + , testGroup "peekSet" [ "empty set" =: Success Set.empty `shouldBeResultOf` do @@ -343,6 +356,7 @@ ] ] + , testGroup "combinators" [ testGroup "peekFieldRaw" [ "access field" =: @@ -408,6 +422,48 @@ , "fails if all peekers fail" =: Failure "all choices failed" [] `shouldBeResultOf` do runPeeker (choice [const $ failPeek @() "nope"]) Lua.top + ] + + , testGroup "peekNilOr" + [ "returns the parser result if the value is not nil" =: + Success (Just "a") `shouldBeResultOf` runPeek + (liftLua (Lua.pushstring "a") *> peekNilOr peekString Lua.top) + , "returns nothing if the value is nil" =: + Success Nothing `shouldBeResultOf` runPeek + (liftLua Lua.pushnil *> peekNilOr peekString Lua.top) + , "fails if the value is none" =: + Failure "string expected, got no value" [] `shouldBeResultOf` runPeek + (liftLua Lua.gettop >>= peekNilOr @Maybe peekString . (+1)) + ] + + , testGroup "peekNoneOr" + [ "returns the parser result if a value is present" =: + Success (Just "a") `shouldBeResultOf` runPeek + (liftLua (Lua.pushstring "a") *> peekNoneOr peekString Lua.top) + , "returns the parser result if the value is nil" =: + Success (Just ()) `shouldBeResultOf` runPeek + (liftLua Lua.pushnil *> peekNoneOr peekNil Lua.top) + , "returns `empty` if the value is missing" =: + Success Nothing `shouldBeResultOf` runPeek + (liftLua Lua.gettop >>= peekNoneOr @Maybe peekString . (+1)) + , "fails if the parser cannot parse the value" =: + Failure "string expected, got nil" [] `shouldBeResultOf` runPeek + (liftLua Lua.pushnil *> peekNoneOr @Maybe peekString Lua.top) + ] + , testGroup "peekNoneOrNilOr" + [ "returns the parser result if a value is present" =: + Success (Just "a") `shouldBeResultOf` runPeek + (liftLua (Lua.pushstring "a") *> peekNoneOrNilOr peekString Lua.top) + , "returns `empty` if the value is nil" =: + Success Nothing `shouldBeResultOf` runPeek + (liftLua Lua.pushnil *> peekNoneOrNilOr @Maybe peekString Lua.top) + , "returns `empty` if the value is missing" =: + Success Nothing `shouldBeResultOf` runPeek + (liftLua Lua.gettop >>= peekNoneOrNilOr @Maybe peekString . (+1)) + , "fails if the parser cannot parse the value" =: + Failure "string expected, got boolean" [] `shouldBeResultOf` runPeek + (liftLua (Lua.pushboolean True) *> + peekNoneOrNilOr @Maybe peekString Lua.top) ] ] diff --git a/test/HsLua/Marshalling/PushTests.hs b/test/HsLua/Marshalling/PushTests.hs --- a/test/HsLua/Marshalling/PushTests.hs +++ b/test/HsLua/Marshalling/PushTests.hs @@ -1,12 +1,11 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} {-| Module : HsLua.Marshalling.PushTests -Copyright : © 2020-2022 Albert Krewinkel +Copyright : © 2020-2023 Albert Krewinkel License : MIT -Maintainer : Albert Krewinkel +Maintainer : Albert Krewinkel Stability : alpha Portability : OverloadedStrings, TypeApplications @@ -28,10 +27,6 @@ import Test.Tasty.HUnit (Assertion, assertFailure) import Test.Tasty.QuickCheck (Arbitrary, testProperty) -#if !MIN_VERSION_base(4,12,0) -import Data.Semigroup (Semigroup ((<>))) -#endif - import qualified Data.Map as Map import qualified Data.Set as Set import qualified HsLua.Core as Lua @@ -158,6 +153,14 @@ assert $ tableSize == length list , testSingleElementProperty (pushList pushText) + ] + + , testGroup "pushNonEmpty" + [ testProperty "table size equals list length" $ \list -> monadicIO $ do + tableSize <- run $ Lua.run @Lua.Exception $ do + pushNonEmpty pushString list + Lua.rawlen Lua.top + assert $ tableSize == length list ] , testGroup "pushKeyValuePairs" diff --git a/test/HsLua/Marshalling/UserdataTests.hs b/test/HsLua/Marshalling/UserdataTests.hs --- a/test/HsLua/Marshalling/UserdataTests.hs +++ b/test/HsLua/Marshalling/UserdataTests.hs @@ -1,9 +1,9 @@ {-# LANGUAGE OverloadedStrings #-} {-| Module : HsLua.Marshalling.UserdataTests -Copyright : © 2018-2022 Albert Krewinkel +Copyright : © 2018-2023 Albert Krewinkel License : MIT -Maintainer : Albert Krewinkel +Maintainer : Albert Krewinkel Tests that any data type can be pushed to Lua as userdata. -} diff --git a/test/HsLua/MarshallingTests.hs b/test/HsLua/MarshallingTests.hs --- a/test/HsLua/MarshallingTests.hs +++ b/test/HsLua/MarshallingTests.hs @@ -2,9 +2,9 @@ {-# LANGUAGE OverloadedStrings #-} {-| Module : HsLua.MarshallingTests -Copyright : © 2020-2022 Albert Krewinkel +Copyright : © 2020-2023 Albert Krewinkel License : MIT -Maintainer : Albert Krewinkel +Maintainer : Albert Krewinkel Stability : alpha Portability : OverloadedStrings, TypeApplications diff --git a/test/test-hslua-marshalling.hs b/test/test-hslua-marshalling.hs --- a/test/test-hslua-marshalling.hs +++ b/test/test-hslua-marshalling.hs @@ -1,8 +1,8 @@ {-| Module : Main -Copyright : © 2017-2022 Albert Krewinkel +Copyright : © 2017-2023 Albert Krewinkel License : MIT -Maintainer : Albert Krewinkel +Maintainer : Albert Krewinkel Tests for HsLua. -}