module Extism.JSON (
  module Extism.JSON,
  module Text.JSON
) where

import Text.JSON
import qualified Data.ByteString as B
import Data.ByteString.Internal (c2w, w2c)
import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Char8 as BS (unpack)

data Nullable a = Null | NotNull a

makeArray :: [a] -> JSValue
makeArray [a]
x = [JSValue] -> JSValue
JSArray [a -> JSValue
forall a. JSON a => a -> JSValue
showJSON a
a | a
a <- [a]
x]
isNull :: JSValue -> Bool
isNull JSValue
JSNull = Bool
True
isNull JSValue
_ = Bool
False
filterNulls :: [(a, JSValue)] -> [(a, JSValue)]
filterNulls [(a, JSValue)]
obj = [(a
a, JSValue
b) | (a
a, JSValue
b) <- [(a, JSValue)]
obj, Bool -> Bool
not (JSValue -> Bool
isNull JSValue
b)]
object :: [(String, JSValue)] -> JSValue
object [(String, JSValue)]
x = [(String, JSValue)] -> JSValue
makeObj ([(String, JSValue)] -> JSValue) -> [(String, JSValue)] -> JSValue
forall a b. (a -> b) -> a -> b
$ [(String, JSValue)] -> [(String, JSValue)]
forall {a}. [(a, JSValue)] -> [(a, JSValue)]
filterNulls [(String, JSValue)]
x
objectWithNulls :: [(String, JSValue)] -> JSValue
objectWithNulls = [(String, JSValue)] -> JSValue
makeObj
nonNull :: a -> Nullable a
nonNull = a -> Nullable a
forall a. a -> Nullable a
NotNull
null' :: Nullable a
null' = Nullable a
forall a. Nullable a
Null
.= :: a -> a -> (a, JSValue)
(.=) a
a a
b = (a
a, a -> JSValue
forall a. JSON a => a -> JSValue
showJSON a
b)
toNullable :: Maybe a -> Nullable a
toNullable (Just a
x) = a -> Nullable a
forall a. a -> Nullable a
NotNull a
x
toNullable Maybe a
Nothing = Nullable a
forall a. Nullable a
Null
fromNullable :: Nullable a -> Maybe a
fromNullable (NotNull a
x) = a -> Maybe a
forall a. a -> Maybe a
Just a
x
fromNullable Nullable a
Null = Maybe a
forall a. Maybe a
Nothing
fromNotNull :: Nullable a -> a
fromNotNull (NotNull a
x) = a
x
fromNotNull Nullable a
Null = String -> a
forall a. HasCallStack => String -> a
error String
"Value is Null"
mapNullable :: (t -> a) -> Nullable t -> Nullable a
mapNullable t -> a
f Nullable t
Null = Nullable a
forall a. Nullable a
Null
mapNullable t -> a
f (NotNull t
x) = a -> Nullable a
forall a. a -> Nullable a
NotNull (t -> a
f t
x)

.? :: JSValue -> String -> Nullable a
(.?) (JSObject JSObject JSValue
a) String
k =
  case String -> JSObject JSValue -> Result a
forall a. JSON a => String -> JSObject JSValue -> Result a
valFromObj String
k JSObject JSValue
a of
    Ok a
x -> a -> Nullable a
forall a. a -> Nullable a
NotNull a
x
    Error String
_ -> Nullable a
forall a. Nullable a
Null
(.?) JSValue
_ String
_ = Nullable a
forall a. Nullable a
Null
.?? :: [(a, a)] -> a -> Nullable a
(.??) [(a, a)]
a a
k = Maybe a -> Nullable a
forall {a}. Maybe a -> Nullable a
toNullable (Maybe a -> Nullable a) -> Maybe a -> Nullable a
forall a b. (a -> b) -> a -> b
$ a -> [(a, a)] -> Maybe a
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup a
k [(a, a)]
a

find :: JSON a => String -> JSValue -> Nullable a
find :: forall a. JSON a => String -> JSValue -> Nullable a
find String
k JSValue
obj = JSValue
obj JSValue -> String -> Nullable a
forall {a}. JSON a => JSValue -> String -> Nullable a
.? String
k

update :: JSON a => String -> a -> JSValue -> JSValue
update :: forall a. JSON a => String -> a -> JSValue -> JSValue
update String
k a
v (JSObject JSObject JSValue
obj) = [(String, JSValue)] -> JSValue
object ([(String, JSValue)] -> JSValue) -> [(String, JSValue)] -> JSValue
forall a b. (a -> b) -> a -> b
$ JSObject JSValue -> [(String, JSValue)]
forall e. JSObject e -> [(String, e)]
fromJSObject JSObject JSValue
obj [(String, JSValue)] -> [(String, JSValue)] -> [(String, JSValue)]
forall a. [a] -> [a] -> [a]
++ [String
k String -> a -> (String, JSValue)
forall {a} {a}. JSON a => a -> a -> (a, JSValue)
.= a
v]

instance JSON a => JSON (Nullable a) where
  showJSON :: Nullable a -> JSValue
showJSON (NotNull a
x) = a -> JSValue
forall a. JSON a => a -> JSValue
showJSON a
x
  showJSON Nullable a
Null = JSValue
JSNull
  readJSON :: JSValue -> Result (Nullable a)
readJSON JSValue
JSNull = Nullable a -> Result (Nullable a)
forall a. a -> Result a
Ok Nullable a
forall a. Nullable a
Null
  readJSON JSValue
x = JSValue -> Result (Nullable a)
forall a. JSON a => JSValue -> Result a
readJSON JSValue
x


newtype Base64 = Base64 B.ByteString

instance JSON Base64 where
  showJSON :: Base64 -> JSValue
showJSON (Base64 ByteString
bs) = String -> JSValue
forall a. JSON a => a -> JSValue
showJSON (ByteString -> String
BS.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
B64.encode ByteString
bs)
  readJSON :: JSValue -> Result Base64
readJSON (JSString JSString
s) =
    let toByteString :: String -> ByteString
toByteString String
x = [Word8] -> ByteString
B.pack ((Char -> Word8) -> String -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map Char -> Word8
c2w String
x) in
    case ByteString -> Either String ByteString
B64.decode (String -> ByteString
toByteString (JSString -> String
fromJSString JSString
s)) of
    Left String
msg -> String -> Result Base64
forall a. String -> Result a
Error String
msg
    Right ByteString
d -> Base64 -> Result Base64
forall a. a -> Result a
Ok (ByteString -> Base64
Base64 ByteString
d)