language-puppet-0.4.0: Tools to parse and evaluate the Puppet DSL.

Safe HaskellNone

Puppet.Interpreter.Types

Synopsis

Documentation

type PuppetTypeName = TextSource

Types for the native type system.

type PuppetTypeValidate = RResource -> Either String RResourceSource

This is a function type than can be bound. It is the type of all subsequent validators.

type Catalog = [CResource]Source

This is the potentially unsolved list of resources in the catalog.

data LinkType Source

Relationship link type.

type GeneralValue = Either Expression ResolvedValueSource

This type holds a value that is either from the ASL or fully resolved.

type GeneralString = Either Expression TextSource

This type holds a value that is either from the ASL or a fully resolved String.

data CResource Source

This describes the resources before the final resolution. This is required as they must somehow be collected while the Statements are interpreted, but the necessary Expressions are not yet available. This is because in Puppet the Statement order should not alter the catalog's content.

The relations are not stored here, as they are pushed into a separate internal data structure by the interpreter.

Constructors

CResource 

Fields

crid :: !Int

Resource ID, used in the Puppet YAML.

crname :: !GeneralString

Resource name.

crtype :: !Text

Resource type.

crparams :: !(Map GeneralString GeneralValue)

Resource parameters.

crvirtuality :: !Virtuality

Resource virtuality.

crscope :: ![[ScopeName]]

Resource scope when it was defined

pos :: !SourcePos

Source code position of the resource definition.

json2puppet :: FromJSON a => Value -> Either String aSource

Used for puppetDB queries, converting values to CResources

type ResIdentifier = (Text, Text)Source

Resource identifier, made of a type, name pair.

type Relation = (LinkType, ResIdentifier)Source

Resource relation, made of a LinkType, ResIdentifier pair.

data RResource Source

This is a fully resolved resource that will be used in the FinalCatalog.

Constructors

RResource 

Fields

rrid :: !Int

Resource ID.

rrname :: !Text

Resource name.

rrtype :: !Text

Resource type.

rrparams :: !(Map Text ResolvedValue)

Resource parameters.

rrelations :: ![Relation]

Resource relations.

rrscope :: ![[ScopeName]]

Resource scope when it was defined

rrpos :: !SourcePos

Source code position of the resource definition.

data RelUpdateType Source

Type of update/override, so they can be applied in the correct order. This part is probably not behaving like vanilla puppet, as it turns out this are many fairly acceptable behaviours and the correct one is not documented.

Constructors

UNormal 
UOverride 
UDefault 
UPlus 

data ScopeState Source

The most important data structure for the interpreter. It stores its internal state.

Constructors

ScopeState 

Fields

curScope :: ![[ScopeName]]

The list of scopes. It works like a stack, and its initial value must be [["::"]]. It is a stack of lists of strings. These lists can be one element wide (usual case), or two elements (inheritance), so that variables could be assigned to both scopes.

curVariables :: !(Map Text (GeneralValue, SourcePos))

The list of known variables. It should be noted that the interpreter tries to resolve them as soon as it can, so that it can store their current scope.

curClasses :: !(Map Text SourcePos)

The list of classes that have already been included, along with the place where this happened.

curDefaults :: !(Map [ScopeName] [ResDefaults])

List of defaults to apply. All defaults are applied at the end of the interpretation of each top level statement.

curResId :: !Int

Stores the value of the current crid.

curPos :: !SourcePos

Current position of the evaluated statement. This is mostly used to give useful error messages.

nestedtoplevels :: !(Map (TopLevelType, Text) Statement)

List of "top levels" that have been parsed inside another top level. Their behaviour is curently non canonical as the scoping rules are unclear.

getStatementsFunction :: TopLevelType -> Text -> IO (Either String Statement)

This is a function that, given the type of a top level statement and its name, should return it.

getWarnings :: ![Text]

List of warnings.

curCollect :: ![(CResource -> CatalogMonad Bool, Map GeneralString GeneralValue, Maybe Query)]

A bit complicated, this stores the collection functions. These are functions that determine whether a resource should be collected or not. It can optionally store overrides, which will be applied in the end on all resources. It can also store a PuppetDB query.

unresolvedRels :: ![([(LinkType, GeneralValue, GeneralValue)], (Text, GeneralString), RelUpdateType, SourcePos, [[ScopeName]])]

This stores unresolved relationships, because the original string name can't be resolved. Fieds are [ ( [dstrelations], srcresource, type, pos ) ]

computeTemplateFunction :: Either Text Text -> Text -> Map Text GeneralValue -> IO (Either String Text)

Function that takes either a text content or a filename, the current scope and a list of variables. It returns an error or the computed template.

puppetDBFunction :: Text -> Query -> IO (Either String Value)

Function that takes a request type (resources, nodes, facts, ..), a query, and returns a resolved value from puppetDB.

luaState :: Maybe LuaState

The Lua state, used for user supplied content.

userFunctions :: !(Set Text)

The list of registered user functions

nativeTypes :: !(Map PuppetTypeName PuppetTypeMethods)

The list of native types.

definedResources :: !(Map ResIdentifier SourcePos)

Horrible hack to kind of support the defined function

currentDependencyStack :: [ResIdentifier]
 

type CatalogMonad = ErrorT Text (StateT ScopeState IO)Source

The monad all the interpreter lives in. It is ErrorT with a state.

type EdgeMap = Map (ResIdentifier, ResIdentifier) LinkInfoSource

This is the map of all edges associated with the FinalCatalog. The key is (source, target).

metaparameters :: Set TextSource

This is the set of meta parameters