module Hydra.Impl.Haskell.Ext.Json.Serde where

import Hydra.All
import Hydra.Ext.Json.Coder
import qualified Hydra.Ext.Json.Model as Json
import Hydra.Impl.Haskell.Ext.Bytestrings

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.HashMap.Strict as HS
import qualified Data.Scientific as SC
import qualified Data.Char as C
import qualified Data.String as String


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

aesonToValue :: A.Value -> Json.Value
aesonToValue :: Value -> Value
aesonToValue Value
v = case Value
v of
  A.Object Object
km -> Map String Value -> Value
Json.ValueObject forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ((Key, Value) -> (String, Value)
mapPair forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
aesonToValue Value
v)
  A.Array Array
a -> [Value] -> Value
Json.ValueArray (Value -> Value
aesonToValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Vector a -> [a]
V.toList Array
a)
  A.String Text
t -> String -> Value
Json.ValueString forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
t
  A.Number Scientific
s -> Double -> Value
Json.ValueNumber forall a b. (a -> b) -> a -> b
$ 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

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

bytesToValue :: BS.ByteString -> Either String Json.Value
bytesToValue :: ByteString -> Either String Value
bytesToValue ByteString
bs = Value -> Value
aesonToValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either String Value
bytesToAeson ByteString
bs

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

jsonSerdeStr :: (Eq m, Ord m, Read m, Show m) => Type m -> GraphFlow m (Coder (Context m) (Context m) (Term m) String)
jsonSerdeStr :: forall m.
(Eq m, Ord m, Read m, Show m) =>
Type m
-> GraphFlow m (Coder (Context m) (Context m) (Term m) String)
jsonSerdeStr Type m
typ = do
  Coder (Context m) (Context m) (Term m) ByteString
serde <- forall m.
(Eq m, Ord m, Read m, Show m) =>
Type m
-> GraphFlow m (Coder (Context m) (Context m) (Term m) ByteString)
jsonSerde Type m
typ
  forall (m :: * -> *) a. Monad m => a -> m a
return Coder {
    coderEncode :: Term m -> Flow (Context m) String
coderEncode = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> String
bytesToString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s1 s2 v1 v2. Coder s1 s2 v1 v2 -> v1 -> Flow s1 v2
coderEncode Coder (Context m) (Context m) (Term m) ByteString
serde,
    coderDecode :: String -> Flow (Context m) (Term m)
coderDecode = forall s1 s2 v1 v2. Coder s1 s2 v1 v2 -> v2 -> Flow s2 v1
coderDecode Coder (Context m) (Context m) (Term m) ByteString
serde forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
stringToBytes}

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

valueToAeson :: Json.Value -> A.Value
valueToAeson :: Value -> Value
valueToAeson Value
v = case Value
v of
    Json.ValueArray [Value]
l -> Array -> Value
A.Array forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Vector a
V.fromList (Value -> Value
valueToAeson 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 forall a b. (a -> b) -> a -> b
$ forall a. RealFloat a => a -> Scientific
SC.fromFloatDigits Double
d
    Json.ValueObject Map String Value
m -> Object -> Value
A.Object forall a b. (a -> b) -> a -> b
$ forall v. [(Key, v)] -> KeyMap v
AKM.fromList ((String, Value) -> (Key, Value)
mapPair forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
valueToAeson Value
v)
    Json.ValueString String
s -> Text -> Value
A.String forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
s

valueToBytes :: Json.Value -> BS.ByteString
valueToBytes :: Value -> ByteString
valueToBytes = Value -> ByteString
aesonToBytes forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Value
valueToAeson

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