{-# LANGUAGE OverloadedStrings #-}

module Hydra.Sources.Tier4.Ext.Protobuf.Language (protobufLanguageModule) where

-- Standard Tier-4 imports
import           Prelude hiding ((++))
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.Base            as Base
import qualified Hydra.Dsl.Core            as Core
import qualified Hydra.Dsl.Graph           as Graph
import qualified Hydra.Dsl.Lib.Equality    as Equality
import qualified Hydra.Dsl.Lib.Flows       as Flows
import qualified Hydra.Dsl.Lib.Io          as Io
import qualified Hydra.Dsl.Lib.Lists       as Lists
import qualified Hydra.Dsl.Lib.Literals    as Literals
import qualified Hydra.Dsl.Lib.Logic       as Logic
import qualified Hydra.Dsl.Lib.Maps        as Maps
import qualified Hydra.Dsl.Lib.Math        as Math
import qualified Hydra.Dsl.Lib.Optionals   as Optionals
import qualified Hydra.Dsl.Lib.Sets        as Sets
import           Hydra.Dsl.Lib.Strings     as Strings
import qualified Hydra.Dsl.Module          as Module
import qualified Hydra.Dsl.Terms           as Terms
import qualified Hydra.Dsl.Types           as Types
import           Hydra.Sources.Tier3.All


protobufLanguageDefinition :: String -> TTerm a -> TElement a
protobufLanguageDefinition :: forall a. String -> TTerm a -> TElement a
protobufLanguageDefinition = Module -> String -> TTerm a -> TElement a
forall a. Module -> String -> TTerm a -> TElement a
definitionInModule Module
protobufLanguageModule

protobufLanguageModule :: Module
protobufLanguageModule :: Module
protobufLanguageModule = Namespace
-> [Element] -> [Module] -> [Module] -> Maybe String -> Module
Module Namespace
ns [Element]
elements [Module
hydraCodersModule, Module
hydraBasicsModule, Module
hydraStripModule] [Module]
tier0Modules (Maybe String -> Module) -> Maybe String -> Module
forall a b. (a -> b) -> a -> b
$
    String -> Maybe String
forall a. a -> Maybe a
Just String
"Language constraints for Protobuf v3"
  where
    ns :: Namespace
ns = String -> Namespace
Namespace String
"hydra/ext/protobuf/language"
    elements :: [Element]
elements = [
      TElement Language -> Element
forall a. TElement a -> Element
el TElement Language
protobufLanguageDef,
      TElement (Set String) -> Element
forall a. TElement a -> Element
el TElement (Set String)
protobufReservedWordsDef]

protobufLanguageDef :: TElement (Language)
protobufLanguageDef :: TElement Language
protobufLanguageDef = String -> TTerm Language -> TElement Language
forall a. String -> TTerm a -> TElement a
protobufLanguageDefinition String
"protobufLanguage" (TTerm Language -> TElement Language)
-> TTerm Language -> TElement Language
forall a b. (a -> b) -> a -> b
$
  String -> TTerm Language -> TTerm Language
forall a. String -> TTerm a -> TTerm a
doc String
"Language constraints for Protocol Buffers v3" (TTerm Language -> TTerm Language)
-> TTerm Language -> TTerm Language
forall a b. (a -> b) -> a -> b
$
  Type -> TTerm Language -> TTerm Language
forall a. Type -> TTerm a -> TTerm a
typed Type
languageT (TTerm Language -> TTerm Language)
-> TTerm Language -> TTerm Language
forall a b. (a -> b) -> a -> b
$
  Name -> [Field] -> TTerm Language
forall a. Name -> [Field] -> TTerm a
record Name
_Language [
    Name
_Language_nameName -> TTerm Any -> Field
forall a. Name -> TTerm a -> Field
>>: Name -> TTerm Any -> TTerm Any
forall a b. Name -> TTerm a -> TTerm b
wrap Name
_LanguageName TTerm Any
"hydra/ext/protobuf",
    Name
_Language_constraintsName -> TTerm Any -> Field
forall a. Name -> TTerm a -> Field
>>: Name -> [Field] -> TTerm Any
forall a. Name -> [Field] -> TTerm a
record Name
_LanguageConstraints [
      Name
_LanguageConstraints_eliminationVariantsName -> TTerm (Set Any) -> Field
forall a. Name -> TTerm a -> Field
>>: TTerm (Set Any)
forall a. TTerm (Set a)
Sets.empty,
      Name
_LanguageConstraints_literalVariantsName -> TTerm (Set Any) -> Field
forall a. Name -> TTerm a -> Field
>>: TTerm ([Any] -> Set Any)
forall a. TTerm ([a] -> Set a)
Sets.fromList TTerm ([Any] -> Set Any) -> TTerm [Any] -> TTerm (Set Any)
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ [TTerm Any] -> TTerm [Any]
forall a. [TTerm a] -> TTerm [a]
list (Name -> Name -> TTerm Any
forall a. Name -> Name -> TTerm a
unitVariant Name
_LiteralVariant (Name -> TTerm Any) -> [Name] -> [TTerm Any]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [
        Name
_LiteralVariant_binary,
        Name
_LiteralVariant_boolean,
        Name
_LiteralVariant_float,
        Name
_LiteralVariant_integer,
        Name
_LiteralVariant_string]),
      Name
_LanguageConstraints_floatTypesName -> TTerm (Set Any) -> Field
forall a. Name -> TTerm a -> Field
>>: TTerm ([Any] -> Set Any)
forall a. TTerm ([a] -> Set a)
Sets.fromList TTerm ([Any] -> Set Any) -> TTerm [Any] -> TTerm (Set Any)
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ [TTerm Any] -> TTerm [Any]
forall a. [TTerm a] -> TTerm [a]
list (Name -> Name -> TTerm Any
forall a. Name -> Name -> TTerm a
unitVariant Name
_FloatType (Name -> TTerm Any) -> [Name] -> [TTerm Any]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [
        Name
_FloatType_float32,
        Name
_FloatType_float64]),
      Name
_LanguageConstraints_functionVariantsName -> TTerm (Set Any) -> Field
forall a. Name -> TTerm a -> Field
>>: TTerm (Set Any)
forall a. TTerm (Set a)
Sets.empty,
      Name
_LanguageConstraints_integerTypesName -> TTerm (Set Any) -> Field
forall a. Name -> TTerm a -> Field
>>: TTerm ([Any] -> Set Any)
forall a. TTerm ([a] -> Set a)
Sets.fromList TTerm ([Any] -> Set Any) -> TTerm [Any] -> TTerm (Set Any)
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ [TTerm Any] -> TTerm [Any]
forall a. [TTerm a] -> TTerm [a]
list (Name -> Name -> TTerm Any
forall a. Name -> Name -> TTerm a
unitVariant Name
_IntegerType (Name -> TTerm Any) -> [Name] -> [TTerm Any]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [
        Name
_IntegerType_int32,
        Name
_IntegerType_int64,
        Name
_IntegerType_uint32,
        Name
_IntegerType_uint64]),
      Name
_LanguageConstraints_termVariantsName -> TTerm (Set Any) -> Field
forall a. Name -> TTerm a -> Field
>>: TTerm ([Any] -> Set Any)
forall a. TTerm ([a] -> Set a)
Sets.fromList TTerm ([Any] -> Set Any) -> TTerm [Any] -> TTerm (Set Any)
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ [TTerm Any] -> TTerm [Any]
forall a. [TTerm a] -> TTerm [a]
list (Name -> Name -> TTerm Any
forall a. Name -> Name -> TTerm a
unitVariant Name
_TermVariant (Name -> TTerm Any) -> [Name] -> [TTerm Any]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [
        Name
_TermVariant_list,
        Name
_TermVariant_literal,
        Name
_TermVariant_map,
        Name
_TermVariant_optional,
        Name
_TermVariant_record,
        Name
_TermVariant_union]),
      Name
_LanguageConstraints_typeVariantsName -> TTerm (Set Any) -> Field
forall a. Name -> TTerm a -> Field
>>: TTerm ([Any] -> Set Any)
forall a. TTerm ([a] -> Set a)
Sets.fromList TTerm ([Any] -> Set Any) -> TTerm [Any] -> TTerm (Set Any)
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ [TTerm Any] -> TTerm [Any]
forall a. [TTerm a] -> TTerm [a]
list (Name -> Name -> TTerm Any
forall a. Name -> Name -> TTerm a
unitVariant Name
_TypeVariant (Name -> TTerm Any) -> [Name] -> [TTerm Any]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [
        Name
_TypeVariant_annotated,
        Name
_TypeVariant_list,
        Name
_TypeVariant_literal,
        Name
_TypeVariant_map,
        Name
_TypeVariant_optional,
        Name
_TypeVariant_record,
        Name
_TypeVariant_union,
        Name
_TypeVariant_variable]),
      Name
_LanguageConstraints_typesName -> TTerm (Any -> Bool) -> Field
forall a. Name -> TTerm a -> Field
>>: Name -> Maybe (TTerm Bool) -> [Field] -> TTerm (Any -> Bool)
forall b u. Name -> Maybe (TTerm b) -> [Field] -> TTerm (u -> b)
match Name
_Type (TTerm Bool -> Maybe (TTerm Bool)
forall a. a -> Maybe a
Just TTerm Bool
true) [
        Name
_Type_mapName -> TTerm (Any -> Any) -> Field
forall a. Name -> TTerm a -> Field
>>: String -> TTerm Bool -> TTerm (Any -> Any)
forall x a b. String -> TTerm x -> TTerm (a -> b)
lambda String
"mt" (Name -> Maybe (TTerm Bool) -> [Field] -> TTerm (Type -> Bool)
forall b u. Name -> Maybe (TTerm b) -> [Field] -> TTerm (u -> b)
match Name
_Type (TTerm Bool -> Maybe (TTerm Bool)
forall a. a -> Maybe a
Just TTerm Bool
true) [
          Name
_Type_optionalName -> TTerm (Any -> Bool) -> Field
forall a. Name -> TTerm a -> Field
>>: TTerm Bool -> TTerm (Any -> Bool)
forall a b. TTerm a -> TTerm (b -> a)
constant TTerm Bool
false] TTerm (Type -> Bool) -> TTerm Type -> TTerm Bool
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ (TElement (Type -> Type) -> TTerm (Type -> Type)
forall a. TElement a -> TTerm a
ref TElement (Type -> Type)
stripTypeDef TTerm (Type -> Type) -> TTerm Type -> TTerm Type
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ (TTerm (MapType -> Type)
Core.mapTypeValues TTerm (MapType -> Type) -> TTerm MapType -> TTerm Type
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ String -> TTerm MapType
forall a. String -> TTerm a
var String
"mt")))]]]

protobufReservedWordsDef :: TElement (S.Set String)
protobufReservedWordsDef :: TElement (Set String)
protobufReservedWordsDef = String -> TTerm (Set String) -> TElement (Set String)
forall a. String -> TTerm a -> TElement a
protobufLanguageDefinition String
"protobufReservedWords" (TTerm (Set String) -> TElement (Set String))
-> TTerm (Set String) -> TElement (Set String)
forall a b. (a -> b) -> a -> b
$
  String -> TTerm (Set String) -> TTerm (Set String)
forall a. String -> TTerm a -> TTerm a
doc String
"A set of reserved words in Protobuf" (TTerm (Set String) -> TTerm (Set String))
-> TTerm (Set String) -> TTerm (Set String)
forall a b. (a -> b) -> a -> b
$
  Type -> TTerm (Set String) -> TTerm (Set String)
forall a. Type -> TTerm a -> TTerm a
typed (Type -> Type
setT Type
stringT) (TTerm (Set String) -> TTerm (Set String))
-> TTerm (Set String) -> TTerm (Set String)
forall a b. (a -> b) -> a -> b
$
  (TTerm ([String] -> Set String)
forall a. TTerm ([a] -> Set a)
Sets.fromList TTerm ([String] -> Set String)
-> TTerm [String] -> TTerm (Set String)
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ (TTerm ([[String]] -> [String])
forall a. TTerm ([[a]] -> [a])
Lists.concat TTerm ([[String]] -> [String])
-> TTerm [[String]] -> TTerm [String]
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ [TTerm [String]] -> TTerm [[String]]
forall a. [TTerm a] -> TTerm [a]
list [String -> TTerm [String]
forall a. String -> TTerm a
var String
"fieldNames"]))
  TTerm (Set String) -> [Field] -> TTerm (Set String)
forall a. TTerm a -> [Field] -> TTerm a
`with` [
    String
"fieldNames"String -> TTerm [Any] -> Field
forall a. String -> TTerm a -> Field
>:
      String -> TTerm [Any] -> TTerm [Any]
forall a. String -> TTerm a -> TTerm a
doc String
"See: http://google.github.io/proto-lens/reserved-names.html" (TTerm [Any] -> TTerm [Any]) -> TTerm [Any] -> TTerm [Any]
forall a b. (a -> b) -> a -> b
$
      [TTerm Any] -> TTerm [Any]
forall a. [TTerm a] -> TTerm [a]
list [
        TTerm Any
"case", TTerm Any
"class", TTerm Any
"data", TTerm Any
"default", TTerm Any
"deriving", TTerm Any
"do", TTerm Any
"else", TTerm Any
"foreign", TTerm Any
"if", TTerm Any
"import", TTerm Any
"in", TTerm Any
"infix", TTerm Any
"infixl",
        TTerm Any
"infixr", TTerm Any
"instance", TTerm Any
"let", TTerm Any
"mdo", TTerm Any
"module", TTerm Any
"newtype", TTerm Any
"of", TTerm Any
"pattern", TTerm Any
"proc", TTerm Any
"rec", TTerm Any
"then", TTerm Any
"type", TTerm Any
"where"]]