{-# LANGUAGE FlexibleInstances #-}

-- |
-- Extism.Encoding handles how values are encoded to be copied in and out of Wasm linear memory
module Extism.Encoding
  ( fromByteString,
    toByteString,
    Error (..),
    Result (..),
    ToBytes (..),
    FromBytes (..),
    Encoding (..),
    JSON (..),
  )
where

import Data.Binary.Get (getDoublele, getFloatle, getInt32le, getInt64le, getWord32le, getWord64le, runGetOrFail)
import Data.Binary.Put (putDoublele, putFloatle, putInt32le, putInt64le, putWord32le, putWord64le, runPut)
import qualified Data.ByteString as B
import Data.ByteString.Internal (c2w, unsafePackLenAddress, w2c)
import Data.Int
import Data.Word
import qualified Text.JSON (JSValue, Result (..), decode, encode, showJSON, toJSObject)
import qualified Text.JSON.Generic (Data, decodeJSON, encodeJSON, fromJSON, toJSON)

-- | Helper function to convert a 'String' to a 'ByteString'
toByteString :: String -> B.ByteString
toByteString :: String -> ByteString
toByteString String
x = [Word8] -> ByteString
B.pack ((Char -> Word8) -> String -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Word8
c2w String
x)

-- | Helper function to convert a 'ByteString' to a 'String'
fromByteString :: B.ByteString -> String
fromByteString :: ByteString -> String
fromByteString ByteString
bs = (Word8 -> Char) -> [Word8] -> String
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> Char
w2c ([Word8] -> String) -> [Word8] -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> [Word8]
B.unpack ByteString
bs

-- | Extism error
newtype Error = ExtismError String deriving (Int -> Error -> ShowS
[Error] -> ShowS
Error -> String
(Int -> Error -> ShowS)
-> (Error -> String) -> ([Error] -> ShowS) -> Show Error
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Error -> ShowS
showsPrec :: Int -> Error -> ShowS
$cshow :: Error -> String
show :: Error -> String
$cshowList :: [Error] -> ShowS
showList :: [Error] -> ShowS
Show, Error -> Error -> Bool
(Error -> Error -> Bool) -> (Error -> Error -> Bool) -> Eq Error
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Error -> Error -> Bool
== :: Error -> Error -> Bool
$c/= :: Error -> Error -> Bool
/= :: Error -> Error -> Bool
Eq)

-- | Result type
type Result a = Either Error a

-- Used to convert a value into linear memory
class ToBytes a where
  toBytes :: a -> B.ByteString

-- Used to read a value from linear memory
class FromBytes a where
  fromBytes :: B.ByteString -> Result a

-- Encoding is used to indicate a type implements both `ToBytes` and `FromBytes`
class (ToBytes a, FromBytes a) => Encoding a

instance ToBytes () where
  toBytes :: () -> ByteString
toBytes () = String -> ByteString
toByteString String
""

instance FromBytes () where
  fromBytes :: ByteString -> Result ()
fromBytes ByteString
_ = () -> Result ()
forall a b. b -> Either a b
Right ()

instance ToBytes B.ByteString where
  toBytes :: ByteString -> ByteString
toBytes ByteString
x = ByteString
x

instance FromBytes B.ByteString where
  fromBytes :: ByteString -> Result ByteString
fromBytes = ByteString -> Result ByteString
forall a b. b -> Either a b
Right

instance ToBytes [Char] where
  toBytes :: String -> ByteString
toBytes = String -> ByteString
toByteString

instance FromBytes [Char] where
  fromBytes :: ByteString -> Result String
fromBytes ByteString
bs =
    String -> Result String
forall a b. b -> Either a b
Right (String -> Result String) -> String -> Result String
forall a b. (a -> b) -> a -> b
$ ByteString -> String
fromByteString ByteString
bs

instance ToBytes Int32 where
  toBytes :: Int32 -> ByteString
toBytes Int32
i = ByteString -> ByteString
B.toStrict (Put -> ByteString
runPut (Int32 -> Put
putInt32le Int32
i))

instance FromBytes Int32 where
  fromBytes :: ByteString -> Result Int32
fromBytes ByteString
bs =
    case Get Int32
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, Int32)
forall a.
Get a
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
runGetOrFail Get Int32
getInt32le (ByteString -> ByteString
B.fromStrict ByteString
bs) of
      Left (ByteString
_, ByteOffset
_, String
e) -> Error -> Result Int32
forall a b. a -> Either a b
Left (String -> Error
ExtismError String
e)
      Right (ByteString
_, ByteOffset
_, Int32
x) -> Int32 -> Result Int32
forall a b. b -> Either a b
Right Int32
x

instance ToBytes Int64 where
  toBytes :: ByteOffset -> ByteString
toBytes ByteOffset
i = ByteString -> ByteString
B.toStrict (Put -> ByteString
runPut (ByteOffset -> Put
putInt64le ByteOffset
i))

instance FromBytes Int64 where
  fromBytes :: ByteString -> Result ByteOffset
fromBytes ByteString
bs =
    case Get ByteOffset
-> ByteString
-> Either
     (ByteString, ByteOffset, String)
     (ByteString, ByteOffset, ByteOffset)
forall a.
Get a
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
runGetOrFail Get ByteOffset
getInt64le (ByteString -> ByteString
B.fromStrict ByteString
bs) of
      Left (ByteString
_, ByteOffset
_, String
e) -> Error -> Result ByteOffset
forall a b. a -> Either a b
Left (String -> Error
ExtismError String
e)
      Right (ByteString
_, ByteOffset
_, ByteOffset
x) -> ByteOffset -> Result ByteOffset
forall a b. b -> Either a b
Right ByteOffset
x

instance ToBytes Word32 where
  toBytes :: Word32 -> ByteString
toBytes Word32
i = ByteString -> ByteString
B.toStrict (Put -> ByteString
runPut (Word32 -> Put
putWord32le Word32
i))

instance FromBytes Word32 where
  fromBytes :: ByteString -> Result Word32
fromBytes ByteString
bs =
    case Get Word32
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, Word32)
forall a.
Get a
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
runGetOrFail Get Word32
getWord32le (ByteString -> ByteString
B.fromStrict ByteString
bs) of
      Left (ByteString
_, ByteOffset
_, String
e) -> Error -> Result Word32
forall a b. a -> Either a b
Left (String -> Error
ExtismError String
e)
      Right (ByteString
_, ByteOffset
_, Word32
x) -> Word32 -> Result Word32
forall a b. b -> Either a b
Right Word32
x

instance ToBytes Word64 where
  toBytes :: Word64 -> ByteString
toBytes Word64
i = ByteString -> ByteString
B.toStrict (Put -> ByteString
runPut (Word64 -> Put
putWord64le Word64
i))

instance FromBytes Word64 where
  fromBytes :: ByteString -> Result Word64
fromBytes ByteString
bs =
    case Get Word64
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, Word64)
forall a.
Get a
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
runGetOrFail Get Word64
getWord64le (ByteString -> ByteString
B.fromStrict ByteString
bs) of
      Left (ByteString
_, ByteOffset
_, String
e) -> Error -> Result Word64
forall a b. a -> Either a b
Left (String -> Error
ExtismError String
e)
      Right (ByteString
_, ByteOffset
_, Word64
x) -> Word64 -> Result Word64
forall a b. b -> Either a b
Right Word64
x

instance ToBytes Float where
  toBytes :: Float -> ByteString
toBytes Float
i = ByteString -> ByteString
B.toStrict (Put -> ByteString
runPut (Float -> Put
putFloatle Float
i))

instance FromBytes Float where
  fromBytes :: ByteString -> Result Float
fromBytes ByteString
bs =
    case Get Float
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, Float)
forall a.
Get a
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
runGetOrFail Get Float
getFloatle (ByteString -> ByteString
B.fromStrict ByteString
bs) of
      Left (ByteString
_, ByteOffset
_, String
e) -> Error -> Result Float
forall a b. a -> Either a b
Left (String -> Error
ExtismError String
e)
      Right (ByteString
_, ByteOffset
_, Float
x) -> Float -> Result Float
forall a b. b -> Either a b
Right Float
x

instance ToBytes Double where
  toBytes :: Double -> ByteString
toBytes Double
i = ByteString -> ByteString
B.toStrict (Put -> ByteString
runPut (Double -> Put
putDoublele Double
i))

instance FromBytes Double where
  fromBytes :: ByteString -> Result Double
fromBytes ByteString
bs =
    case Get Double
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, Double)
forall a.
Get a
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
runGetOrFail Get Double
getDoublele (ByteString -> ByteString
B.fromStrict ByteString
bs) of
      Left (ByteString
_, ByteOffset
_, String
e) -> Error -> Result Double
forall a b. a -> Either a b
Left (String -> Error
ExtismError String
e)
      Right (ByteString
_, ByteOffset
_, Double
x) -> Double -> Result Double
forall a b. b -> Either a b
Right Double
x

-- Wraps a `JSON` value for input/output
newtype JSON x = JSON x

instance (Text.JSON.Generic.Data a) => ToBytes (JSON a) where
  toBytes :: JSON a -> ByteString
toBytes (JSON a
x) =
    String -> ByteString
toByteString (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Data a => a -> String
Text.JSON.Generic.encodeJSON a
x

instance (Text.JSON.Generic.Data a) => FromBytes (JSON a) where
  fromBytes :: ByteString -> Result (JSON a)
fromBytes ByteString
bs =
    let x :: Result JSValue
x = String -> Result JSValue
forall a. JSON a => String -> Result a
Text.JSON.decode (ByteString -> String
fromByteString ByteString
bs)
     in case Result JSValue
x of
          Text.JSON.Error String
e -> Error -> Result (JSON a)
forall a b. a -> Either a b
Left (String -> Error
ExtismError String
e)
          Text.JSON.Ok JSValue
x ->
            case JSValue -> Result a
forall a. Data a => JSValue -> Result a
Text.JSON.Generic.fromJSON (JSValue
x :: Text.JSON.JSValue) of
              Text.JSON.Error String
e -> Error -> Result (JSON a)
forall a b. a -> Either a b
Left (String -> Error
ExtismError String
e)
              Text.JSON.Ok a
x -> JSON a -> Result (JSON a)
forall a b. b -> Either a b
Right (a -> JSON a
forall x. x -> JSON x
JSON a
x)