{-# LANGUAGE FlexibleInstances #-}
module Extism.PDK.Memory
( Memory (..),
MemoryOffset,
MemoryLength,
FromBytes (..),
ToBytes (..),
JSONValue (..),
MsgPackValue (..),
load,
loadString,
loadByteString,
outputMemory,
memAlloc,
free,
alloc,
allocString,
allocByteString,
memoryOffset,
memoryLength,
findMemory,
)
where
import Data.Binary.Get
import Data.Binary.Put
import qualified Data.ByteString as B
import Data.ByteString.Internal (c2w, w2c)
import Data.Int
import Data.Word
import Extism.PDK.Bindings
import qualified Extism.PDK.MsgPack (MsgPack, decode, encode)
import Extism.PDK.Util
import Text.JSON (JSON, decode, encode, resultToEither)
data Memory = Memory MemoryOffset MemoryLength
load :: (FromBytes a) => Memory -> IO (Either String a)
load :: forall a. FromBytes a => Memory -> IO (Either String a)
load (Memory MemoryOffset
offs MemoryOffset
len) = do
ByteString
x <- MemoryOffset -> MemoryOffset -> IO ByteString
readBytes MemoryOffset
offs MemoryOffset
len
Either String a -> IO (Either String a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String a -> IO (Either String a))
-> Either String a -> IO (Either String a)
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String a
forall a. FromBytes a => ByteString -> Either String a
fromBytes ByteString
x
store :: (ToBytes a) => Memory -> a -> IO ()
store :: forall a. ToBytes a => Memory -> a -> IO ()
store (Memory MemoryOffset
offs MemoryOffset
len) a
a =
let bs :: ByteString
bs = a -> ByteString
forall a. ToBytes a => a -> ByteString
toBytes a
a
in MemoryOffset -> MemoryOffset -> ByteString -> IO ()
writeBytes MemoryOffset
offs MemoryOffset
len ByteString
bs
outputMemory :: Memory -> IO ()
outputMemory :: Memory -> IO ()
outputMemory (Memory MemoryOffset
offs MemoryOffset
len) =
MemoryOffset -> MemoryOffset -> IO ()
extismSetOutput MemoryOffset
offs MemoryOffset
len
loadByteString :: Memory -> IO B.ByteString
loadByteString :: Memory -> IO ByteString
loadByteString (Memory MemoryOffset
offs MemoryOffset
len) = do
MemoryOffset -> MemoryOffset -> IO ByteString
readBytes MemoryOffset
offs MemoryOffset
len
loadString :: Memory -> IO String
loadString :: Memory -> IO String
loadString (Memory MemoryOffset
offs MemoryOffset
len) =
ByteString -> String
fromByteString (ByteString -> String) -> IO ByteString -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MemoryOffset -> MemoryOffset -> IO ByteString
readBytes MemoryOffset
offs MemoryOffset
len
storeString :: Memory -> String -> IO ()
storeString :: Memory -> String -> IO ()
storeString Memory
mem String
s =
let bs :: ByteString
bs = String -> ByteString
toByteString String
s
in Memory -> ByteString -> IO ()
storeByteString Memory
mem ByteString
bs
storeByteString :: Memory -> B.ByteString -> IO ()
storeByteString :: Memory -> ByteString -> IO ()
storeByteString (Memory MemoryOffset
offs MemoryOffset
len) =
MemoryOffset -> MemoryOffset -> ByteString -> IO ()
writeBytes MemoryOffset
offs MemoryOffset
len
alloc :: (ToBytes a) => a -> IO Memory
alloc :: forall a. ToBytes a => a -> IO Memory
alloc a
x =
let bs :: ByteString
bs = a -> ByteString
forall a. ToBytes a => a -> ByteString
toBytes a
x
in do
Memory MemoryOffset
offs MemoryOffset
len <- Int -> IO Memory
memAlloc (ByteString -> Int
B.length ByteString
bs)
MemoryOffset -> MemoryOffset -> ByteString -> IO ()
writeBytes MemoryOffset
offs MemoryOffset
len ByteString
bs
Memory -> IO Memory
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Memory -> IO Memory) -> Memory -> IO Memory
forall a b. (a -> b) -> a -> b
$ MemoryOffset -> MemoryOffset -> Memory
Memory MemoryOffset
offs MemoryOffset
len
memAlloc :: Int -> IO Memory
memAlloc :: Int -> IO Memory
memAlloc Int
n =
let len :: MemoryOffset
len = Int -> MemoryOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
in do
MemoryOffset
offs <- MemoryOffset -> IO MemoryOffset
extismAlloc MemoryOffset
len
Memory -> IO Memory
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Memory -> IO Memory) -> Memory -> IO Memory
forall a b. (a -> b) -> a -> b
$ MemoryOffset -> MemoryOffset -> Memory
Memory MemoryOffset
offs MemoryOffset
len
free :: Memory -> IO ()
free :: Memory -> IO ()
free (Memory MemoryOffset
0 MemoryOffset
_) = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
free (Memory MemoryOffset
_ MemoryOffset
0) = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
free (Memory MemoryOffset
offs MemoryOffset
_) =
MemoryOffset -> IO ()
extismFree MemoryOffset
offs
allocByteString :: B.ByteString -> IO Memory
allocByteString :: ByteString -> IO Memory
allocByteString ByteString
bs = do
Memory MemoryOffset
offs MemoryOffset
len <- Int -> IO Memory
memAlloc (ByteString -> Int
B.length ByteString
bs)
MemoryOffset -> MemoryOffset -> ByteString -> IO ()
writeBytes MemoryOffset
offs MemoryOffset
len ByteString
bs
Memory -> IO Memory
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (MemoryOffset -> MemoryOffset -> Memory
Memory MemoryOffset
offs MemoryOffset
len)
allocString :: String -> IO Memory
allocString :: String -> IO Memory
allocString = ByteString -> IO Memory
allocByteString (ByteString -> IO Memory)
-> (String -> ByteString) -> String -> IO Memory
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
toByteString
memoryOffset :: Memory -> MemoryOffset
memoryOffset :: Memory -> MemoryOffset
memoryOffset (Memory MemoryOffset
offs MemoryOffset
_) = MemoryOffset
offs
memoryLength :: Memory -> MemoryLength
memoryLength :: Memory -> MemoryOffset
memoryLength (Memory MemoryOffset
_ MemoryOffset
len) = MemoryOffset
len
findMemory :: MemoryOffset -> IO Memory
findMemory :: MemoryOffset -> IO Memory
findMemory MemoryOffset
offs = do
MemoryOffset
len <- MemoryOffset -> IO MemoryOffset
extismLength MemoryOffset
offs
Memory -> IO Memory
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Memory -> IO Memory) -> Memory -> IO Memory
forall a b. (a -> b) -> a -> b
$ MemoryOffset -> MemoryOffset -> Memory
Memory MemoryOffset
offs MemoryOffset
len
class FromBytes a where
fromBytes :: B.ByteString -> Either String a
class ToBytes a where
toBytes :: a -> B.ByteString
newtype JSONValue a = JSONValue a
newtype MsgPackValue a = MsgPackValue a
instance FromBytes B.ByteString where
fromBytes :: ByteString -> Either String ByteString
fromBytes = ByteString -> Either String ByteString
forall a b. b -> Either a b
Right
instance ToBytes B.ByteString where
toBytes :: ByteString -> ByteString
toBytes = ByteString -> ByteString
forall a. a -> a
id
instance FromBytes String where
fromBytes :: ByteString -> Either String String
fromBytes ByteString
mem =
let s :: Either String ByteString
s = ByteString -> Either String ByteString
forall a. FromBytes a => ByteString -> Either String a
fromBytes ByteString
mem
in case Either String ByteString
s of
Left String
e -> String -> Either String String
forall a b. a -> Either a b
Left String
e
Right ByteString
x -> String -> Either String String
forall a b. b -> Either a b
Right (String -> Either String String) -> String -> Either String String
forall a b. (a -> b) -> a -> b
$ ByteString -> String
fromByteString ByteString
x
instance ToBytes String where
toBytes :: String -> ByteString
toBytes = String -> ByteString
toByteString
instance (JSON a) => FromBytes (JSONValue a) where
fromBytes :: ByteString -> Either String (JSONValue a)
fromBytes ByteString
mem =
let a :: Either String String
a = ByteString -> Either String String
forall a. FromBytes a => ByteString -> Either String a
fromBytes ByteString
mem
in case Either String String
a of
Left String
e -> String -> Either String (JSONValue a)
forall a b. a -> Either a b
Left String
e
Right String
x ->
case Result a -> Either String a
forall a. Result a -> Either String a
resultToEither (Result a -> Either String a) -> Result a -> Either String a
forall a b. (a -> b) -> a -> b
$ String -> Result a
forall a. JSON a => String -> Result a
decode String
x of
Left String
e -> String -> Either String (JSONValue a)
forall a b. a -> Either a b
Left String
e
Right a
y -> JSONValue a -> Either String (JSONValue a)
forall a b. b -> Either a b
Right (a -> JSONValue a
forall a. a -> JSONValue a
JSONValue a
y)
instance (JSON a) => ToBytes (JSONValue a) where
toBytes :: JSONValue a -> ByteString
toBytes (JSONValue a
x) = String -> ByteString
forall a. ToBytes a => a -> ByteString
toBytes (a -> String
forall a. JSON a => a -> String
encode a
x)
instance (Extism.PDK.MsgPack.MsgPack a) => FromBytes (MsgPackValue a) where
fromBytes :: ByteString -> Either String (MsgPackValue a)
fromBytes ByteString
mem =
let a :: Either String ByteString
a = ByteString -> Either String ByteString
forall a. FromBytes a => ByteString -> Either String a
fromBytes ByteString
mem
in case Either String ByteString
a of
Left String
e -> String -> Either String (MsgPackValue a)
forall a b. a -> Either a b
Left String
e
Right ByteString
x ->
case ByteString -> Either String a
forall a. MsgPack a => ByteString -> Either String a
Extism.PDK.MsgPack.decode ByteString
x of
Left String
e -> String -> Either String (MsgPackValue a)
forall a b. a -> Either a b
Left String
e
Right a
y -> MsgPackValue a -> Either String (MsgPackValue a)
forall a b. b -> Either a b
Right (a -> MsgPackValue a
forall a. a -> MsgPackValue a
MsgPackValue a
y)
instance (Extism.PDK.MsgPack.MsgPack a) => ToBytes (MsgPackValue a) where
toBytes :: MsgPackValue a -> ByteString
toBytes (MsgPackValue a
x) = ByteString -> ByteString
forall a. ToBytes a => a -> ByteString
toBytes (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ a -> ByteString
forall a. MsgPack a => a -> ByteString
Extism.PDK.MsgPack.encode a
x
instance ToBytes Int32 where
toBytes :: Int32 -> ByteString
toBytes Int32
i = ByteString -> ByteString
forall a. ToBytes a => a -> ByteString
toBytes (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
B.toStrict (Put -> ByteString
runPut (Int32 -> Put
putInt32le Int32
i))
instance FromBytes Int32 where
fromBytes :: ByteString -> Either String Int32
fromBytes ByteString
mem =
let bs :: Either String ByteString
bs = ByteString -> Either String ByteString
forall a. FromBytes a => ByteString -> Either String a
fromBytes ByteString
mem
in case Either String ByteString
bs of
Left String
e -> String -> Either String Int32
forall a b. a -> Either a b
Left String
e
Right ByteString
x ->
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
x) of
Left (ByteString
_, ByteOffset
_, String
e) -> String -> Either String Int32
forall a b. a -> Either a b
Left String
e
Right (ByteString
_, ByteOffset
_, Int32
x) -> Int32 -> Either String Int32
forall a b. b -> Either a b
Right Int32
x
instance ToBytes Int64 where
toBytes :: ByteOffset -> ByteString
toBytes ByteOffset
i = ByteString -> ByteString
forall a. ToBytes a => a -> ByteString
toBytes (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
B.toStrict (Put -> ByteString
runPut (ByteOffset -> Put
putInt64le ByteOffset
i))
instance FromBytes Int64 where
fromBytes :: ByteString -> Either String ByteOffset
fromBytes ByteString
mem =
let bs :: Either String ByteString
bs = ByteString -> Either String ByteString
forall a. FromBytes a => ByteString -> Either String a
fromBytes ByteString
mem
in case Either String ByteString
bs of
Left String
e -> String -> Either String ByteOffset
forall a b. a -> Either a b
Left String
e
Right ByteString
x ->
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
x) of
Left (ByteString
_, ByteOffset
_, String
e) -> String -> Either String ByteOffset
forall a b. a -> Either a b
Left String
e
Right (ByteString
_, ByteOffset
_, ByteOffset
x) -> ByteOffset -> Either String ByteOffset
forall a b. b -> Either a b
Right ByteOffset
x
instance ToBytes Word32 where
toBytes :: Word32 -> ByteString
toBytes Word32
i = ByteString -> ByteString
forall a. ToBytes a => a -> ByteString
toBytes (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
B.toStrict (Put -> ByteString
runPut (Word32 -> Put
putWord32le Word32
i))
instance FromBytes Word32 where
fromBytes :: ByteString -> Either String Word32
fromBytes ByteString
mem =
let bs :: Either String ByteString
bs = ByteString -> Either String ByteString
forall a. FromBytes a => ByteString -> Either String a
fromBytes ByteString
mem
in case Either String ByteString
bs of
Left String
e -> String -> Either String Word32
forall a b. a -> Either a b
Left String
e
Right ByteString
x ->
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
x) of
Left (ByteString
_, ByteOffset
_, String
e) -> String -> Either String Word32
forall a b. a -> Either a b
Left String
e
Right (ByteString
_, ByteOffset
_, Word32
x) -> Word32 -> Either String Word32
forall a b. b -> Either a b
Right Word32
x
instance ToBytes Word64 where
toBytes :: MemoryOffset -> ByteString
toBytes MemoryOffset
i = ByteString -> ByteString
forall a. ToBytes a => a -> ByteString
toBytes (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
B.toStrict (Put -> ByteString
runPut (MemoryOffset -> Put
putWord64le MemoryOffset
i))
instance FromBytes Word64 where
fromBytes :: ByteString -> Either String MemoryOffset
fromBytes ByteString
mem =
let bs :: Either String ByteString
bs = ByteString -> Either String ByteString
forall a. FromBytes a => ByteString -> Either String a
fromBytes ByteString
mem
in case Either String ByteString
bs of
Left String
e -> String -> Either String MemoryOffset
forall a b. a -> Either a b
Left String
e
Right ByteString
x ->
case Get MemoryOffset
-> ByteString
-> Either
(ByteString, ByteOffset, String)
(ByteString, ByteOffset, MemoryOffset)
forall a.
Get a
-> ByteString
-> Either
(ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
runGetOrFail Get MemoryOffset
getWord64le (ByteString -> ByteString
B.fromStrict ByteString
x) of
Left (ByteString
_, ByteOffset
_, String
e) -> String -> Either String MemoryOffset
forall a b. a -> Either a b
Left String
e
Right (ByteString
_, ByteOffset
_, MemoryOffset
x) -> MemoryOffset -> Either String MemoryOffset
forall a b. b -> Either a b
Right MemoryOffset
x
instance ToBytes Float where
toBytes :: Float -> ByteString
toBytes Float
i = ByteString -> ByteString
forall a. ToBytes a => a -> ByteString
toBytes (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
B.toStrict (Put -> ByteString
runPut (Float -> Put
putFloatle Float
i))
instance FromBytes Float where
fromBytes :: ByteString -> Either String Float
fromBytes ByteString
mem =
let bs :: Either String ByteString
bs = ByteString -> Either String ByteString
forall a. FromBytes a => ByteString -> Either String a
fromBytes ByteString
mem
in case Either String ByteString
bs of
Left String
e -> String -> Either String Float
forall a b. a -> Either a b
Left String
e
Right ByteString
x ->
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
x) of
Left (ByteString
_, ByteOffset
_, String
e) -> String -> Either String Float
forall a b. a -> Either a b
Left String
e
Right (ByteString
_, ByteOffset
_, Float
x) -> Float -> Either String Float
forall a b. b -> Either a b
Right Float
x
instance ToBytes Double where
toBytes :: Double -> ByteString
toBytes Double
i = ByteString -> ByteString
forall a. ToBytes a => a -> ByteString
toBytes (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
B.toStrict (Put -> ByteString
runPut (Double -> Put
putDoublele Double
i))
instance FromBytes Double where
fromBytes :: ByteString -> Either String Double
fromBytes ByteString
mem =
let bs :: Either String ByteString
bs = ByteString -> Either String ByteString
forall a. FromBytes a => ByteString -> Either String a
fromBytes ByteString
mem
in case Either String ByteString
bs of
Left String
e -> String -> Either String Double
forall a b. a -> Either a b
Left String
e
Right ByteString
x ->
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
x) of
Left (ByteString
_, ByteOffset
_, String
e) -> String -> Either String Double
forall a b. a -> Either a b
Left String
e
Right (ByteString
_, ByteOffset
_, Double
x) -> Double -> Either String Double
forall a b. b -> Either a b
Right Double
x