module Hydra.Ext.Json.Serde where

import Hydra.Core
import Hydra.Compute
import Hydra.Graph
import Hydra.Ext.Json.Coder
import Hydra.Tools.Bytestrings
import qualified Hydra.Json as Json

import qualified Data.ByteString.Lazy as BS
import qualified Control.Monad as CM
import qualified Data.Aeson as A
import qualified Data.Aeson.KeyMap as AKM
import qualified Data.Aeson.Key as AK
import qualified Data.List as L
import qualified Data.Map as M
import qualified Data.Text as T
import qualified Data.Vector as V
import qualified Data.Scientific as SC
import qualified Data.Char as C
import qualified Data.String as String


aesonValueToBytes :: A.Value -> BS.ByteString
aesonValueToBytes :: Value -> ByteString
aesonValueToBytes = Value -> ByteString
forall a. ToJSON a => a -> ByteString
A.encode

aesonValueToJsonValue :: A.Value -> Json.Value
aesonValueToJsonValue :: Value -> Value
aesonValueToJsonValue Value
v = case Value
v of
  A.Object Object
km -> Map String Value -> Value
Json.ValueObject (Map String Value -> Value) -> Map String Value -> Value
forall a b. (a -> b) -> a -> b
$ [(String, Value)] -> Map String Value
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ((Key, Value) -> (String, Value)
mapPair ((Key, Value) -> (String, Value))
-> [(Key, Value)] -> [(String, Value)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> [(Key, Value)]
forall v. KeyMap v -> [(Key, v)]
AKM.toList Object
km)
    where
      mapPair :: (Key, Value) -> (String, Value)
mapPair (Key
k, Value
v) = (Key -> String
AK.toString Key
k, Value -> Value
aesonValueToJsonValue Value
v)
  A.Array Array
a -> [Value] -> Value
Json.ValueArray (Value -> Value
aesonValueToJsonValue (Value -> Value) -> [Value] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Array -> [Value]
forall a. Vector a -> [a]
V.toList Array
a)
  A.String Text
t -> String -> Value
Json.ValueString (String -> Value) -> String -> Value
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
t
  A.Number Scientific
s -> Double -> Value
Json.ValueNumber (Double -> Value) -> Double -> Value
forall a b. (a -> b) -> a -> b
$ Scientific -> Double
forall a. RealFloat a => Scientific -> a
SC.toRealFloat Scientific
s
  A.Bool Bool
b -> Bool -> Value
Json.ValueBoolean Bool
b
  Value
A.Null -> Value
Json.ValueNull

bytesToAesonValue :: BS.ByteString -> Either String A.Value
bytesToAesonValue :: ByteString -> Either String Value
bytesToAesonValue = ByteString -> Either String Value
forall a. FromJSON a => ByteString -> Either String a
A.eitherDecode

bytesToJsonValue :: BS.ByteString -> Either String Json.Value
bytesToJsonValue :: ByteString -> Either String Value
bytesToJsonValue ByteString
bs = Value -> Value
aesonValueToJsonValue (Value -> Value) -> Either String Value -> Either String Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either String Value
bytesToAesonValue ByteString
bs

jsonByteStringCoder :: Type -> Flow Graph (Coder Graph Graph Term BS.ByteString)
jsonByteStringCoder :: Type -> Flow Graph (Coder Graph Graph Term ByteString)
jsonByteStringCoder Type
typ = do
  Coder Graph Graph Term Value
coder <- Type -> Flow Graph (Coder Graph Graph Term Value)
jsonCoder Type
typ
  Coder Graph Graph Term ByteString
-> Flow Graph (Coder Graph Graph Term ByteString)
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return Coder {
    coderEncode :: Term -> Flow Graph ByteString
coderEncode = (Value -> ByteString) -> Flow Graph Value -> Flow Graph ByteString
forall a b. (a -> b) -> Flow Graph a -> Flow Graph b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> ByteString
jsonValueToBytes (Flow Graph Value -> Flow Graph ByteString)
-> (Term -> Flow Graph Value) -> Term -> Flow Graph ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coder Graph Graph Term Value -> Term -> Flow Graph Value
forall s1 s2 v1 v2. Coder s1 s2 v1 v2 -> v1 -> Flow s1 v2
coderEncode Coder Graph Graph Term Value
coder,
    coderDecode :: ByteString -> Flow Graph Term
coderDecode = \ByteString
bs -> case ByteString -> Either String Value
bytesToJsonValue ByteString
bs of
        Left String
msg -> String -> Flow Graph Term
forall a. String -> Flow Graph a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Flow Graph Term) -> String -> Flow Graph Term
forall a b. (a -> b) -> a -> b
$ String
"JSON parsing failed: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg
        Right Value
v -> Coder Graph Graph Term Value -> Value -> Flow Graph Term
forall s1 s2 v1 v2. Coder s1 s2 v1 v2 -> v2 -> Flow s2 v1
coderDecode Coder Graph Graph Term Value
coder Value
v}

-- | A convenience which maps typed terms to and from pretty-printed JSON strings, as opposed to JSON objects
jsonStringCoder :: Type -> Flow Graph (Coder Graph Graph Term String)
jsonStringCoder :: Type -> Flow Graph (Coder Graph Graph Term String)
jsonStringCoder Type
typ = do
  Coder Graph Graph Term ByteString
serde <- Type -> Flow Graph (Coder Graph Graph Term ByteString)
jsonByteStringCoder Type
typ
  Coder Graph Graph Term String
-> Flow Graph (Coder Graph Graph Term String)
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return Coder {
    coderEncode :: Term -> Flow Graph String
coderEncode = (ByteString -> String)
-> Flow Graph ByteString -> Flow Graph String
forall a b. (a -> b) -> Flow Graph a -> Flow Graph b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> String
bytesToString (Flow Graph ByteString -> Flow Graph String)
-> (Term -> Flow Graph ByteString) -> Term -> Flow Graph String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coder Graph Graph Term ByteString -> Term -> Flow Graph ByteString
forall s1 s2 v1 v2. Coder s1 s2 v1 v2 -> v1 -> Flow s1 v2
coderEncode Coder Graph Graph Term ByteString
serde,
    coderDecode :: String -> Flow Graph Term
coderDecode = Coder Graph Graph Term ByteString -> ByteString -> Flow Graph Term
forall s1 s2 v1 v2. Coder s1 s2 v1 v2 -> v2 -> Flow s2 v1
coderDecode Coder Graph Graph Term ByteString
serde (ByteString -> Flow Graph Term)
-> (String -> ByteString) -> String -> Flow Graph Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
stringToBytes}

jsonValueToAesonValue :: Json.Value -> A.Value
jsonValueToAesonValue :: Value -> Value
jsonValueToAesonValue Value
v = case Value
v of
    Json.ValueArray [Value]
l -> Array -> Value
A.Array (Array -> Value) -> Array -> Value
forall a b. (a -> b) -> a -> b
$ [Value] -> Array
forall a. [a] -> Vector a
V.fromList (Value -> Value
jsonValueToAesonValue (Value -> Value) -> [Value] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Value]
l)
    Json.ValueBoolean Bool
b -> Bool -> Value
A.Bool Bool
b
    Value
Json.ValueNull -> Value
A.Null
    Json.ValueNumber Double
d -> Scientific -> Value
A.Number (Scientific -> Value) -> Scientific -> Value
forall a b. (a -> b) -> a -> b
$ Double -> Scientific
forall a. RealFloat a => a -> Scientific
SC.fromFloatDigits Double
d
    Json.ValueObject Map String Value
m -> Object -> Value
A.Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ [(Key, Value)] -> Object
forall v. [(Key, v)] -> KeyMap v
AKM.fromList ((String, Value) -> (Key, Value)
mapPair ((String, Value) -> (Key, Value))
-> [(String, Value)] -> [(Key, Value)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map String Value -> [(String, Value)]
forall k a. Map k a -> [(k, a)]
M.toList Map String Value
m)
      where
        mapPair :: (String, Value) -> (Key, Value)
mapPair (String
k, Value
v) = (String -> Key
AK.fromString String
k, Value -> Value
jsonValueToAesonValue Value
v)
    Json.ValueString String
s -> Text -> Value
A.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
s

jsonValueToBytes :: Json.Value -> BS.ByteString
jsonValueToBytes :: Value -> ByteString
jsonValueToBytes = Value -> ByteString
aesonValueToBytes (Value -> ByteString) -> (Value -> Value) -> Value -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Value
jsonValueToAesonValue

jsonValueToString :: Json.Value -> String
jsonValueToString :: Value -> String
jsonValueToString = ByteString -> String
bytesToString (ByteString -> String) -> (Value -> ByteString) -> Value -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> ByteString
jsonValueToBytes

stringToJsonValue :: String -> Either String Json.Value
stringToJsonValue :: String -> Either String Value
stringToJsonValue = ByteString -> Either String Value
bytesToJsonValue (ByteString -> Either String Value)
-> (String -> ByteString) -> String -> Either String Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
stringToBytes