Constants.hs

module Hydra.Sources.Kernel.Terms.Constants where

-- Standard imports for kernel terms modules
import Hydra.Kernel hiding (
  debugInference, ignoredVariable, key_classes, key_debugId, key_deprecated, key_description,
  key_exclude, key_firstClassType, key_maxLength, key_minLength, key_preserveFieldName,
  key_type, key_freshTypeVariableCount, maxInt32, maxTraceDepth,
  warningAutoGeneratedFile)
import Hydra.Sources.Libraries
import qualified Hydra.Dsl.Paths    as Paths
import qualified Hydra.Dsl.Annotations       as Annotations
import qualified Hydra.Dsl.Ast          as Ast
import qualified Hydra.Dsl.Bootstrap         as Bootstrap
import qualified Hydra.Dsl.Coders       as Coders
import qualified Hydra.Dsl.Util      as Util
import qualified Hydra.Dsl.Meta.Core         as Core
import qualified Hydra.Dsl.Meta.Graph        as Graph
import qualified Hydra.Dsl.Json.Model         as Json
import qualified Hydra.Dsl.Meta.Lib.Chars    as Chars
import qualified Hydra.Dsl.Meta.Lib.Eithers  as Eithers
import qualified Hydra.Dsl.Meta.Lib.Equality as Equality
import qualified Hydra.Dsl.Meta.Lib.Lists    as Lists
import qualified Hydra.Dsl.Meta.Lib.Literals as Literals
import qualified Hydra.Dsl.Meta.Lib.Logic    as Logic
import qualified Hydra.Dsl.Meta.Lib.Maps     as Maps
import qualified Hydra.Dsl.Meta.Lib.Math     as Math
import qualified Hydra.Dsl.Meta.Lib.Maybes   as Maybes
import qualified Hydra.Dsl.Meta.Lib.Pairs    as Pairs
import qualified Hydra.Dsl.Meta.Lib.Sets     as Sets
import           Hydra.Dsl.Meta.Lib.Strings  as Strings
import qualified Hydra.Dsl.Literals          as Literals
import qualified Hydra.Dsl.LiteralTypes      as LiteralTypes
import qualified Hydra.Dsl.Meta.Base         as MetaBase
import qualified Hydra.Dsl.Meta.Terms        as MetaTerms
import qualified Hydra.Dsl.Meta.Types        as MetaTypes
import qualified Hydra.Dsl.Module       as Module
import qualified Hydra.Dsl.Parsing      as Parsing
import           Hydra.Dsl.Meta.Phantoms     as Phantoms
import qualified Hydra.Dsl.Prims             as Prims
import qualified Hydra.Dsl.Meta.Tabular           as Tabular
import qualified Hydra.Dsl.Meta.Testing      as Testing
import qualified Hydra.Dsl.Terms             as Terms
import qualified Hydra.Dsl.Tests             as Tests
import qualified Hydra.Dsl.Topology     as Topology
import qualified Hydra.Dsl.Types             as Types
import qualified Hydra.Dsl.Typing       as Typing
import qualified Hydra.Dsl.Util         as Util
import qualified Hydra.Dsl.Meta.Variants     as Variants
import           Hydra.Sources.Kernel.Types.All
import           Prelude hiding ((++))
import qualified Data.Int                    as I
import qualified Data.List                   as L
import qualified Data.Map                    as M
import qualified Data.Set                    as S
import qualified Data.Maybe                  as Y


ns :: Namespace
ns = Namespace "hydra.constants"

module_ :: Module
module_ = Module ns elements
    []
    kernelTypesNamespaces $
    Just ("A module for tier-0 constants.")
  where
   elements = [
--     toTermDefinition tryMe,
     toTermDefinition debugInference,
     toTermDefinition ignoredVariable,
     toTermDefinition key_classes,
     toTermDefinition key_debugId,
     toTermDefinition key_deprecated,
     toTermDefinition key_description,
     toTermDefinition key_exclude,
     toTermDefinition key_firstClassType,
     toTermDefinition key_maxLength,
     toTermDefinition key_minLength,
     toTermDefinition key_preserveFieldName,
     toTermDefinition key_type,
     toTermDefinition key_freshTypeVariableCount,
     toTermDefinition maxInt32,
     toTermDefinition maxTraceDepth,
     toTermDefinition warningAutoGeneratedFile]

define :: String -> TTerm a -> TBinding a
define = definitionInModule module_

defineAnnotationKey :: String -> Maybe String -> TBinding Name
defineAnnotationKey name mdesc = define ("key_" <> name) $ case mdesc of
    Nothing -> def
    Just comment -> doc comment def
  where
    def = wrap _Name $ string name

-- 

-- An extra definition, normally commented out, for debugging
tryMe = define "tryMe" $
  left $ string "foo"
--  Core.termPair $ pair Core.termUnit Core.termUnit
--  Core.termPair $ pair Core.termUnit Core.termUnit
--  pair Core.termUnit Core.termUnit
--  Core.termProduct $ list [Core.termUnit, Core.termUnit]

debugInference :: TBinding Bool
debugInference = define "debugInference" $
  doc "Disable type checking by default, for better performance" $
  true
  
ignoredVariable :: TBinding String
ignoredVariable = define "ignoredVariable" $
  doc "The name used for ignored variables" $
  string "_"

key_classes = defineAnnotationKey "classes" $ Just "Annotation key for type classes"
key_debugId = defineAnnotationKey "debugId" $ Just "Annotation key for debug identifiers"
key_deprecated = defineAnnotationKey "deprecated" $ Just "Annotation key for deprecated markers"
key_description = defineAnnotationKey "description" $ Just "Annotation key for descriptions"
key_exclude = defineAnnotationKey "exclude" $ Just "Annotation key for exclusions"
key_firstClassType = defineAnnotationKey "firstClassType" $
  Just "A flag which tells the language coders to encode a given encoded type as a term rather than a native type"
key_maxLength = defineAnnotationKey "maxLength" $ Just "Annotation key for maximum length constraints"
key_minLength = defineAnnotationKey "minLength" $ Just "Annotation key for minimum length constraints"
key_preserveFieldName = defineAnnotationKey "preserveFieldName" $ Just "Annotation key for preserving field names during code generation"
key_type = defineAnnotationKey "type" $ Just "Annotation key for type information"
key_freshTypeVariableCount = defineAnnotationKey "freshTypeVariableCount" $
  Just "A counter for generating fresh type variable names"

maxInt32 :: TBinding Int
maxInt32 = define "maxInt32" $
  doc "The maximum value of a 32-bit integer" $
  int32 2147483647 -- 2^31 - 1

maxTraceDepth :: TBinding Int
maxTraceDepth = define "maxTraceDepth" $
  doc ("A maximum depth for nested computations."
    <> " Currently, this is set very high because deep recursion is common in type inference over the Hydra kernel.") $
  int32 5000

warningAutoGeneratedFile :: TBinding String
warningAutoGeneratedFile = define "warningAutoGeneratedFile" $
  doc "A standard warning message for auto-generated files" $
  string "Note: this is an automatically generated file. Do not edit."