{-# LANGUAGE Rank2Types #-}

-- |
-- Extism plugin development kit, used with the [wasm32-wasi-ghc](https://gitlab.haskell.org/ghc/ghc-wasm-meta) backend to make Extism plugins
module Extism.PDK
  ( module Extism.PDK,
    ToBytes (..),
    FromBytes (..),
    JSON (..),
    MsgPack (..),
  )
where

import Data.ByteString as B
import Extism.PDK.Bindings
import Extism.PDK.Memory
import qualified Extism.PDK.MsgPack (MsgPack, decode, encode)
import Extism.PDK.Util
import qualified Text.JSON (decode, encode, resultToEither)
import qualified Text.JSON.Generic

-- | Get plugin input, returning an error message if the encoding is invalid
tryInput :: (FromBytes a) => IO (Either String a)
tryInput :: forall a. FromBytes a => IO (Either String a)
tryInput = ByteString -> Either String a
forall a. FromBytes a => ByteString -> Either String a
fromBytes (ByteString -> Either String a)
-> IO ByteString -> IO (Either String a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ByteString
inputByteString

-- | Get plugin input
input :: forall a. (FromBytes a) => IO a
input :: forall a. FromBytes a => IO a
input = do
  ByteString
i <- IO ByteString
inputByteString
  case ByteString -> Either String a
forall a. FromBytes a => ByteString -> Either String a
fromBytes ByteString
i of
    Left String
e -> String -> IO a
forall a. HasCallStack => String -> a
error String
e
    Right a
y -> a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
y

-- | Get plugin input as a String
inputString :: IO String
inputString :: IO String
inputString = do
  MemoryOffset
len <- IO MemoryOffset
extismInputLength
  ByteString -> String
fromByteString (ByteString -> String) -> IO ByteString -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MemoryOffset -> IO ByteString
readInputBytes MemoryOffset
len

-- | Get plugin input as a ByteString
inputByteString :: IO ByteString
inputByteString :: IO ByteString
inputByteString = do
  MemoryOffset
len <- IO MemoryOffset
extismInputLength
  MemoryOffset -> IO ByteString
readInputBytes MemoryOffset
len

-- | Get input as 'JSON', this is similar to calling `input (JsonValue ...)`
inputJSON :: (Text.JSON.Generic.Data a) => IO a
inputJSON :: forall a. Data a => IO a
inputJSON = do
  String -> a
forall a. Data a => String -> a
Text.JSON.Generic.decodeJSON (String -> a) -> IO String -> IO a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO String
forall a. FromBytes a => IO a
input

-- | Set plugin output
output :: (ToBytes a) => a -> IO ()
output :: forall a. ToBytes a => a -> IO ()
output a
x = do
  Memory MemoryOffset
offs MemoryOffset
len <- a -> IO Memory
forall a. ToBytes a => a -> IO Memory
alloc a
x
  MemoryOffset -> MemoryOffset -> IO ()
extismSetOutput MemoryOffset
offs MemoryOffset
len

-- | Set plugin output to a JSON encoded version of the provided value
outputJSON :: (Text.JSON.Generic.Data a) => a -> IO ()
outputJSON :: forall a. Data a => a -> IO ()
outputJSON a
x =
  String -> IO ()
forall a. ToBytes a => a -> IO ()
output (a -> String
forall a. Data a => a -> String
Text.JSON.Generic.encodeJSON a
x)

-- | Get a variable from the Extism runtime
getVar :: (FromBytes a) => String -> IO (Maybe a)
getVar :: forall a. FromBytes a => String -> IO (Maybe a)
getVar String
key = do
  Memory
k <- String -> IO Memory
allocString String
key
  MemoryOffset
v <- MemoryOffset -> IO MemoryOffset
extismGetVar (Memory -> MemoryOffset
memoryOffset Memory
k)
  if MemoryOffset
v MemoryOffset -> MemoryOffset -> Bool
forall a. Eq a => a -> a -> Bool
== MemoryOffset
0
    then Maybe a -> IO (Maybe a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
    else do
      Memory
mem <- MemoryOffset -> IO Memory
findMemory MemoryOffset
v
      Either String a
bs <- Memory -> IO (Either String a)
forall a. FromBytes a => Memory -> IO (Either String a)
load Memory
mem
      case Either String a
bs of
        Left String
_ -> Maybe a -> IO (Maybe a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
        Right a
x -> Maybe a -> IO (Maybe a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
x)

-- | Set a variable
setVar :: (ToBytes a) => String -> Maybe a -> IO ()
setVar :: forall a. ToBytes a => String -> Maybe a -> IO ()
setVar String
key Maybe a
Nothing = do
  Memory
k <- String -> IO Memory
allocString String
key
  MemoryOffset -> MemoryOffset -> IO ()
extismSetVar (Memory -> MemoryOffset
memoryOffset Memory
k) MemoryOffset
0
setVar String
key (Just a
v) = do
  Memory
k <- String -> IO Memory
allocString String
key
  Memory
x <- a -> IO Memory
forall a. ToBytes a => a -> IO Memory
alloc a
v
  MemoryOffset -> MemoryOffset -> IO ()
extismSetVar (Memory -> MemoryOffset
memoryOffset Memory
k) (Memory -> MemoryOffset
memoryOffset Memory
x)

-- | Get a configuration value
getConfig :: String -> IO (Maybe String)
getConfig :: String -> IO (Maybe String)
getConfig String
key = do
  Memory
k <- String -> IO Memory
allocString String
key
  MemoryOffset
v <- MemoryOffset -> IO MemoryOffset
extismGetConfig (Memory -> MemoryOffset
memoryOffset Memory
k)
  if MemoryOffset
v MemoryOffset -> MemoryOffset -> Bool
forall a. Eq a => a -> a -> Bool
== MemoryOffset
0
    then Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
    else do
      Memory
mem <- MemoryOffset -> IO Memory
findMemory MemoryOffset
v
      String
s <- Memory -> IO String
loadString Memory
mem
      Memory -> IO ()
free Memory
mem
      Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> IO (Maybe String))
-> Maybe String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. a -> Maybe a
Just String
s

-- | Set the current error message
setError :: String -> IO ()
setError :: String -> IO ()
setError String
msg = do
  Memory
s <- String -> IO Memory
allocString String
msg
  MemoryOffset -> IO ()
extismSetError (MemoryOffset -> IO ()) -> MemoryOffset -> IO ()
forall a b. (a -> b) -> a -> b
$ Memory -> MemoryOffset
memoryOffset Memory
s

-- | Log level
data LogLevel = LogTrace | LogDebug | LogInfo | LogWarn | LogError deriving (Int -> LogLevel
LogLevel -> Int
LogLevel -> [LogLevel]
LogLevel -> LogLevel
LogLevel -> LogLevel -> [LogLevel]
LogLevel -> LogLevel -> LogLevel -> [LogLevel]
(LogLevel -> LogLevel)
-> (LogLevel -> LogLevel)
-> (Int -> LogLevel)
-> (LogLevel -> Int)
-> (LogLevel -> [LogLevel])
-> (LogLevel -> LogLevel -> [LogLevel])
-> (LogLevel -> LogLevel -> [LogLevel])
-> (LogLevel -> LogLevel -> LogLevel -> [LogLevel])
-> Enum LogLevel
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: LogLevel -> LogLevel
succ :: LogLevel -> LogLevel
$cpred :: LogLevel -> LogLevel
pred :: LogLevel -> LogLevel
$ctoEnum :: Int -> LogLevel
toEnum :: Int -> LogLevel
$cfromEnum :: LogLevel -> Int
fromEnum :: LogLevel -> Int
$cenumFrom :: LogLevel -> [LogLevel]
enumFrom :: LogLevel -> [LogLevel]
$cenumFromThen :: LogLevel -> LogLevel -> [LogLevel]
enumFromThen :: LogLevel -> LogLevel -> [LogLevel]
$cenumFromTo :: LogLevel -> LogLevel -> [LogLevel]
enumFromTo :: LogLevel -> LogLevel -> [LogLevel]
$cenumFromThenTo :: LogLevel -> LogLevel -> LogLevel -> [LogLevel]
enumFromThenTo :: LogLevel -> LogLevel -> LogLevel -> [LogLevel]
Enum)

-- | Log to configured log file
log :: LogLevel -> String -> IO ()
log :: LogLevel -> String -> IO ()
log LogLevel
level String
msg = do
  Int32
configuredLevel <- IO Int32
extismGetLogLevel
  if Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (LogLevel -> Int
forall a. Enum a => a -> Int
fromEnum LogLevel
level) Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
< Int32
configuredLevel
    then () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    else do
      Memory
s <- String -> IO Memory
allocString String
msg
      let offs :: MemoryOffset
offs = Memory -> MemoryOffset
memoryOffset Memory
s
      case LogLevel
level of
        LogLevel
LogTrace -> MemoryOffset -> IO ()
extismLogTrace MemoryOffset
offs
        LogLevel
LogDebug -> MemoryOffset -> IO ()
extismLogDebug MemoryOffset
offs
        LogLevel
LogInfo -> MemoryOffset -> IO ()
extismLogInfo MemoryOffset
offs
        LogLevel
LogWarn -> MemoryOffset -> IO ()
extismLogWarn MemoryOffset
offs
        LogLevel
LogError -> MemoryOffset -> IO ()
extismLogError MemoryOffset
offs

-- Log with "error" level
logError :: String -> IO ()
logError :: String -> IO ()
logError = LogLevel -> String -> IO ()
Extism.PDK.log LogLevel
LogError

-- Log with "info" level
logInfo :: String -> IO ()
logInfo :: String -> IO ()
logInfo = LogLevel -> String -> IO ()
Extism.PDK.log LogLevel
LogInfo

-- Log with "debug" level
logDebug :: String -> IO ()
logDebug :: String -> IO ()
logDebug = LogLevel -> String -> IO ()
Extism.PDK.log LogLevel
LogDebug

-- Log with "warn" level
logWarn :: String -> IO ()
logWarn :: String -> IO ()
logWarn = LogLevel -> String -> IO ()
Extism.PDK.log LogLevel
LogWarn

-- Log with "trace" level
logTrace :: String -> IO ()
logTrace :: String -> IO ()
logTrace = LogLevel -> String -> IO ()
Extism.PDK.log LogLevel
LogTrace