-- | A simple JSON model. This model is part of the Hydra kernel, despite JSON being an external language; JSON support is built in to Hydra

module Hydra.Sources.Tier0.Json where

-- Standard Tier-0 imports
import qualified Data.List             as L
import qualified Data.Map              as M
import qualified Data.Set              as S
import qualified Data.Maybe            as Y
import           Hydra.Dsl.Annotations
import           Hydra.Dsl.Bootstrap
import qualified Hydra.Dsl.Terms       as Terms
import           Hydra.Dsl.Types       as Types
import           Hydra.Sources.Core


jsonModelModule :: Module
jsonModelModule :: Module
jsonModelModule = Namespace
-> [Element] -> [Module] -> [Module] -> Maybe String -> Module
Module Namespace
ns [Element]
elements [Module
hydraCoreModule] [Module
hydraCoreModule] (Maybe String -> Module) -> Maybe String -> Module
forall a b. (a -> b) -> a -> b
$
    String -> Maybe String
forall a. a -> Maybe a
Just String
"A JSON syntax model. See the BNF at https://www.json.org"
  where
    ns :: Namespace
ns = String -> Namespace
Namespace String
"hydra/json"
    def :: String -> Type -> Element
def = Namespace -> String -> Type -> Element
datatype Namespace
ns
    json :: String -> Type
json = Namespace -> String -> Type
typeref Namespace
ns

    elements :: [Element]
elements = [

      String -> Type -> Element
def String
"Value" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
doc String
"A JSON value" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
union [
          String
"array"String -> Type -> FieldType
>:
            String -> Type -> Type
doc String
"A JSON array" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
json String
"Value",
          String
"boolean"String -> Type -> FieldType
>:
            String -> Type -> Type
doc String
"A boolean value"
            Type
boolean,
          String
"null"String -> Type -> FieldType
>:
            String -> Type -> Type
doc String
"JSON's null value"
            Type
unit,
          String
"number"String -> Type -> FieldType
>:
            String -> Type -> Type
doc String
"A numeric value"
            Type
bigfloat, -- TODO: JSON numbers are decimal-encoded
          String
"object"String -> Type -> FieldType
>:
            String -> Type -> Type
doc String
"A JSON object as a set of key/value pairs" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            Type -> Type -> Type
Types.map Type
string (String -> Type
json String
"Value"),
          String
"string"String -> Type -> FieldType
>:
            String -> Type -> Type
doc String
"A string value"
            Type
string]]