Merge pull request #7 from BeFunctional/edsko/remove-failure-wrappers

More consistent treatment of `Failure`
This commit is contained in:
Edsko de Vries 2023-03-23 17:13:58 +00:00 committed by GitHub
commit 1c5fef5162
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
2 changed files with 6 additions and 29 deletions

View file

@ -16,6 +16,8 @@ module Foreign.Rust.External.JSON (
) where ) where
import Codec.Borsh import Codec.Borsh
import Foreign.Rust.Failure
import GHC.Stack
import qualified Data.Aeson as Aeson import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Encoding as Aeson (unsafeToEncoding) import qualified Data.Aeson.Encoding as Aeson (unsafeToEncoding)
@ -32,13 +34,13 @@ newtype JSON = JSON Lazy.ByteString
deriving stock (Eq) deriving stock (Eq)
deriving newtype (BorshSize, ToBorsh, FromBorsh) deriving newtype (BorshSize, ToBorsh, FromBorsh)
-- | Types with an external JSON renderer (typically, in Rust) -- | Types with a Rust-side JSON renderer
class ToJSON a where class ToJSON a where
toJSON :: a -> JSON toJSON :: a -> JSON
-- | Types with an external JSON parser (typically, in Rust) -- | Types with a Rust-side JSON parser
class FromJSON a where class FromJSON a where
fromJSON :: JSON -> Either String a fromJSON :: HasCallStack => JSON -> Either Failure a
{------------------------------------------------------------------------------- {-------------------------------------------------------------------------------
Deriving-via: derive Aeson instances using external (de)serialiser Deriving-via: derive Aeson instances using external (de)serialiser
@ -67,6 +69,6 @@ instance ToJSON a => Aeson.ToJSON (UseExternalJSON a) where
instance FromJSON a => Aeson.FromJSON (UseExternalJSON a) where instance FromJSON a => Aeson.FromJSON (UseExternalJSON a) where
parseJSON val = parseJSON val =
case fromJSON (JSON (Aeson.encode val)) of case fromJSON (JSON (Aeson.encode val)) of
Left failure -> Aeson.parseFail failure Left failure -> Aeson.parseFail (show failure)
Right tx -> return $ UseExternalJSON tx Right tx -> return $ UseExternalJSON tx

View file

@ -11,26 +11,20 @@ module Foreign.Rust.Marshall.Variable (
, Buffer -- opaque , Buffer -- opaque
, getVarBuffer , getVarBuffer
, withBorshVarBuffer , withBorshVarBuffer
, withBorshFailure
, withBorshBufferOfInitSize , withBorshBufferOfInitSize
-- ** Pure variants -- ** Pure variants
, withPureBorshVarBuffer , withPureBorshVarBuffer
, withPureBorshFailure
) where ) where
import Codec.Borsh import Codec.Borsh
import Data.Bifunctor
import Data.Text (Text)
import Data.Typeable import Data.Typeable
import Foreign import Foreign
import Foreign.C.Types import Foreign.C.Types
import GHC.Stack
import System.IO.Unsafe (unsafePerformIO) import System.IO.Unsafe (unsafePerformIO)
import qualified Data.ByteString as Strict import qualified Data.ByteString as Strict
import Foreign.Rust.Marshall.Util import Foreign.Rust.Marshall.Util
import Foreign.Rust.Failure
{------------------------------------------------------------------------------- {-------------------------------------------------------------------------------
Haskell to Rust Haskell to Rust
@ -72,16 +66,6 @@ withBorshVarBuffer :: forall a.
=> (Buffer a -> IO ()) -> IO a => (Buffer a -> IO ()) -> IO a
withBorshVarBuffer = withBorshBufferOfInitSize 1024 withBorshVarBuffer = withBorshBufferOfInitSize 1024
-- | Wrapper around 'withBorshVarBuffer' with explicit support for failures
withBorshFailure :: forall a.
( FromBorsh a
, StaticBorshSize a ~ 'HasVariableSize
, Typeable a
, HasCallStack
)
=> (Buffer (Either Text a) -> IO ()) -> IO (Either Failure a)
withBorshFailure = fmap (first mkFailure) . withBorshVarBuffer
{------------------------------------------------------------------------------- {-------------------------------------------------------------------------------
Pure variants Pure variants
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
@ -94,15 +78,6 @@ withPureBorshVarBuffer :: forall a.
=> (Buffer a -> IO ()) -> a => (Buffer a -> IO ()) -> a
withPureBorshVarBuffer = unsafePerformIO . withBorshVarBuffer withPureBorshVarBuffer = unsafePerformIO . withBorshVarBuffer
withPureBorshFailure :: forall a.
( FromBorsh a
, StaticBorshSize a ~ 'HasVariableSize
, Typeable a
, HasCallStack
)
=> (Buffer (Either Text a) -> IO ()) -> Either Failure a
withPureBorshFailure = unsafePerformIO . withBorshFailure
{------------------------------------------------------------------------------- {-------------------------------------------------------------------------------
Generalization Generalization
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}