module Hydra.Langs.Json.Coder (jsonCoder, literalJsonCoder, untypedTermToJson) where

import Hydra.Core
import Hydra.Compute
import Hydra.Graph
import Hydra.Strip
import Hydra.Basics
import Hydra.CoreEncoding
import Hydra.Tier1
import Hydra.Tier2
import Hydra.Adapters
import Hydra.TermAdapters
import Hydra.Langs.Json.Language
import Hydra.Lib.Literals
import Hydra.AdapterUtils
import qualified Hydra.Json as Json
import qualified Hydra.Dsl.Terms as Terms
import qualified Hydra.Dsl.Types as Types

import qualified Control.Monad as CM
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.Maybe as Y


jsonCoder :: Type -> Flow Graph (Coder Graph Graph Term Json.Value)
jsonCoder :: Type -> Flow Graph (Coder Graph Graph Term Value)
jsonCoder Type
typ = do
  SymmetricAdapter Graph Type Term
adapter <- Language -> Type -> Flow Graph (SymmetricAdapter Graph Type Term)
languageAdapter Language
jsonLanguage Type
typ
  Coder Graph Graph Term Value
coder <- Type -> Flow Graph (Coder Graph Graph Term Value)
termCoder (Type -> Flow Graph (Coder Graph Graph Term Value))
-> Type -> Flow Graph (Coder Graph Graph Term Value)
forall a b. (a -> b) -> a -> b
$ SymmetricAdapter Graph Type Term -> Type
forall s1 s2 t1 t2 v1 v2. Adapter s1 s2 t1 t2 v1 v2 -> t2
adapterTarget SymmetricAdapter Graph Type Term
adapter
  Coder Graph Graph Term Value
-> Flow Graph (Coder Graph Graph Term Value)
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (Coder Graph Graph Term Value
 -> Flow Graph (Coder Graph Graph Term Value))
-> Coder Graph Graph Term Value
-> Flow Graph (Coder Graph Graph Term Value)
forall a b. (a -> b) -> a -> b
$ Coder Graph Graph Term Term
-> Coder Graph Graph Term Value -> Coder Graph Graph Term Value
forall s a b c. Coder s s a b -> Coder s s b c -> Coder s s a c
composeCoders (SymmetricAdapter Graph Type Term -> Coder Graph Graph Term Term
forall s1 s2 t1 t2 v1 v2.
Adapter s1 s2 t1 t2 v1 v2 -> Coder s1 s2 v1 v2
adapterCoder SymmetricAdapter Graph Type Term
adapter) Coder Graph Graph Term Value
coder

literalJsonCoder :: LiteralType -> Flow Graph (Coder Graph Graph Literal Json.Value)
literalJsonCoder :: LiteralType -> Flow Graph (Coder Graph Graph Literal Value)
literalJsonCoder LiteralType
at = Coder Graph Graph Literal Value
-> Flow Graph (Coder Graph Graph Literal Value)
forall a. a -> Flow Graph a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Coder Graph Graph Literal Value
 -> Flow Graph (Coder Graph Graph Literal Value))
-> Coder Graph Graph Literal Value
-> Flow Graph (Coder Graph Graph Literal Value)
forall a b. (a -> b) -> a -> b
$ case LiteralType
at of
  LiteralType
LiteralTypeBoolean -> Coder {
    coderEncode :: Literal -> Flow Graph Value
coderEncode = \(LiteralBoolean Bool
b) -> Value -> Flow Graph Value
forall a. a -> Flow Graph a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Flow Graph Value) -> Value -> Flow Graph Value
forall a b. (a -> b) -> a -> b
$ Bool -> Value
Json.ValueBoolean Bool
b,
    coderDecode :: Value -> Flow Graph Literal
coderDecode = \Value
s -> case Value
s of
      Json.ValueBoolean Bool
b -> Literal -> Flow Graph Literal
forall a. a -> Flow Graph a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Literal -> Flow Graph Literal) -> Literal -> Flow Graph Literal
forall a b. (a -> b) -> a -> b
$ Bool -> Literal
LiteralBoolean Bool
b
      Value
_ -> String -> String -> Flow Graph Literal
forall s x. String -> String -> Flow s x
unexpected String
"boolean" (String -> Flow Graph Literal) -> String -> Flow Graph Literal
forall a b. (a -> b) -> a -> b
$ Value -> String
forall a. Show a => a -> String
show Value
s}
  LiteralTypeFloat FloatType
_ -> Coder {
    coderEncode :: Literal -> Flow Graph Value
coderEncode = \(LiteralFloat (FloatValueBigfloat Double
f)) -> Value -> Flow Graph Value
forall a. a -> Flow Graph a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Flow Graph Value) -> Value -> Flow Graph Value
forall a b. (a -> b) -> a -> b
$ Double -> Value
Json.ValueNumber Double
f,
    coderDecode :: Value -> Flow Graph Literal
coderDecode = \Value
s -> case Value
s of
      Json.ValueNumber Double
f -> Literal -> Flow Graph Literal
forall a. a -> Flow Graph a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Literal -> Flow Graph Literal) -> Literal -> Flow Graph Literal
forall a b. (a -> b) -> a -> b
$ FloatValue -> Literal
LiteralFloat (FloatValue -> Literal) -> FloatValue -> Literal
forall a b. (a -> b) -> a -> b
$ Double -> FloatValue
FloatValueBigfloat Double
f
      Value
_ -> String -> String -> Flow Graph Literal
forall s x. String -> String -> Flow s x
unexpected String
"number" (String -> Flow Graph Literal) -> String -> Flow Graph Literal
forall a b. (a -> b) -> a -> b
$ Value -> String
forall a. Show a => a -> String
show Value
s}
  LiteralTypeInteger IntegerType
_ -> Coder {
    coderEncode :: Literal -> Flow Graph Value
coderEncode = \(LiteralInteger (IntegerValueBigint Integer
i)) -> Value -> Flow Graph Value
forall a. a -> Flow Graph a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Flow Graph Value) -> Value -> Flow Graph Value
forall a b. (a -> b) -> a -> b
$ Double -> Value
Json.ValueNumber (Double -> Value) -> Double -> Value
forall a b. (a -> b) -> a -> b
$ Integer -> Double
bigintToBigfloat Integer
i,
    coderDecode :: Value -> Flow Graph Literal
coderDecode = \Value
s -> case Value
s of
      Json.ValueNumber Double
f -> Literal -> Flow Graph Literal
forall a. a -> Flow Graph a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Literal -> Flow Graph Literal) -> Literal -> Flow Graph Literal
forall a b. (a -> b) -> a -> b
$ IntegerValue -> Literal
LiteralInteger (IntegerValue -> Literal) -> IntegerValue -> Literal
forall a b. (a -> b) -> a -> b
$ Integer -> IntegerValue
IntegerValueBigint (Integer -> IntegerValue) -> Integer -> IntegerValue
forall a b. (a -> b) -> a -> b
$ Double -> Integer
bigfloatToBigint Double
f
      Value
_ -> String -> String -> Flow Graph Literal
forall s x. String -> String -> Flow s x
unexpected String
"number" (String -> Flow Graph Literal) -> String -> Flow Graph Literal
forall a b. (a -> b) -> a -> b
$ Value -> String
forall a. Show a => a -> String
show Value
s}
  LiteralType
LiteralTypeString -> Coder {
    coderEncode :: Literal -> Flow Graph Value
coderEncode = \(LiteralString String
s) -> Value -> Flow Graph Value
forall a. a -> Flow Graph a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Flow Graph Value) -> Value -> Flow Graph Value
forall a b. (a -> b) -> a -> b
$ String -> Value
Json.ValueString String
s,
    coderDecode :: Value -> Flow Graph Literal
coderDecode = \Value
s -> case Value
s of
      Json.ValueString String
s' -> Literal -> Flow Graph Literal
forall a. a -> Flow Graph a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Literal -> Flow Graph Literal) -> Literal -> Flow Graph Literal
forall a b. (a -> b) -> a -> b
$ String -> Literal
LiteralString String
s'
      Value
_ -> String -> String -> Flow Graph Literal
forall s x. String -> String -> Flow s x
unexpected String
"string" (String -> Flow Graph Literal) -> String -> Flow Graph Literal
forall a b. (a -> b) -> a -> b
$ Value -> String
forall a. Show a => a -> String
show Value
s}

recordCoder :: RowType -> Flow Graph (Coder Graph Graph Term Json.Value)
recordCoder :: RowType -> Flow Graph (Coder Graph Graph Term Value)
recordCoder RowType
rt = do
    [(FieldType, Coder Graph Graph Term Value)]
coders <- (FieldType -> Flow Graph (FieldType, Coder Graph Graph Term Value))
-> [FieldType]
-> Flow Graph [(FieldType, Coder Graph Graph Term Value)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
CM.mapM (\FieldType
f -> (,) (FieldType
 -> Coder Graph Graph Term Value
 -> (FieldType, Coder Graph Graph Term Value))
-> Flow Graph FieldType
-> Flow
     Graph
     (Coder Graph Graph Term Value
      -> (FieldType, Coder Graph Graph Term Value))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldType -> Flow Graph FieldType
forall a. a -> Flow Graph a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FieldType
f Flow
  Graph
  (Coder Graph Graph Term Value
   -> (FieldType, Coder Graph Graph Term Value))
-> Flow Graph (Coder Graph Graph Term Value)
-> Flow Graph (FieldType, Coder Graph Graph Term Value)
forall a b. Flow Graph (a -> b) -> Flow Graph a -> Flow Graph b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type -> Flow Graph (Coder Graph Graph Term Value)
termCoder (FieldType -> Type
fieldTypeType FieldType
f)) (RowType -> [FieldType]
rowTypeFields RowType
rt)
    Coder Graph Graph Term Value
-> Flow Graph (Coder Graph Graph Term Value)
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (Coder Graph Graph Term Value
 -> Flow Graph (Coder Graph Graph Term Value))
-> Coder Graph Graph Term Value
-> Flow Graph (Coder Graph Graph Term Value)
forall a b. (a -> b) -> a -> b
$ (Term -> Flow Graph Value)
-> (Value -> Flow Graph Term) -> Coder Graph Graph Term Value
forall s1 s2 v1 v2.
(v1 -> Flow s1 v2) -> (v2 -> Flow s2 v1) -> Coder s1 s2 v1 v2
Coder ([(FieldType, Coder Graph Graph Term Value)]
-> Term -> Flow Graph Value
forall {s1} {s2}.
[(FieldType, Coder s1 s2 Term Value)] -> Term -> Flow s1 Value
encode [(FieldType, Coder Graph Graph Term Value)]
coders) ([(FieldType, Coder Graph Graph Term Value)]
-> Value -> Flow Graph Term
forall {s1} {s2}.
[(FieldType, Coder s1 s2 Term Value)] -> Value -> Flow s2 Term
decode [(FieldType, Coder Graph Graph Term Value)]
coders)
  where
    encode :: [(FieldType, Coder s1 s2 Term Value)] -> Term -> Flow s1 Value
encode [(FieldType, Coder s1 s2 Term Value)]
coders Term
term = case Term -> Term
stripTerm Term
term of
      TermRecord (Record Name
_ [Field]
fields) -> Map String Value -> Value
Json.ValueObject (Map String Value -> Value)
-> ([Maybe (String, Value)] -> Map String Value)
-> [Maybe (String, Value)]
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, Value)] -> Map String Value
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(String, Value)] -> Map String Value)
-> ([Maybe (String, Value)] -> [(String, Value)])
-> [Maybe (String, Value)]
-> Map String Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (String, Value)] -> [(String, Value)]
forall a. [Maybe a] -> [a]
Y.catMaybes ([Maybe (String, Value)] -> Value)
-> Flow s1 [Maybe (String, Value)] -> Flow s1 Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((FieldType, Coder s1 s2 Term Value)
 -> Field -> Flow s1 (Maybe (String, Value)))
-> [(FieldType, Coder s1 s2 Term Value)]
-> [Field]
-> Flow s1 [Maybe (String, Value)]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
CM.zipWithM (FieldType, Coder s1 s2 Term Value)
-> Field -> Flow s1 (Maybe (String, Value))
forall {s1} {s2} {a}.
(FieldType, Coder s1 s2 Term a)
-> Field -> Flow s1 (Maybe (String, a))
encodeField [(FieldType, Coder s1 s2 Term Value)]
coders [Field]
fields
        where
          encodeField :: (FieldType, Coder s1 s2 Term a)
-> Field -> Flow s1 (Maybe (String, a))
encodeField (FieldType
ft, Coder s1 s2 Term a
coder) (Field Name
fname Term
fv) = case (FieldType -> Type
fieldTypeType FieldType
ft, Term
fv) of
            (TypeOptional Type
_, TermOptional Maybe Term
Nothing) -> Maybe (String, a) -> Flow s1 (Maybe (String, a))
forall a. a -> Flow s1 a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (String, a)
forall a. Maybe a
Nothing
            (Type, Term)
_ -> (String, a) -> Maybe (String, a)
forall a. a -> Maybe a
Just ((String, a) -> Maybe (String, a))
-> Flow s1 (String, a) -> Flow s1 (Maybe (String, a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((,) (String -> a -> (String, a))
-> Flow s1 String -> Flow s1 (a -> (String, a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Flow s1 String
forall a. a -> Flow s1 a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> String
unName Name
fname) Flow s1 (a -> (String, a)) -> Flow s1 a -> Flow s1 (String, a)
forall a b. Flow s1 (a -> b) -> Flow s1 a -> Flow s1 b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Coder s1 s2 Term a -> Term -> Flow s1 a
forall s1 s2 v1 v2. Coder s1 s2 v1 v2 -> v1 -> Flow s1 v2
coderEncode Coder s1 s2 Term a
coder Term
fv)
      Term
_ -> String -> String -> Flow s1 Value
forall s x. String -> String -> Flow s x
unexpected String
"record" (String -> Flow s1 Value) -> String -> Flow s1 Value
forall a b. (a -> b) -> a -> b
$ Term -> String
forall a. Show a => a -> String
show Term
term
    decode :: [(FieldType, Coder s1 s2 Term Value)] -> Value -> Flow s2 Term
decode [(FieldType, Coder s1 s2 Term Value)]
coders Value
n = case Value
n of
      Json.ValueObject Map String Value
m -> Name -> [Field] -> Term
Terms.record (RowType -> Name
rowTypeTypeName RowType
rt) ([Field] -> Term) -> Flow s2 [Field] -> Flow s2 Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((FieldType, Coder s1 s2 Term Value) -> Flow s2 Field)
-> [(FieldType, Coder s1 s2 Term Value)] -> Flow s2 [Field]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
CM.mapM (Map String Value
-> (FieldType, Coder s1 s2 Term Value) -> Flow s2 Field
forall {p} {s1} {s2}.
p -> (FieldType, Coder s1 s2 Term Value) -> Flow s2 Field
decodeField Map String Value
m) [(FieldType, Coder s1 s2 Term Value)]
coders -- Note: unknown fields are ignored
        where
          decodeField :: p -> (FieldType, Coder s1 s2 Term Value) -> Flow s2 Field
decodeField p
a (FieldType Name
fname Type
_, Coder s1 s2 Term Value
coder) = do
            Term
v <- Coder s1 s2 Term Value -> Value -> Flow s2 Term
forall s1 s2 v1 v2. Coder s1 s2 v1 v2 -> v2 -> Flow s2 v1
coderDecode Coder s1 s2 Term Value
coder (Value -> Flow s2 Term) -> Value -> Flow s2 Term
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Value -> Value
forall a. a -> Maybe a -> a
Y.fromMaybe Value
Json.ValueNull (Maybe Value -> Value) -> Maybe Value -> Value
forall a b. (a -> b) -> a -> b
$ String -> Map String Value -> Maybe Value
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Name -> String
unName Name
fname) Map String Value
m
            Field -> Flow s2 Field
forall a. a -> Flow s2 a
forall (m :: * -> *) a. Monad m => a -> m a
return (Field -> Flow s2 Field) -> Field -> Flow s2 Field
forall a b. (a -> b) -> a -> b
$ Name -> Term -> Field
Field Name
fname Term
v
      Value
_ -> String -> String -> Flow s2 Term
forall s x. String -> String -> Flow s x
unexpected String
"mapping" (String -> Flow s2 Term) -> String -> Flow s2 Term
forall a b. (a -> b) -> a -> b
$ Value -> String
forall a. Show a => a -> String
show Value
n
    getCoder :: Map String a -> String -> m a
getCoder Map String a
coders String
fname = m a -> (a -> m a) -> Maybe a -> m a
forall b a. b -> (a -> b) -> Maybe a -> b
Y.maybe m a
forall {a}. m a
error a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> m a) -> Maybe a -> m a
forall a b. (a -> b) -> a -> b
$ String -> Map String a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
fname Map String a
coders
      where
        error :: m a
error = String -> m a
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ String
"no such field: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fname

termCoder :: Type -> Flow Graph (Coder Graph Graph Term Json.Value)
termCoder :: Type -> Flow Graph (Coder Graph Graph Term Value)
termCoder Type
typ = case Type -> Type
stripType Type
typ of
  TypeLiteral LiteralType
at -> do
    Coder Graph Graph Literal Value
ac <- LiteralType -> Flow Graph (Coder Graph Graph Literal Value)
literalJsonCoder LiteralType
at
    Coder Graph Graph Term Value
-> Flow Graph (Coder Graph Graph Term Value)
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return Coder {
      coderEncode :: Term -> Flow Graph Value
coderEncode = \(TermLiteral Literal
av) -> Coder Graph Graph Literal Value -> Literal -> Flow Graph Value
forall s1 s2 v1 v2. Coder s1 s2 v1 v2 -> v1 -> Flow s1 v2
coderEncode Coder Graph Graph Literal Value
ac Literal
av,
      coderDecode :: Value -> Flow Graph Term
coderDecode = \Value
n -> case Value
n of
        Value
s -> Literal -> Term
Terms.literal (Literal -> Term) -> Flow Graph Literal -> Flow Graph Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Coder Graph Graph Literal Value -> Value -> Flow Graph Literal
forall s1 s2 v1 v2. Coder s1 s2 v1 v2 -> v2 -> Flow s2 v1
coderDecode Coder Graph Graph Literal Value
ac Value
s}
  TypeList Type
lt -> do
    Coder Graph Graph Term Value
lc <- Type -> Flow Graph (Coder Graph Graph Term Value)
termCoder Type
lt
    Coder Graph Graph Term Value
-> Flow Graph (Coder Graph Graph Term Value)
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return Coder {
      coderEncode :: Term -> Flow Graph Value
coderEncode = \(TermList [Term]
els) -> [Value] -> Value
Json.ValueArray ([Value] -> Value) -> Flow Graph [Value] -> Flow Graph Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Term -> Flow Graph Value) -> [Term] -> Flow Graph [Value]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
CM.mapM (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
lc) [Term]
els,
      coderDecode :: Value -> Flow Graph Term
coderDecode = \Value
n -> case Value
n of
        Json.ValueArray [Value]
nodes -> [Term] -> Term
Terms.list ([Term] -> Term) -> Flow Graph [Term] -> Flow Graph Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Flow Graph Term) -> [Value] -> Flow Graph [Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
CM.mapM (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
lc) [Value]
nodes
        Value
_ -> String -> String -> Flow Graph Term
forall s x. String -> String -> Flow s x
unexpected String
"sequence" (String -> Flow Graph Term) -> String -> Flow Graph Term
forall a b. (a -> b) -> a -> b
$ Value -> String
forall a. Show a => a -> String
show Value
n}
  TypeOptional Type
ot -> do
    Coder Graph Graph Term Value
oc <- Type -> Flow Graph (Coder Graph Graph Term Value)
termCoder Type
ot
    Coder Graph Graph Term Value
-> Flow Graph (Coder Graph Graph Term Value)
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return Coder {
      coderEncode :: Term -> Flow Graph Value
coderEncode = \Term
t -> case Term
t of
        TermOptional Maybe Term
el -> Flow Graph Value
-> (Term -> Flow Graph Value) -> Maybe Term -> Flow Graph Value
forall b a. b -> (a -> b) -> Maybe a -> b
Y.maybe (Value -> Flow Graph Value
forall a. a -> Flow Graph a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
Json.ValueNull) (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
oc) Maybe Term
el
        Term
_ -> String -> String -> Flow Graph Value
forall s x. String -> String -> Flow s x
unexpected String
"optional term" (String -> Flow Graph Value) -> String -> Flow Graph Value
forall a b. (a -> b) -> a -> b
$ Term -> String
forall a. Show a => a -> String
show Term
t,
      coderDecode :: Value -> Flow Graph Term
coderDecode = \Value
n -> case Value
n of
        Value
Json.ValueNull -> Term -> Flow Graph Term
forall a. a -> Flow Graph a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term -> Flow Graph Term) -> Term -> Flow Graph Term
forall a b. (a -> b) -> a -> b
$ Maybe Term -> Term
Terms.optional Maybe Term
forall a. Maybe a
Nothing
        Value
_ -> Maybe Term -> Term
Terms.optional (Maybe Term -> Term) -> (Term -> Maybe Term) -> Term -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Maybe Term
forall a. a -> Maybe a
Just (Term -> Term) -> Flow Graph Term -> Flow Graph Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
oc Value
n}
  TypeMap (MapType Type
kt Type
vt) -> do
      Coder Graph Graph Term Value
kc <- Type -> Flow Graph (Coder Graph Graph Term Value)
termCoder Type
kt
      Coder Graph Graph Term Value
vc <- Type -> Flow Graph (Coder Graph Graph Term Value)
termCoder Type
vt
      Graph
cx <- Flow Graph Graph
forall s. Flow s s
getState
      let encodeEntry :: (Term, Term) -> Flow Graph (String, Value)
encodeEntry (Term
k, Term
v) = (,) (Graph -> Term -> String
forall {p}. p -> Term -> String
toString Graph
cx Term
k) (Value -> (String, Value))
-> Flow Graph Value -> Flow Graph (String, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
vc Term
v
      let decodeEntry :: (String, Value) -> Flow Graph (Term, Term)
decodeEntry (String
k, Value
v) = (,) (Graph -> String -> Term
forall {p}. p -> String -> Term
fromString Graph
cx String
k) (Term -> (Term, Term))
-> Flow Graph Term -> Flow Graph (Term, Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
vc Value
v
      Coder Graph Graph Term Value
-> Flow Graph (Coder Graph Graph Term Value)
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return Coder {
        coderEncode :: Term -> Flow Graph Value
coderEncode = \(TermMap Map Term Term
m) -> Map String Value -> Value
Json.ValueObject (Map String Value -> Value)
-> ([(String, Value)] -> Map String Value)
-> [(String, Value)]
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, Value)] -> Map String Value
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(String, Value)] -> Value)
-> Flow Graph [(String, Value)] -> Flow Graph Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Term, Term) -> Flow Graph (String, Value))
-> [(Term, Term)] -> Flow Graph [(String, Value)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
CM.mapM (Term, Term) -> Flow Graph (String, Value)
encodeEntry (Map Term Term -> [(Term, Term)]
forall k a. Map k a -> [(k, a)]
M.toList Map Term Term
m),
        coderDecode :: Value -> Flow Graph Term
coderDecode = \Value
n -> case Value
n of
          Json.ValueObject Map String Value
m -> Map Term Term -> Term
Terms.map (Map Term Term -> Term)
-> ([(Term, Term)] -> Map Term Term) -> [(Term, Term)] -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Term, Term)] -> Map Term Term
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Term, Term)] -> Term)
-> Flow Graph [(Term, Term)] -> Flow Graph Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((String, Value) -> Flow Graph (Term, Term))
-> [(String, Value)] -> Flow Graph [(Term, Term)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
CM.mapM (String, Value) -> Flow Graph (Term, Term)
decodeEntry (Map String Value -> [(String, Value)]
forall k a. Map k a -> [(k, a)]
M.toList Map String Value
m)
          Value
_ -> String -> String -> Flow Graph Term
forall s x. String -> String -> Flow s x
unexpected String
"mapping" (String -> Flow Graph Term) -> String -> Flow Graph Term
forall a b. (a -> b) -> a -> b
$ Value -> String
forall a. Show a => a -> String
show Value
n}
    where
      toString :: p -> Term -> String
toString p
cx Term
v = if p -> Bool
forall {p}. p -> Bool
isStringKey p
cx
        then case Term -> Term
stripTerm Term
v of
          TermLiteral (LiteralString String
s) -> String
s
        else Term -> String
forall a. Show a => a -> String
show Term
v
      fromString :: p -> String -> Term
fromString p
cx String
s = String -> Term
Terms.string (String -> Term) -> String -> Term
forall a b. (a -> b) -> a -> b
$ if p -> Bool
forall {p}. p -> Bool
isStringKey p
cx then String
s else String -> String
forall a. Read a => String -> a
read String
s
      isStringKey :: p -> Bool
isStringKey p
cx = Type -> Type
stripType Type
kt Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
== Type
Types.string
  TypeRecord RowType
rt -> RowType -> Flow Graph (Coder Graph Graph Term Value)
recordCoder RowType
rt
  TypeVariable Name
name -> Coder Graph Graph Term Value
-> Flow Graph (Coder Graph Graph Term Value)
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (Coder Graph Graph Term Value
 -> Flow Graph (Coder Graph Graph Term Value))
-> Coder Graph Graph Term Value
-> Flow Graph (Coder Graph Graph Term Value)
forall a b. (a -> b) -> a -> b
$ (Term -> Flow Graph Value)
-> (Value -> Flow Graph Term) -> Coder Graph Graph Term Value
forall s1 s2 v1 v2.
(v1 -> Flow s1 v2) -> (v2 -> Flow s2 v1) -> Coder s1 s2 v1 v2
Coder Term -> Flow Graph Value
forall {f :: * -> *} {a}. (Applicative f, Show a) => a -> f Value
encode Value -> Flow Graph Term
forall {m :: * -> *} {p} {a}. MonadFail m => p -> m a
decode
    where
      encode :: a -> f Value
encode a
term = Value -> f Value
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> f Value) -> Value -> f Value
forall a b. (a -> b) -> a -> b
$ String -> Value
Json.ValueString (String -> Value) -> String -> Value
forall a b. (a -> b) -> a -> b
$ String
"variable '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
unName Name
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' for: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
term
      decode :: p -> m a
decode p
term = String -> m a
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ String
"type variable " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
unName Name
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" does not support decoding"
  Type
_ -> String -> Flow Graph (Coder Graph Graph Term Value)
forall a. String -> Flow Graph a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Flow Graph (Coder Graph Graph Term Value))
-> String -> Flow Graph (Coder Graph Graph Term Value)
forall a b. (a -> b) -> a -> b
$ String
"unsupported type in JSON: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ TypeVariant -> String
forall a. Show a => a -> String
show (Type -> TypeVariant
typeVariant Type
typ)

-- | A simplistic, unidirectional encoding for terms as JSON values. Not type-aware; best used for human consumption.
untypedTermToJson :: Term -> Flow s Json.Value
untypedTermToJson :: forall s. Term -> Flow s Value
untypedTermToJson Term
term = case Term -> Term
stripTerm Term
term of
    TermApplication (Application Term
lhs Term
rhs) -> [Field] -> Flow s Value
forall {s}. [Field] -> Flow s Value
asRecord [
      Name -> Term -> Field
Field Name
_Application_function Term
lhs,
      Name -> Term -> Field
Field Name
_Application_argument Term
rhs]
    TermFunction Function
f -> case Function
f of
      FunctionElimination Elimination
elm -> case Elimination
elm of
        EliminationList Term
term1 -> String -> Term -> Flow s Value
forall {s}. String -> Term -> Flow s Value
asVariant String
"fold" Term
term1
        EliminationRecord (Projection Name
_ Name
fname) -> String -> Term -> Flow s Value
forall {s}. String -> Term -> Flow s Value
asVariant String
"project" (Term -> Flow s Value) -> Term -> Flow s Value
forall a b. (a -> b) -> a -> b
$ Name -> Term
TermVariable Name
fname
        Elimination
_ -> String -> Flow s Value
forall {f :: * -> *}. Applicative f => String -> f Value
unexp (String -> Flow s Value) -> String -> Flow s Value
forall a b. (a -> b) -> a -> b
$ String
"unexpected elimination variant: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ EliminationVariant -> String
forall a. Show a => a -> String
show (Elimination -> EliminationVariant
eliminationVariant Elimination
elm)
      FunctionLambda (Lambda Name
v Term
body) -> [Field] -> Flow s Value
forall {s}. [Field] -> Flow s Value
asRecord [
        Name -> Term -> Field
Field Name
_Lambda_parameter (Term -> Field) -> Term -> Field
forall a b. (a -> b) -> a -> b
$ Name -> Term
TermVariable Name
v,
        Name -> Term -> Field
Field Name
_Lambda_body Term
body]
      FunctionPrimitive Name
name -> Value -> Flow s Value
forall a. a -> Flow s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Flow s Value) -> Value -> Flow s Value
forall a b. (a -> b) -> a -> b
$ String -> Value
Json.ValueString (String -> Value) -> String -> Value
forall a b. (a -> b) -> a -> b
$ Name -> String
unName Name
name
    TermLet (Let [LetBinding]
bindings Term
env) -> [Field] -> Flow s Value
forall {s}. [Field] -> Flow s Value
asRecord [
        Name -> Term -> Field
Field Name
_Let_bindings (Term -> Field) -> Term -> Field
forall a b. (a -> b) -> a -> b
$ Record -> Term
TermRecord (Record -> Term) -> Record -> Term
forall a b. (a -> b) -> a -> b
$ Name -> [Field] -> Record
Record (String -> Name
Name String
"") (LetBinding -> Field
fromBinding (LetBinding -> Field) -> [LetBinding] -> [Field]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LetBinding]
bindings),
        Name -> Term -> Field
Field Name
_Let_environment Term
env]
      where
        fromBinding :: LetBinding -> Field
fromBinding (LetBinding Name
k Term
v Maybe TypeScheme
_) = Name -> Term -> Field
Field Name
k Term
v
    TermList [Term]
terms -> [Value] -> Value
Json.ValueArray ([Value] -> Value) -> Flow s [Value] -> Flow s Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Term -> Flow s Value) -> [Term] -> Flow s [Value]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
CM.mapM Term -> Flow s Value
forall s. Term -> Flow s Value
untypedTermToJson [Term]
terms)
    TermLiteral Literal
lit -> Value -> Flow s Value
forall a. a -> Flow s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Flow s Value) -> Value -> Flow s Value
forall a b. (a -> b) -> a -> b
$ case Literal
lit of
      LiteralBinary String
s -> String -> Value
Json.ValueString String
s
      LiteralBoolean Bool
b -> Bool -> Value
Json.ValueBoolean Bool
b
      LiteralFloat FloatValue
f -> Double -> Value
Json.ValueNumber (Double -> Value) -> Double -> Value
forall a b. (a -> b) -> a -> b
$ FloatValue -> Double
floatValueToBigfloat FloatValue
f
      LiteralInteger IntegerValue
i -> Double -> Value
Json.ValueNumber (Double -> Value) -> Double -> Value
forall a b. (a -> b) -> a -> b
$ Integer -> Double
bigintToBigfloat (Integer -> Double) -> Integer -> Double
forall a b. (a -> b) -> a -> b
$ IntegerValue -> Integer
integerValueToBigint IntegerValue
i
      LiteralString String
s -> String -> Value
Json.ValueString String
s
    TermOptional Maybe Term
mt -> case Maybe Term
mt of
      Maybe Term
Nothing -> Value -> Flow s Value
forall a. a -> Flow s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
Json.ValueNull
      Just Term
t -> Term -> Flow s Value
forall s. Term -> Flow s Value
untypedTermToJson Term
t
    TermProduct [Term]
els -> Term -> Flow s Value
forall s. Term -> Flow s Value
untypedTermToJson (Term -> Flow s Value) -> Term -> Flow s Value
forall a b. (a -> b) -> a -> b
$ [Term] -> Term
TermList [Term]
els
    TermRecord (Record Name
_ [Field]
fields) -> do
      [Maybe (String, Value)]
keyvals <- (Field -> Flow s (Maybe (String, Value)))
-> [Field] -> Flow s [Maybe (String, Value)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
CM.mapM Field -> Flow s (Maybe (String, Value))
forall {s}. Field -> Flow s (Maybe (String, Value))
fieldToKeyval [Field]
fields
      Value -> Flow s Value
forall a. a -> Flow s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> Flow s Value) -> Value -> Flow s Value
forall a b. (a -> b) -> a -> b
$ 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 ([(String, Value)] -> Map String Value)
-> [(String, Value)] -> Map String Value
forall a b. (a -> b) -> a -> b
$ [Maybe (String, Value)] -> [(String, Value)]
forall a. [Maybe a] -> [a]
Y.catMaybes [Maybe (String, Value)]
keyvals
    TermSet Set Term
vals -> Term -> Flow s Value
forall s. Term -> Flow s Value
untypedTermToJson (Term -> Flow s Value) -> Term -> Flow s Value
forall a b. (a -> b) -> a -> b
$ [Term] -> Term
TermList ([Term] -> Term) -> [Term] -> Term
forall a b. (a -> b) -> a -> b
$ Set Term -> [Term]
forall a. Set a -> [a]
S.toList Set Term
vals
    TermSum (Sum Int
idx Int
size Term
term1) -> [Field] -> Flow s Value
forall {s}. [Field] -> Flow s Value
asRecord [
      Name -> Term -> Field
Field Name
_Sum_index (Term -> Field) -> Term -> Field
forall a b. (a -> b) -> a -> b
$ Literal -> Term
TermLiteral (Literal -> Term) -> Literal -> Term
forall a b. (a -> b) -> a -> b
$ IntegerValue -> Literal
LiteralInteger (IntegerValue -> Literal) -> IntegerValue -> Literal
forall a b. (a -> b) -> a -> b
$ Int -> IntegerValue
IntegerValueInt32 Int
idx,
      Name -> Term -> Field
Field Name
_Sum_size (Term -> Field) -> Term -> Field
forall a b. (a -> b) -> a -> b
$ Literal -> Term
TermLiteral (Literal -> Term) -> Literal -> Term
forall a b. (a -> b) -> a -> b
$ IntegerValue -> Literal
LiteralInteger (IntegerValue -> Literal) -> IntegerValue -> Literal
forall a b. (a -> b) -> a -> b
$ Int -> IntegerValue
IntegerValueInt32 Int
size,
      Name -> Term -> Field
Field Name
_Sum_term Term
term1]
    TermTyped (TypedTerm Term
term1 Type
typ) -> [Field] -> Flow s Value
forall {s}. [Field] -> Flow s Value
asRecord [
      Name -> Term -> Field
Field Name
_TypedTerm_term Term
term1,
      Name -> Term -> Field
Field Name
_TypedTerm_type (Term -> Field) -> Term -> Field
forall a b. (a -> b) -> a -> b
$ Type -> Term
coreEncodeType Type
typ]
    TermUnion (Injection Name
_ Field
field) -> if Field -> Term
fieldTerm Field
field Term -> Term -> Bool
forall a. Eq a => a -> a -> Bool
== Term
Terms.unit
      then Value -> Flow s Value
forall a. a -> Flow s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> Flow s Value) -> Value -> Flow s Value
forall a b. (a -> b) -> a -> b
$ String -> Value
Json.ValueString (String -> Value) -> String -> Value
forall a b. (a -> b) -> a -> b
$ Name -> String
unName (Name -> String) -> Name -> String
forall a b. (a -> b) -> a -> b
$ Field -> Name
fieldName Field
field
      else do
        Maybe (String, Value)
mkeyval <- Field -> Flow s (Maybe (String, Value))
forall {s}. Field -> Flow s (Maybe (String, Value))
fieldToKeyval Field
field
        Value -> Flow s Value
forall a. a -> Flow s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> Flow s Value) -> Value -> Flow s Value
forall a b. (a -> b) -> a -> b
$ 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 ([(String, Value)] -> Map String Value)
-> [(String, Value)] -> Map String Value
forall a b. (a -> b) -> a -> b
$ case Maybe (String, Value)
mkeyval of
          Maybe (String, Value)
Nothing -> []
          Just (String, Value)
keyval -> [(String, Value)
keyval]
    TermVariable Name
v -> Value -> Flow s Value
forall a. a -> Flow s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Flow s Value) -> Value -> Flow s Value
forall a b. (a -> b) -> a -> b
$ String -> Value
Json.ValueString (String -> Value) -> String -> Value
forall a b. (a -> b) -> a -> b
$ Name -> String
unName Name
v
    TermWrap (WrappedTerm Name
_ Term
t) -> Term -> Flow s Value
forall s. Term -> Flow s Value
untypedTermToJson Term
t
    Term
t -> String -> Flow s Value
forall {f :: * -> *}. Applicative f => String -> f Value
unexp (String -> Flow s Value) -> String -> Flow s Value
forall a b. (a -> b) -> a -> b
$ String
"unsupported term variant: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ TermVariant -> String
forall a. Show a => a -> String
show (Term -> TermVariant
termVariant Term
t)
--     t -> fail $ "unexpected term variant: " ++ show (termVariant t)
  where
    unexp :: String -> f Value
unexp String
msg = Value -> f Value
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> f Value) -> Value -> f Value
forall a b. (a -> b) -> a -> b
$ String -> Value
Json.ValueString (String -> Value) -> String -> Value
forall a b. (a -> b) -> a -> b
$ String
"FAIL: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg
    asRecord :: [Field] -> Flow s Value
asRecord = Term -> Flow s Value
forall s. Term -> Flow s Value
untypedTermToJson (Term -> Flow s Value)
-> ([Field] -> Term) -> [Field] -> Flow s Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Record -> Term
TermRecord (Record -> Term) -> ([Field] -> Record) -> [Field] -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> [Field] -> Record
Record (String -> Name
Name String
"")
    asVariant :: String -> Term -> Flow s Value
asVariant String
name Term
term = Term -> Flow s Value
forall s. Term -> Flow s Value
untypedTermToJson (Term -> Flow s Value) -> Term -> Flow s Value
forall a b. (a -> b) -> a -> b
$ Injection -> Term
TermUnion (Injection -> Term) -> Injection -> Term
forall a b. (a -> b) -> a -> b
$ Name -> Field -> Injection
Injection (String -> Name
Name String
"") (Field -> Injection) -> Field -> Injection
forall a b. (a -> b) -> a -> b
$ Name -> Term -> Field
Field (String -> Name
Name String
name) Term
term
    fieldToKeyval :: Field -> Flow s (Maybe (String, Value))
fieldToKeyval Field
f = do
        Maybe Value
mjson <- Term -> Flow s (Maybe Value)
forall {s}. Term -> Flow s (Maybe Value)
forTerm (Term -> Flow s (Maybe Value)) -> Term -> Flow s (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Field -> Term
fieldTerm Field
f
        Maybe (String, Value) -> Flow s (Maybe (String, Value))
forall a. a -> Flow s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (String, Value) -> Flow s (Maybe (String, Value)))
-> Maybe (String, Value) -> Flow s (Maybe (String, Value))
forall a b. (a -> b) -> a -> b
$ case Maybe Value
mjson of
          Maybe Value
Nothing -> Maybe (String, Value)
forall a. Maybe a
Nothing
          Just Value
j -> (String, Value) -> Maybe (String, Value)
forall a. a -> Maybe a
Just (Name -> String
unName (Name -> String) -> Name -> String
forall a b. (a -> b) -> a -> b
$ Field -> Name
fieldName Field
f, Value
j)
      where
        forTerm :: Term -> Flow s (Maybe Value)
forTerm Term
t = case Term
t of
          TermOptional Maybe Term
mt -> case Maybe Term
mt of
            Maybe Term
Nothing -> Maybe Value -> Flow s (Maybe Value)
forall a. a -> Flow s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Value
forall a. Maybe a
Nothing
            Just Term
t' -> Term -> Flow s (Maybe Value)
forTerm Term
t'
          Term
t' -> Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Flow s Value -> Flow s (Maybe Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> Flow s Value
forall s. Term -> Flow s Value
untypedTermToJson Term
t'