{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeOperators #-}

-- |
-- Provides the ability to use MessagePack for plugin input/output
module Extism.PDK.MsgPack
  ( module Extism.PDK.MsgPack,
    module Data.MessagePack,
    module Map,
  )
where

import Data.Bifunctor (bimap)
import qualified Data.ByteString as B
import Data.ByteString.Internal (c2w, w2c)
import Data.Int
import qualified Data.Map.Strict as Map
import Data.MessagePack
import qualified Data.Serialize as S
import Data.Word
import GHC.Generics

class MsgPack a where
  toMsgPack :: a -> Object
  fromMsgPack :: Object -> Maybe a

class GMsgPack f where
  toGMsgPack :: f a -> Object
  fromGMsgPack :: Object -> Maybe (f a)
  fromGMsgPack Object
_ = Maybe (f a)
forall a. Maybe a
Nothing

instance GMsgPack U1 where
  toGMsgPack :: forall a. U1 a -> Object
toGMsgPack U1 a
U1 = Object
ObjectNil
  fromGMsgPack :: forall a. Object -> Maybe (U1 a)
fromGMsgPack Object
ObjectNil = U1 a -> Maybe (U1 a)
forall a. a -> Maybe a
Just U1 a
forall k (p :: k). U1 p
U1

instance (GMsgPack a, GMsgPack b) => GMsgPack (a :*: b) where
  toGMsgPack :: forall a. (:*:) a b a -> Object
toGMsgPack (a a
x :*: b a
y) = [Object] -> Object
forall a. MsgPack a => [a] -> Object
array [a a -> Object
forall a. a a -> Object
forall (f :: * -> *) a. GMsgPack f => f a -> Object
toGMsgPack a a
x, b a -> Object
forall a. b a -> Object
forall (f :: * -> *) a. GMsgPack f => f a -> Object
toGMsgPack b a
y]

-- fromGMsgPack (ObjectArray [a, b]) = Just (a :*: b)

instance (GMsgPack a, GMsgPack b) => GMsgPack (a :+: b) where
  toGMsgPack :: forall a. (:+:) a b a -> Object
toGMsgPack (L1 a a
x) = a a -> Object
forall a. a a -> Object
forall (f :: * -> *) a. GMsgPack f => f a -> Object
toGMsgPack a a
x
  toGMsgPack (R1 b a
x) = b a -> Object
forall a. b a -> Object
forall (f :: * -> *) a. GMsgPack f => f a -> Object
toGMsgPack b a
x

instance (GMsgPack a) => GMsgPack (M1 i c a) where
  toGMsgPack :: forall a. M1 i c a a -> Object
toGMsgPack (M1 a a
x) = a a -> Object
forall a. a a -> Object
forall (f :: * -> *) a. GMsgPack f => f a -> Object
toGMsgPack a a
x

instance (MsgPack a) => GMsgPack (K1 i a) where
  toGMsgPack :: forall a. K1 i a a -> Object
toGMsgPack (K1 a
x) = a -> Object
forall a. MsgPack a => a -> Object
toMsgPack a
x

toByteString :: [Char] -> ByteString
toByteString [Char]
x = [Word8] -> ByteString
B.pack ((Char -> Word8) -> [Char] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map Char -> Word8
c2w [Char]
x)

fromByteString :: ByteString -> [Char]
fromByteString ByteString
bs = (Word8 -> Char) -> [Word8] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map Word8 -> Char
w2c ([Word8] -> [Char]) -> [Word8] -> [Char]
forall a b. (a -> b) -> a -> b
$ ByteString -> [Word8]
B.unpack ByteString
bs

instance MsgPack Bool where
  toMsgPack :: Bool -> Object
toMsgPack = Bool -> Object
ObjectBool
  fromMsgPack :: Object -> Maybe Bool
fromMsgPack (ObjectBool Bool
b) = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
b
  fromMsgPack Object
_ = Maybe Bool
forall a. Maybe a
Nothing

instance MsgPack String where
  toMsgPack :: [Char] -> Object
toMsgPack [Char]
s = ByteString -> Object
ObjectString ([Char] -> ByteString
toByteString [Char]
s)
  fromMsgPack :: Object -> Maybe [Char]
fromMsgPack (ObjectString ByteString
s) = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just (ByteString -> [Char]
fromByteString ByteString
s)
  fromMsgPack Object
_ = Maybe [Char]
forall a. Maybe a
Nothing

instance MsgPack B.ByteString where
  toMsgPack :: ByteString -> Object
toMsgPack = ByteString -> Object
ObjectBinary
  fromMsgPack :: Object -> Maybe ByteString
fromMsgPack (ObjectString ByteString
s) = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
s
  fromMsgPack (ObjectBinary ByteString
s) = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
s
  fromMsgPack Object
_ = Maybe ByteString
forall a. Maybe a
Nothing

instance MsgPack Int where
  toMsgPack :: Int -> Object
toMsgPack Int
i = Int64 -> Object
ObjectInt (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)
  fromMsgPack :: Object -> Maybe Int
fromMsgPack (ObjectInt Int64
i) = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i)
  fromMsgPack Object
_ = Maybe Int
forall a. Maybe a
Nothing

instance MsgPack Int64 where
  toMsgPack :: Int64 -> Object
toMsgPack = Int64 -> Object
ObjectInt
  fromMsgPack :: Object -> Maybe Int64
fromMsgPack (ObjectInt Int64
i) = Int64 -> Maybe Int64
forall a. a -> Maybe a
Just Int64
i
  fromMsgPack Object
_ = Maybe Int64
forall a. Maybe a
Nothing

instance MsgPack Word where
  toMsgPack :: Word -> Object
toMsgPack Word
w = Word64 -> Object
ObjectUInt (Word -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
w)
  fromMsgPack :: Object -> Maybe Word
fromMsgPack (ObjectUInt Word64
x) = Word -> Maybe Word
forall a. a -> Maybe a
Just (Word64 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
x)
  fromMsgPack Object
_ = Maybe Word
forall a. Maybe a
Nothing

instance MsgPack Word64 where
  toMsgPack :: Word64 -> Object
toMsgPack = Word64 -> Object
ObjectUInt
  fromMsgPack :: Object -> Maybe Word64
fromMsgPack (ObjectUInt Word64
x) = Word64 -> Maybe Word64
forall a. a -> Maybe a
Just Word64
x
  fromMsgPack Object
_ = Maybe Word64
forall a. Maybe a
Nothing

instance (MsgPack a) => MsgPack (Maybe a) where
  toMsgPack :: Maybe a -> Object
toMsgPack Maybe a
Nothing = Object
ObjectNil
  toMsgPack (Just a
a) = a -> Object
forall a. MsgPack a => a -> Object
toMsgPack a
a
  fromMsgPack :: Object -> Maybe (Maybe a)
fromMsgPack = Object -> Maybe (Maybe a)
forall a. MsgPack a => Object -> Maybe a
fromMsgPack

instance MsgPack () where
  toMsgPack :: () -> Object
toMsgPack () = Object
ObjectNil
  fromMsgPack :: Object -> Maybe ()
fromMsgPack Object
ObjectNil = () -> Maybe ()
forall a. a -> Maybe a
Just ()
  fromMsgPack Object
_ = Maybe ()
forall a. Maybe a
Nothing

instance MsgPack Float where
  toMsgPack :: Float -> Object
toMsgPack = Float -> Object
ObjectFloat
  fromMsgPack :: Object -> Maybe Float
fromMsgPack (ObjectFloat Float
f) = Float -> Maybe Float
forall a. a -> Maybe a
Just Float
f
  fromMsgPack Object
_ = Maybe Float
forall a. Maybe a
Nothing

instance MsgPack Double where
  toMsgPack :: Double -> Object
toMsgPack = Double -> Object
ObjectDouble
  fromMsgPack :: Object -> Maybe Double
fromMsgPack (ObjectDouble Double
d) = Double -> Maybe Double
forall a. a -> Maybe a
Just Double
d
  fromMsgPack Object
_ = Maybe Double
forall a. Maybe a
Nothing

instance MsgPack Object where
  toMsgPack :: Object -> Object
toMsgPack Object
x = Object
x
  fromMsgPack :: Object -> Maybe Object
fromMsgPack = Object -> Maybe Object
forall a. a -> Maybe a
Just

(.=) :: (MsgPack a) => (MsgPack b) => a -> b -> (Object, Object)
.= :: forall a b. (MsgPack a, MsgPack b) => a -> b -> (Object, Object)
(.=) a
k b
v = (a -> Object
forall a. MsgPack a => a -> Object
toMsgPack a
k, b -> Object
forall a. MsgPack a => a -> Object
toMsgPack b
v)

lookup :: (MsgPack a) => (MsgPack b) => a -> Object -> Maybe b
lookup :: forall a b. (MsgPack a, MsgPack b) => a -> Object -> Maybe b
lookup a
k (ObjectMap Map Object Object
map) =
  let x :: Maybe Object
x = Object -> Map Object Object -> Maybe Object
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (a -> Object
forall a. MsgPack a => a -> Object
toMsgPack a
k) Map Object Object
map
   in Object -> Maybe b
forall a. MsgPack a => Object -> Maybe a
fromMsgPack (Object -> Maybe b) -> Maybe Object -> Maybe b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Object
x
lookup a
_ Object
_ = Maybe b
forall a. Maybe a
Nothing

set :: a -> a -> Object -> Object
set a
k a
v (ObjectMap Map Object Object
map) =
  Map Object Object -> Object
ObjectMap (Map Object Object -> Object) -> Map Object Object -> Object
forall a b. (a -> b) -> a -> b
$ Object -> Object -> Map Object Object -> Map Object Object
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (a -> Object
forall a. MsgPack a => a -> Object
toMsgPack a
k) (a -> Object
forall a. MsgPack a => a -> Object
toMsgPack a
v) Map Object Object
map

(.?) :: (MsgPack a) => (MsgPack b) => Object -> a -> Maybe b
.? :: forall a b. (MsgPack a, MsgPack b) => Object -> a -> Maybe b
(.?) Object
a a
b = a -> Object -> Maybe b
forall a b. (MsgPack a, MsgPack b) => a -> Object -> Maybe b
Extism.PDK.MsgPack.lookup a
b Object
a

object :: (MsgPack a) => (MsgPack b) => [(a, b)] -> Object
object :: forall a b. (MsgPack a, MsgPack b) => [(a, b)] -> Object
object [(a, b)]
l = Map Object Object -> Object
ObjectMap ([(Object, Object)] -> Map Object Object
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Object, Object)] -> Map Object Object)
-> [(Object, Object)] -> Map Object Object
forall a b. (a -> b) -> a -> b
$ ((a, b) -> (Object, Object)) -> [(a, b)] -> [(Object, Object)]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> Object) -> (b -> Object) -> (a, b) -> (Object, Object)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> Object
forall a. MsgPack a => a -> Object
toMsgPack b -> Object
forall a. MsgPack a => a -> Object
toMsgPack) [(a, b)]
l)

array :: (MsgPack a) => [a] -> Object
array :: forall a. MsgPack a => [a] -> Object
array [a]
l = [Object] -> Object
ObjectArray ((a -> Object) -> [a] -> [Object]
forall a b. (a -> b) -> [a] -> [b]
map a -> Object
forall a. MsgPack a => a -> Object
toMsgPack [a]
l)

encode :: (MsgPack a) => a -> B.ByteString
encode :: forall a. MsgPack a => a -> ByteString
encode a
x =
  let y :: Object
y = a -> Object
forall a. MsgPack a => a -> Object
toMsgPack a
x
   in Object -> ByteString
forall a. Serialize a => a -> ByteString
S.encode Object
y

decode :: (MsgPack a) => B.ByteString -> Either String a
decode :: forall a. MsgPack a => ByteString -> Either [Char] a
decode ByteString
bs =
  case ByteString -> Either [Char] Object
forall a. Serialize a => ByteString -> Either [Char] a
S.decode ByteString
bs of
    Right Object
a -> case Object -> Maybe a
forall a. MsgPack a => Object -> Maybe a
fromMsgPack Object
a of
      Maybe a
Nothing -> [Char] -> Either [Char] a
forall a b. a -> Either a b
Left [Char]
"Invalid type conversion"
      Just a
x -> a -> Either [Char] a
forall a b. b -> Either a b
Right a
x
    Left [Char]
s -> [Char] -> Either [Char] a
forall a b. a -> Either a b
Left [Char]
s