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 [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 forall a b. (a -> b) -> a -> b $ forall {a}. [(a, JSValue)] -> [(a, JSValue)] filterNulls [(String, JSValue)] x objectWithNulls :: [(String, JSValue)] -> JSValue objectWithNulls [(String, JSValue)] x = [(String, JSValue)] -> JSValue makeObj [(String, JSValue)] x nonNull :: a -> Nullable a nonNull a x = forall a. a -> Nullable a NotNull a x null' :: Nullable a null' = forall a. Nullable a Null .= :: a -> a -> (a, JSValue) (.=) a a a b = (a a, forall a. JSON a => a -> JSValue showJSON a b) toNullable :: Maybe a -> Nullable a toNullable (Just a x) = forall a. a -> Nullable a NotNull a x toNullable Maybe a Nothing = forall a. Nullable a Null fromNullable :: Nullable a -> Maybe a fromNullable (NotNull a x) = forall a. a -> Maybe a Just a x fromNullable Nullable a Null = forall a. Maybe a Nothing mapNullable :: (t -> a) -> Nullable t -> Nullable a mapNullable t -> a f Nullable t Null = forall a. Nullable a Null mapNullable t -> a f (NotNull t x) = forall a. a -> Nullable a NotNull (t -> a f t x) .? :: JSValue -> String -> Nullable a (.?) (JSObject JSObject JSValue a) String k = case forall a. JSON a => String -> JSObject JSValue -> Result a valFromObj String k JSObject JSValue a of Ok a x -> forall a. a -> Nullable a NotNull a x Error String _ -> forall a. Nullable a Null (.?) JSValue _ String _ = forall a. Nullable a Null .?? :: [(a, a)] -> a -> Nullable a (.??) [(a, a)] a a k = forall {a}. Maybe a -> Nullable a toNullable forall a b. (a -> b) -> a -> b $ 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 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 forall a b. (a -> b) -> a -> b $ (forall e. JSObject e -> [(String, e)] fromJSObject JSObject JSValue obj) forall a. [a] -> [a] -> [a] ++ [String k 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) = forall a. JSON a => a -> JSValue showJSON a x showJSON Nullable a Null = JSValue JSNull readJSON :: JSValue -> Result (Nullable a) readJSON JSValue JSNull = forall a. a -> Result a Ok forall a. Nullable a Null readJSON JSValue x = 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) = forall a. JSON a => a -> JSValue showJSON (ByteString -> String BS.unpack 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 (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 -> forall a. String -> Result a Error String msg Right ByteString d -> forall a. a -> Result a Ok (ByteString -> Base64 Base64 ByteString d)