{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskellQuotes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.Types.Internal.AST.Value
  ( Value (..),
    ScalarValue (..),
    Object,
    replaceValue,
    decodeScientific,
    RawValue,
    ValidValue,
    RawObject,
    ValidObject,
    Variable (..),
    ResolvedValue,
    ResolvedObject,
    VariableContent (..),
    ObjectEntry (..),
    VariableDefinitions,
  )
where

-- MORPHEUS
import qualified Data.Aeson as A
  ( FromJSON (..),
    ToJSON (..),
    Value (..),
    object,
    pairs,
    (.=),
  )
import Data.Foldable (foldr')
import Data.Mergeable
  ( NameCollision (..),
    OrdMap,
  )
import Data.Morpheus.Internal.Utils
  ( KeyOf (..),
    toAssoc,
    unsafeFromList,
  )
import Data.Morpheus.Rendering.RenderGQL
  ( RenderGQL (..),
    fromText,
    render,
    renderInputSeq,
    space,
  )
import Data.Morpheus.Types.Internal.AST.Base
  ( Position,
    Ref (..),
  )
import Data.Morpheus.Types.Internal.AST.Error
  ( GQLError,
    Msg (..),
    at,
  )
import Data.Morpheus.Types.Internal.AST.Name
  ( FieldName,
    TypeName,
    packName,
    unpackName,
  )
import Data.Morpheus.Types.Internal.AST.Stage
  ( CONST,
    CONST_OR_VALID,
    RAW,
    Stage,
    VALID,
  )
import Data.Morpheus.Types.Internal.AST.Type (TypeRef (..))
import Data.Scientific
  ( Scientific,
    floatingOrInteger,
  )
import qualified Data.Text as T
import qualified Data.Vector as V
import Instances.TH.Lift ()
import Language.Haskell.TH.Syntax (Lift (..))
import Relude

-- | Primitive Values for GQLScalar: 'Int', 'Float', 'String', 'Boolean'.
-- for performance reason type 'Text' represents GraphQl 'String' value
data ScalarValue
  = Int Int
  | Float Double
  | String Text
  | Boolean Bool
  | Value A.Value
  deriving (Int -> ScalarValue -> ShowS
[ScalarValue] -> ShowS
ScalarValue -> String
(Int -> ScalarValue -> ShowS)
-> (ScalarValue -> String)
-> ([ScalarValue] -> ShowS)
-> Show ScalarValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScalarValue -> ShowS
showsPrec :: Int -> ScalarValue -> ShowS
$cshow :: ScalarValue -> String
show :: ScalarValue -> String
$cshowList :: [ScalarValue] -> ShowS
showList :: [ScalarValue] -> ShowS
Show, ScalarValue -> ScalarValue -> Bool
(ScalarValue -> ScalarValue -> Bool)
-> (ScalarValue -> ScalarValue -> Bool) -> Eq ScalarValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScalarValue -> ScalarValue -> Bool
== :: ScalarValue -> ScalarValue -> Bool
$c/= :: ScalarValue -> ScalarValue -> Bool
/= :: ScalarValue -> ScalarValue -> Bool
Eq, (forall x. ScalarValue -> Rep ScalarValue x)
-> (forall x. Rep ScalarValue x -> ScalarValue)
-> Generic ScalarValue
forall x. Rep ScalarValue x -> ScalarValue
forall x. ScalarValue -> Rep ScalarValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ScalarValue -> Rep ScalarValue x
from :: forall x. ScalarValue -> Rep ScalarValue x
$cto :: forall x. Rep ScalarValue x -> ScalarValue
to :: forall x. Rep ScalarValue x -> ScalarValue
Generic, (forall (m :: * -> *). Quote m => ScalarValue -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    ScalarValue -> Code m ScalarValue)
-> Lift ScalarValue
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => ScalarValue -> m Exp
forall (m :: * -> *). Quote m => ScalarValue -> Code m ScalarValue
$clift :: forall (m :: * -> *). Quote m => ScalarValue -> m Exp
lift :: forall (m :: * -> *). Quote m => ScalarValue -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => ScalarValue -> Code m ScalarValue
liftTyped :: forall (m :: * -> *). Quote m => ScalarValue -> Code m ScalarValue
Lift)

instance IsString ScalarValue where
  fromString :: String -> ScalarValue
fromString = Text -> ScalarValue
String (Text -> ScalarValue) -> (String -> Text) -> String -> ScalarValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

instance RenderGQL ScalarValue where
  renderGQL :: ScalarValue -> Rendering
renderGQL (Int Int
x) = Int -> Rendering
forall a. RenderGQL a => a -> Rendering
renderGQL Int
x
  renderGQL (Float Double
x) = Double -> Rendering
forall a. RenderGQL a => a -> Rendering
renderGQL Double
x
  renderGQL (String Text
x) = Text -> Rendering
forall a. RenderGQL a => a -> Rendering
renderGQL Text
x
  renderGQL (Boolean Bool
x) = Bool -> Rendering
forall a. RenderGQL a => a -> Rendering
renderGQL Bool
x
  renderGQL (Value Value
x) = Value -> Rendering
forall a. RenderGQL a => a -> Rendering
renderGQL Value
x

instance A.ToJSON ScalarValue where
  toJSON :: ScalarValue -> Value
toJSON (Float Double
x) = Double -> Value
forall a. ToJSON a => a -> Value
A.toJSON Double
x
  toJSON (Int Int
x) = Int -> Value
forall a. ToJSON a => a -> Value
A.toJSON Int
x
  toJSON (Boolean Bool
x) = Bool -> Value
forall a. ToJSON a => a -> Value
A.toJSON Bool
x
  toJSON (String Text
x) = Text -> Value
forall a. ToJSON a => a -> Value
A.toJSON Text
x
  toJSON (Value Value
x) = Value -> Value
forall a. ToJSON a => a -> Value
A.toJSON Value
x

instance A.FromJSON ScalarValue where
  parseJSON :: Value -> Parser ScalarValue
parseJSON (A.Bool Bool
v) = ScalarValue -> Parser ScalarValue
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ScalarValue -> Parser ScalarValue)
-> ScalarValue -> Parser ScalarValue
forall a b. (a -> b) -> a -> b
$ Bool -> ScalarValue
Boolean Bool
v
  parseJSON (A.Number Scientific
v) = ScalarValue -> Parser ScalarValue
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ScalarValue -> Parser ScalarValue)
-> ScalarValue -> Parser ScalarValue
forall a b. (a -> b) -> a -> b
$ Scientific -> ScalarValue
decodeScientific Scientific
v
  parseJSON (A.String Text
v) = ScalarValue -> Parser ScalarValue
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ScalarValue -> Parser ScalarValue)
-> ScalarValue -> Parser ScalarValue
forall a b. (a -> b) -> a -> b
$ Text -> ScalarValue
String Text
v
  parseJSON Value
notScalar = String -> Parser ScalarValue
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ScalarValue) -> String -> Parser ScalarValue
forall a b. (a -> b) -> a -> b
$ String
"Expected Scalar got :" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Value -> String
forall b a. (Show a, IsString b) => a -> b
show Value
notScalar

data VariableContent (stage :: Stage) where
  DefaultValue :: Maybe ResolvedValue -> VariableContent CONST
  ValidVariableValue :: {VariableContent VALID -> ValidValue
validVarContent :: ValidValue} -> VariableContent VALID

instance Lift (VariableContent a) where
  lift :: forall (m :: * -> *). Quote m => VariableContent a -> m Exp
lift (DefaultValue Maybe ResolvedValue
x) = [|DefaultValue x|]
  lift (ValidVariableValue ValidValue
x) = [|ValidVariableValue x|]

#if MIN_VERSION_template_haskell(2,16,0)
  liftTyped :: forall (m :: * -> *).
Quote m =>
VariableContent a -> Code m (VariableContent a)
liftTyped (DefaultValue Maybe ResolvedValue
x) = [||Maybe ResolvedValue -> VariableContent 'CONST
DefaultValue Maybe ResolvedValue
x||]
  liftTyped (ValidVariableValue ValidValue
x) = [||ValidValue -> VariableContent VALID
ValidVariableValue ValidValue
x||]
#endif
deriving instance Show (VariableContent a)

deriving instance Eq (VariableContent a)

data Variable (stage :: Stage) = Variable
  { forall (stage :: Stage). Variable stage -> Position
variablePosition :: Position,
    forall (stage :: Stage). Variable stage -> FieldName
variableName :: FieldName,
    forall (stage :: Stage). Variable stage -> TypeRef
variableType :: TypeRef,
    forall (stage :: Stage).
Variable stage -> VariableContent (CONST_OR_VALID stage)
variableValue :: VariableContent (CONST_OR_VALID stage)
  }
  deriving (Int -> Variable stage -> ShowS
[Variable stage] -> ShowS
Variable stage -> String
(Int -> Variable stage -> ShowS)
-> (Variable stage -> String)
-> ([Variable stage] -> ShowS)
-> Show (Variable stage)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (stage :: Stage). Int -> Variable stage -> ShowS
forall (stage :: Stage). [Variable stage] -> ShowS
forall (stage :: Stage). Variable stage -> String
$cshowsPrec :: forall (stage :: Stage). Int -> Variable stage -> ShowS
showsPrec :: Int -> Variable stage -> ShowS
$cshow :: forall (stage :: Stage). Variable stage -> String
show :: Variable stage -> String
$cshowList :: forall (stage :: Stage). [Variable stage] -> ShowS
showList :: [Variable stage] -> ShowS
Show, Variable stage -> Variable stage -> Bool
(Variable stage -> Variable stage -> Bool)
-> (Variable stage -> Variable stage -> Bool)
-> Eq (Variable stage)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (stage :: Stage). Variable stage -> Variable stage -> Bool
$c== :: forall (stage :: Stage). Variable stage -> Variable stage -> Bool
== :: Variable stage -> Variable stage -> Bool
$c/= :: forall (stage :: Stage). Variable stage -> Variable stage -> Bool
/= :: Variable stage -> Variable stage -> Bool
Eq, (forall (m :: * -> *). Quote m => Variable stage -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    Variable stage -> Code m (Variable stage))
-> Lift (Variable stage)
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (stage :: Stage) (m :: * -> *).
Quote m =>
Variable stage -> m Exp
forall (stage :: Stage) (m :: * -> *).
Quote m =>
Variable stage -> Code m (Variable stage)
forall (m :: * -> *). Quote m => Variable stage -> m Exp
forall (m :: * -> *).
Quote m =>
Variable stage -> Code m (Variable stage)
$clift :: forall (stage :: Stage) (m :: * -> *).
Quote m =>
Variable stage -> m Exp
lift :: forall (m :: * -> *). Quote m => Variable stage -> m Exp
$cliftTyped :: forall (stage :: Stage) (m :: * -> *).
Quote m =>
Variable stage -> Code m (Variable stage)
liftTyped :: forall (m :: * -> *).
Quote m =>
Variable stage -> Code m (Variable stage)
Lift)

instance KeyOf FieldName (Variable s) where
  keyOf :: Variable s -> FieldName
keyOf = Variable s -> FieldName
forall (stage :: Stage). Variable stage -> FieldName
variableName

instance NameCollision GQLError (Variable s) where
  nameCollision :: Variable s -> GQLError
nameCollision Variable {FieldName
variableName :: forall (stage :: Stage). Variable stage -> FieldName
variableName :: FieldName
variableName, Position
variablePosition :: forall (stage :: Stage). Variable stage -> Position
variablePosition :: Position
variablePosition} =
    (GQLError
"There can Be only One Variable Named " GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> FieldName -> GQLError
forall a. Msg a => a -> GQLError
msg FieldName
variableName)
      GQLError -> Position -> GQLError
`at` Position
variablePosition

type VariableDefinitions s = OrdMap FieldName (Variable s)

data Value (stage :: Stage) where
  ResolvedVariable :: Ref FieldName -> Variable VALID -> Value CONST
  VariableValue :: Ref FieldName -> Value RAW
  Object :: Object stage -> Value stage
  List :: [Value stage] -> Value stage
  Enum :: TypeName -> Value stage
  Scalar :: ScalarValue -> Value stage
  Null :: Value stage

instance IsString (Value stage) where
  fromString :: String -> Value stage
fromString = ScalarValue -> Value stage
forall (stage :: Stage). ScalarValue -> Value stage
Scalar (ScalarValue -> Value stage)
-> (String -> ScalarValue) -> String -> Value stage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ScalarValue
forall a. IsString a => String -> a
fromString

deriving instance Show (Value a)

deriving instance Eq (Value s)

data ObjectEntry (s :: Stage) = ObjectEntry
  { forall (s :: Stage). ObjectEntry s -> FieldName
entryName :: FieldName,
    forall (s :: Stage). ObjectEntry s -> Value s
entryValue :: Value s
  }
  deriving (ObjectEntry s -> ObjectEntry s -> Bool
(ObjectEntry s -> ObjectEntry s -> Bool)
-> (ObjectEntry s -> ObjectEntry s -> Bool) -> Eq (ObjectEntry s)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (s :: Stage). ObjectEntry s -> ObjectEntry s -> Bool
$c== :: forall (s :: Stage). ObjectEntry s -> ObjectEntry s -> Bool
== :: ObjectEntry s -> ObjectEntry s -> Bool
$c/= :: forall (s :: Stage). ObjectEntry s -> ObjectEntry s -> Bool
/= :: ObjectEntry s -> ObjectEntry s -> Bool
Eq, Int -> ObjectEntry s -> ShowS
[ObjectEntry s] -> ShowS
ObjectEntry s -> String
(Int -> ObjectEntry s -> ShowS)
-> (ObjectEntry s -> String)
-> ([ObjectEntry s] -> ShowS)
-> Show (ObjectEntry s)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (s :: Stage). Int -> ObjectEntry s -> ShowS
forall (s :: Stage). [ObjectEntry s] -> ShowS
forall (s :: Stage). ObjectEntry s -> String
$cshowsPrec :: forall (s :: Stage). Int -> ObjectEntry s -> ShowS
showsPrec :: Int -> ObjectEntry s -> ShowS
$cshow :: forall (s :: Stage). ObjectEntry s -> String
show :: ObjectEntry s -> String
$cshowList :: forall (s :: Stage). [ObjectEntry s] -> ShowS
showList :: [ObjectEntry s] -> ShowS
Show)

instance RenderGQL (ObjectEntry a) where
  renderGQL :: ObjectEntry a -> Rendering
renderGQL (ObjectEntry FieldName
name Value a
value) = Text -> Rendering
fromText (FieldName -> Text
forall a (t :: NAME). NamePacking a => Name t -> a
forall (t :: NAME). Name t -> Text
unpackName FieldName
name) Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> Rendering
": " Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> Value a -> Rendering
forall a. RenderGQL a => a -> Rendering
renderGQL Value a
value

instance NameCollision GQLError (ObjectEntry s) where
  nameCollision :: ObjectEntry s -> GQLError
nameCollision ObjectEntry {FieldName
entryName :: forall (s :: Stage). ObjectEntry s -> FieldName
entryName :: FieldName
entryName} =
    GQLError
"There can Be only One field Named "
      GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> FieldName -> GQLError
forall a. Msg a => a -> GQLError
msg FieldName
entryName

instance KeyOf FieldName (ObjectEntry s) where
  keyOf :: ObjectEntry s -> FieldName
keyOf = ObjectEntry s -> FieldName
forall (s :: Stage). ObjectEntry s -> FieldName
entryName

type Object a = OrdMap FieldName (ObjectEntry a)

type ValidObject = Object VALID

type RawObject = Object RAW

type ResolvedObject = Object CONST

type RawValue = Value RAW

type ValidValue = Value VALID

type ResolvedValue = Value CONST

deriving instance Lift (Value a)

deriving instance Lift (ObjectEntry a)

instance RenderGQL (Value a) where
  renderGQL :: Value a -> Rendering
renderGQL (ResolvedVariable Ref {FieldName
refName :: FieldName
refName :: forall name. Ref name -> name
refName} Variable VALID
_) = Rendering
"$" Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> FieldName -> Rendering
forall a. RenderGQL a => a -> Rendering
renderGQL FieldName
refName
  renderGQL (VariableValue Ref {FieldName
refName :: forall name. Ref name -> name
refName :: FieldName
refName}) = Rendering
"$" Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> FieldName -> Rendering
forall a. RenderGQL a => a -> Rendering
renderGQL FieldName
refName Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> Rendering
" "
  renderGQL Value a
Null = Rendering
"null"
  renderGQL (Enum TypeName
x) = TypeName -> Rendering
forall a. RenderGQL a => a -> Rendering
renderGQL TypeName
x
  renderGQL (Scalar ScalarValue
x) = ScalarValue -> Rendering
forall a. RenderGQL a => a -> Rendering
renderGQL ScalarValue
x
  renderGQL (Object Object a
xs) = Rendering
"{" Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> Rendering
entries Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> Rendering
"}"
    where
      entries :: Rendering
entries
        | Object a -> Bool
forall a. OrdMap FieldName a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Object a
xs = Rendering
""
        | Bool
otherwise = Rendering
space Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> [ObjectEntry a] -> Rendering
forall (t :: * -> *) a.
(Foldable t, RenderGQL a) =>
t a -> Rendering
renderInputSeq (Object a -> [ObjectEntry a]
forall a. OrdMap FieldName a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Object a
xs) Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> Rendering
space
  renderGQL (List [Value a]
list) = Rendering
"[" Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> [Value a] -> Rendering
forall (t :: * -> *) a.
(Foldable t, RenderGQL a) =>
t a -> Rendering
renderInputSeq [Value a]
list Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> Rendering
"]"

instance Msg (Value a) where
  msg :: Value a -> GQLError
msg = ByteString -> GQLError
forall a. Msg a => a -> GQLError
msg (ByteString -> GQLError)
-> (Value a -> ByteString) -> Value a -> GQLError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value a -> ByteString
forall a. RenderGQL a => a -> ByteString
render

instance A.ToJSON (Value a) where
  toJSON :: Value a -> Value
toJSON (ResolvedVariable Ref FieldName
_ Variable {variableValue :: forall (stage :: Stage).
Variable stage -> VariableContent (CONST_OR_VALID stage)
variableValue = ValidVariableValue ValidValue
x}) =
    ValidValue -> Value
forall a. ToJSON a => a -> Value
A.toJSON ValidValue
x
  toJSON (VariableValue Ref {FieldName
refName :: forall name. Ref name -> name
refName :: FieldName
refName}) =
    Text -> Value
A.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ Text
"($ref:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FieldName -> Text
forall a (t :: NAME). NamePacking a => Name t -> a
forall (t :: NAME). Name t -> Text
unpackName FieldName
refName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
  toJSON Value a
Null = Value
A.Null
  toJSON (Enum TypeName
x) = Text -> Value
A.String (TypeName -> Text
forall a (t :: NAME). NamePacking a => Name t -> a
forall (t :: NAME). Name t -> Text
unpackName TypeName
x)
  toJSON (Scalar ScalarValue
x) = ScalarValue -> Value
forall a. ToJSON a => a -> Value
A.toJSON ScalarValue
x
  toJSON (List [Value a]
x) = [Value a] -> Value
forall a. ToJSON a => a -> Value
A.toJSON [Value a]
x
  toJSON (Object Object a
fields) = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ (ObjectEntry a -> Pair) -> [ObjectEntry a] -> [Pair]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ObjectEntry a -> Pair
forall {e} {kv} {s :: Stage}. KeyValue e kv => ObjectEntry s -> kv
toEntry (Object a -> [ObjectEntry a]
forall a. OrdMap FieldName a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Object a
fields)
    where
      toEntry :: ObjectEntry s -> kv
toEntry (ObjectEntry FieldName
name Value s
value) = FieldName -> Key
forall a (t :: NAME). NamePacking a => Name t -> a
forall (t :: NAME). Name t -> Key
unpackName FieldName
name Key -> Value -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Value s -> Value
forall a. ToJSON a => a -> Value
A.toJSON Value s
value

  -------------------------------------------
  toEncoding :: Value a -> Encoding
toEncoding (ResolvedVariable Ref FieldName
_ Variable {variableValue :: forall (stage :: Stage).
Variable stage -> VariableContent (CONST_OR_VALID stage)
variableValue = ValidVariableValue ValidValue
x}) =
    ValidValue -> Encoding
forall a. ToJSON a => a -> Encoding
A.toEncoding ValidValue
x
  toEncoding (VariableValue Ref {FieldName
refName :: forall name. Ref name -> name
refName :: FieldName
refName}) =
    FieldName -> Encoding
forall a. ToJSON a => a -> Encoding
A.toEncoding (FieldName -> Encoding) -> FieldName -> Encoding
forall a b. (a -> b) -> a -> b
$ FieldName
"($ref:" FieldName -> FieldName -> FieldName
forall a. Semigroup a => a -> a -> a
<> FieldName
refName FieldName -> FieldName -> FieldName
forall a. Semigroup a => a -> a -> a
<> FieldName
")"
  toEncoding Value a
Null = Value -> Encoding
forall a. ToJSON a => a -> Encoding
A.toEncoding Value
A.Null
  toEncoding (Enum TypeName
x) = TypeName -> Encoding
forall a. ToJSON a => a -> Encoding
A.toEncoding TypeName
x
  toEncoding (Scalar ScalarValue
x) = ScalarValue -> Encoding
forall a. ToJSON a => a -> Encoding
A.toEncoding ScalarValue
x
  toEncoding (List [Value a]
x) = [Value a] -> Encoding
forall a. ToJSON a => a -> Encoding
A.toEncoding [Value a]
x
  toEncoding (Object Object a
ordMap) = Series -> Encoding
A.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$ (ObjectEntry a -> Series) -> [ObjectEntry a] -> Series
forall p e. (Semigroup p, Monoid p) => (e -> p) -> [e] -> p
renderSeries ObjectEntry a -> Series
forall {e} {kv} {s :: Stage}. KeyValue e kv => ObjectEntry s -> kv
encodeField (Object a -> [ObjectEntry a]
forall a. OrdMap FieldName a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Object a
ordMap)
    where
      encodeField :: ObjectEntry s -> kv
encodeField (ObjectEntry FieldName
key Value s
value) = FieldName -> Key
forall a (t :: NAME). NamePacking a => Name t -> a
forall (t :: NAME). Name t -> Key
unpackName FieldName
key Key -> Value s -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Value s
value

-- fixes GHC 8.2.2, which can't deduce (Semigroup p) from context (Monoid p)
renderSeries :: (Semigroup p, Monoid p) => (e -> p) -> [e] -> p
renderSeries :: forall p e. (Semigroup p, Monoid p) => (e -> p) -> [e] -> p
renderSeries e -> p
_ [] = p
forall a. Monoid a => a
mempty
renderSeries e -> p
f (e
x : [e]
xs) = (e -> p -> p) -> p -> [e] -> p
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr' (\e
e p
es -> p
es p -> p -> p
forall a. Semigroup a => a -> a -> a
<> e -> p
f e
e) (e -> p
f e
x) [e]
xs

decodeScientific :: Scientific -> ScalarValue
decodeScientific :: Scientific -> ScalarValue
decodeScientific Scientific
v = case Scientific -> Either Double Int
forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
floatingOrInteger Scientific
v of
  Left Double
float -> Double -> ScalarValue
Float Double
float
  Right Int
int -> Int -> ScalarValue
Int Int
int

replaceValue :: A.Value -> Value a
replaceValue :: forall (a :: Stage). Value -> Value a
replaceValue (A.Bool Bool
v) = Bool -> Value a
forall (s :: Stage). Bool -> Value s
mkBoolean Bool
v
replaceValue (A.Number Scientific
v) = ScalarValue -> Value a
forall (stage :: Stage). ScalarValue -> Value stage
Scalar (ScalarValue -> Value a) -> ScalarValue -> Value a
forall a b. (a -> b) -> a -> b
$ Scientific -> ScalarValue
decodeScientific Scientific
v
replaceValue (A.String Text
v) = Text -> Value a
forall (s :: Stage). Text -> Value s
mkString Text
v
replaceValue (A.Object Object
v) =
  [(FieldName, Value a)] -> Value a
forall (s :: Stage). [(FieldName, Value s)] -> Value s
mkObject ([(FieldName, Value a)] -> Value a)
-> [(FieldName, Value a)] -> Value a
forall a b. (a -> b) -> a -> b
$
    (Pair -> (FieldName, Value a)) -> [Pair] -> [(FieldName, Value a)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
      ((Key -> FieldName)
-> (Value -> Value a) -> Pair -> (FieldName, Value a)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Key -> FieldName
forall a (t :: NAME). NamePacking a => a -> Name t
forall (t :: NAME). Key -> Name t
packName Value -> Value a
forall (a :: Stage). Value -> Value a
replaceValue)
      (Object -> [Pair]
forall a. KeyMap a -> [(Key, a)]
forall k (m :: * -> *) a. IsMap k m => m a -> [(k, a)]
toAssoc Object
v)
replaceValue (A.Array Array
li) = [Value a] -> Value a
forall (stage :: Stage). [Value stage] -> Value stage
List ((Value -> Value a) -> [Value] -> [Value a]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> Value a
forall (a :: Stage). Value -> Value a
replaceValue (Array -> [Value]
forall a. Vector a -> [a]
V.toList Array
li))
replaceValue Value
A.Null = Value a
forall (stage :: Stage). Value stage
Null

instance A.FromJSON (Value a) where
  parseJSON :: Value -> Parser (Value a)
parseJSON = Value a -> Parser (Value a)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value a -> Parser (Value a))
-> (Value -> Value a) -> Value -> Parser (Value a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Value a
forall (a :: Stage). Value -> Value a
replaceValue

-- DEFAULT VALUES

mkBoolean :: Bool -> Value s
mkBoolean :: forall (s :: Stage). Bool -> Value s
mkBoolean = ScalarValue -> Value s
forall (stage :: Stage). ScalarValue -> Value stage
Scalar (ScalarValue -> Value s)
-> (Bool -> ScalarValue) -> Bool -> Value s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> ScalarValue
Boolean

mkString :: Text -> Value s
mkString :: forall (s :: Stage). Text -> Value s
mkString = ScalarValue -> Value s
forall (stage :: Stage). ScalarValue -> Value stage
Scalar (ScalarValue -> Value s)
-> (Text -> ScalarValue) -> Text -> Value s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ScalarValue
String

mkObject :: [(FieldName, Value s)] -> Value s
mkObject :: forall (s :: Stage). [(FieldName, Value s)] -> Value s
mkObject = Object s -> Value s
forall (stage :: Stage). Object stage -> Value stage
Object (Object s -> Value s)
-> ([(FieldName, Value s)] -> Object s)
-> [(FieldName, Value s)]
-> Value s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(FieldName, ObjectEntry s)] -> Object s
forall a. [(FieldName, a)] -> OrdMap FieldName a
forall k (m :: * -> *) a. IsMap k m => [(k, a)] -> m a
unsafeFromList ([(FieldName, ObjectEntry s)] -> Object s)
-> ([(FieldName, Value s)] -> [(FieldName, ObjectEntry s)])
-> [(FieldName, Value s)]
-> Object s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((FieldName, Value s) -> (FieldName, ObjectEntry s))
-> [(FieldName, Value s)] -> [(FieldName, ObjectEntry s)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FieldName, Value s) -> (FieldName, ObjectEntry s)
forall {s :: Stage}.
(FieldName, Value s) -> (FieldName, ObjectEntry s)
toEntry
  where
    toEntry :: (FieldName, Value s) -> (FieldName, ObjectEntry s)
toEntry (FieldName
key, Value s
value) = (FieldName
key, FieldName -> Value s -> ObjectEntry s
forall (s :: Stage). FieldName -> Value s -> ObjectEntry s
ObjectEntry FieldName
key Value s
value)

instance Hashable (Value a) where
  hashWithSalt :: Int -> Value a -> Int
hashWithSalt Int
s (Object Object a
x) = Int -> (Int, [ObjectEntry a]) -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Int
0 :: Int, Object a -> [ObjectEntry a]
forall a. OrdMap FieldName a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Object a
x)
  hashWithSalt Int
s (List [Value a]
x) = Int -> (Int, [Value a]) -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Int
1 :: Int, [Value a]
x)
  hashWithSalt Int
s (Enum TypeName
x) = Int -> (Int, TypeName) -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Int
2 :: Int, TypeName
x)
  hashWithSalt Int
s (Scalar ScalarValue
x) = Int -> (Int, String) -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Int
3 :: Int, ScalarValue -> String
forall b a. (Show a, IsString b) => a -> b
show ScalarValue
x :: String)
  hashWithSalt Int
s Value a
Null = Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Int
4 :: Int)
  hashWithSalt Int
s (ResolvedVariable Ref FieldName
_ Variable VALID
_) = Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Int
5 :: Int)
  hashWithSalt Int
s (VariableValue Ref {FieldName
refName :: forall name. Ref name -> name
refName :: FieldName
refName}) = Int -> (Int, FieldName) -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Int
6 :: Int, FieldName
refName)

instance Hashable (ObjectEntry s) where
  hashWithSalt :: Int -> ObjectEntry s -> Int
hashWithSalt Int
s (ObjectEntry FieldName
name Value s
value) = Int -> (FieldName, Value s) -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (FieldName
name, Value s
value)