Safe Haskell | None |
---|
Puppet.Interpreter.Types
- metaparameters :: HashSet Text
- type Nodename = Text
- type Container = HashMap Text
- data PValue
- data HieraQueryType
- = Priority
- | ArrayMerge
- | HashMerge
- type HieraQueryFunc = Container ScopeInformation -> Text -> HieraQueryType -> IO (Either Doc (Pair InterpreterWriter (Maybe PValue)))
- data RSearchExpression
- data ClassIncludeType
- type Scope = Text
- type Facts = Container Text
- data TopLevelType
- = TopNode
- | TopDefine
- | TopClass
- | TopSpurious
- data ResDefaults = ResDefaults {
- _defType :: !Text
- _defSrcScope :: !Text
- _defValues :: !(Container PValue)
- _defPos :: !PPosition
- data CurContainerDesc
- = ContRoot
- | ContClass !Text
- | ContDefine !Text !Text
- | ContImported !CurContainerDesc
- | ContImport !Nodename !CurContainerDesc
- data CurContainer = CurContainer {
- _cctype :: !CurContainerDesc
- _cctags :: !(HashSet Text)
- data ResRefOverride = ResRefOverride {}
- data ScopeInformation = ScopeInformation {}
- data InterpreterState = InterpreterState {
- _scopes :: !(Container ScopeInformation)
- _loadedClasses :: !(Container (Pair ClassIncludeType PPosition))
- _definedResources :: !(HashMap RIdentifier Resource)
- _curScope :: ![CurContainerDesc]
- _curPos :: !PPosition
- _nestedDeclarations :: !(HashMap (TopLevelType, Text) Statement)
- _extraRelations :: ![LinkInformation]
- _resMod :: ![ResourceModifier]
- data InterpreterReader = InterpreterReader {
- _nativeTypes :: !(Container PuppetTypeMethods)
- _getStatement :: TopLevelType -> Text -> IO (Either Doc Statement)
- _computeTemplateFunction :: Either Text Text -> Text -> Container ScopeInformation -> IO (Either Doc Text)
- _pdbAPI :: PuppetDBAPI
- _externalFunctions :: Container ([PValue] -> InterpreterMonad PValue)
- _thisNodename :: Text
- _hieraQuery :: HieraQueryFunc
- newtype Warning = Warning Doc
- type InterpreterLog = Pair Priority Doc
- type InterpreterWriter = [InterpreterLog]
- warn :: (Monad m, MonadWriter InterpreterWriter m) => Doc -> m ()
- debug :: (Monad m, MonadWriter InterpreterWriter m) => Doc -> m ()
- logWriter :: (Monad m, MonadWriter InterpreterWriter m) => Priority -> Doc -> m ()
- type InterpreterMonad = ErrorT Doc (RSST InterpreterReader InterpreterWriter InterpreterState IO)
- data RIdentifier = RIdentifier {}
- data LinkType
- = RNotify
- | RRequire
- | RBefore
- | RSubscribe
- data ModifierType
- data OverrideType
- = CantOverride
- | Replace
- | CantReplace
- data ResourceCollectorType
- data ResourceModifier = ResourceModifier {}
- data LinkInformation = LinkInformation {
- _linksrc :: !RIdentifier
- _linkdst :: !RIdentifier
- _linkType :: !LinkType
- _linkPos :: !PPosition
- type EdgeMap = HashMap RIdentifier [LinkInformation]
- data Resource = Resource {
- _rid :: !RIdentifier
- _ralias :: !(HashSet Text)
- _rattributes :: !(Container PValue)
- _rrelations :: !(HashMap RIdentifier (HashSet LinkType))
- _rscope :: ![CurContainerDesc]
- _rvirtuality :: !Virtuality
- _rtags :: !(HashSet Text)
- _rpos :: !PPosition
- _rnode :: !Nodename
- type PuppetTypeValidate = Resource -> Either Doc Resource
- data PuppetTypeMethods = PuppetTypeMethods {}
- type FinalCatalog = HashMap RIdentifier Resource
- data DaemonMethods = DaemonMethods {
- _dGetCatalog :: Text -> Facts -> IO (Either Doc (FinalCatalog, EdgeMap, FinalCatalog))
- _dParserStats :: MStats
- _dCatalogStats :: MStats
- _dTemplateStats :: MStats
- data PuppetEdge = PuppetEdge RIdentifier RIdentifier LinkType
- data WireCatalog = WireCatalog {}
- data PFactInfo = PFactInfo {}
- data PNodeInfo = PNodeInfo {}
- data PuppetDBAPI = PuppetDBAPI {
- pdbInformation :: IO Doc
- replaceCatalog :: WireCatalog -> IO (Either Doc ())
- replaceFacts :: [(Nodename, Facts)] -> IO (Either Doc ())
- deactivateNode :: Nodename -> IO (Either Doc ())
- getFacts :: Query FactField -> IO (Either Doc [PFactInfo])
- getResources :: Query ResourceField -> IO (Either Doc [Resource])
- getNodes :: Query NodeField -> IO (Either Doc [PNodeInfo])
- commitDB :: IO (Either Doc ())
- getResourcesOfNode :: Nodename -> Query ResourceField -> IO (Either Doc [Resource])
- data Query a
- data FactField
- data NodeField
- data ResourceField
- class HasRIdentifier t where
- rIdentifier :: Lens' t RIdentifier
- iname :: Lens' t Text
- itype :: Lens' t Text
- class HasResRefOverride t where
- resRefOverride :: Lens' t ResRefOverride
- rrid :: Lens' t RIdentifier
- rrparams :: Lens' t (Container PValue)
- rrpos :: Lens' t PPosition
- class HasLinkInformation t where
- linkInformation :: Lens' t LinkInformation
- linkPos :: Lens' t PPosition
- linkType :: Lens' t LinkType
- linkdst :: Lens' t RIdentifier
- linksrc :: Lens' t RIdentifier
- class HasResDefaults t where
- class HasResourceModifier t where
- resourceModifier :: Lens' t ResourceModifier
- rmDeclaration :: Lens' t PPosition
- rmModifierType :: Lens' t ModifierType
- rmMutation :: Lens' t (Resource -> InterpreterMonad Resource)
- rmResType :: Lens' t Text
- rmSearch :: Lens' t RSearchExpression
- rmType :: Lens' t ResourceCollectorType
- class HasDaemonMethods t where
- daemonMethods :: Lens' t DaemonMethods
- dCatalogStats :: Lens' t MStats
- dGetCatalog :: Lens' t (Text -> Facts -> IO (Either Doc (FinalCatalog, EdgeMap, FinalCatalog)))
- dParserStats :: Lens' t MStats
- dTemplateStats :: Lens' t MStats
- class HasPuppetTypeMethods t where
- class HasScopeInformation t where
- scopeInformation :: Lens' t ScopeInformation
- scopeContainer :: Lens' t CurContainer
- scopeDefaults :: Lens' t (Container ResDefaults)
- scopeExtraTags :: Lens' t (HashSet Text)
- scopeOverrides :: Lens' t (HashMap RIdentifier ResRefOverride)
- scopeParent :: Lens' t (Maybe Text)
- scopeVariables :: Lens' t (Container (Pair (Pair PValue PPosition) CurContainerDesc))
- class HasResource t where
- resource :: Lens' t Resource
- ralias :: Lens' t (HashSet Text)
- rattributes :: Lens' t (Container PValue)
- rid :: Lens' t RIdentifier
- rnode :: Lens' t Nodename
- rpos :: Lens' t PPosition
- rrelations :: Lens' t (HashMap RIdentifier (HashSet LinkType))
- rscope :: Lens' t [CurContainerDesc]
- rtags :: Lens' t (HashSet Text)
- rvirtuality :: Lens' t Virtuality
- class HasInterpreterState t where
- interpreterState :: Lens' t InterpreterState
- curPos :: Lens' t PPosition
- curScope :: Lens' t [CurContainerDesc]
- definedResources :: Lens' t (HashMap RIdentifier Resource)
- extraRelations :: Lens' t [LinkInformation]
- loadedClasses :: Lens' t (Container (Pair ClassIncludeType PPosition))
- nestedDeclarations :: Lens' t (HashMap (TopLevelType, Text) Statement)
- resMod :: Lens' t [ResourceModifier]
- scopes :: Lens' t (Container ScopeInformation)
- class HasInterpreterReader t where
- interpreterReader :: Lens' t InterpreterReader
- computeTemplateFunction :: Lens' t (Either Text Text -> Text -> Container ScopeInformation -> IO (Either Doc Text))
- externalFunctions :: Lens' t (Container ([PValue] -> InterpreterMonad PValue))
- getStatement :: Lens' t (TopLevelType -> Text -> IO (Either Doc Statement))
- hieraQuery :: Lens' t HieraQueryFunc
- nativeTypes :: Lens' t (Container PuppetTypeMethods)
- pdbAPI :: Lens' t PuppetDBAPI
- thisNodename :: Lens' t Text
- class HasCurContainer t where
- curContainer :: Lens' t CurContainer
- cctags :: Lens' t (HashSet Text)
- cctype :: Lens' t CurContainerDesc
- class HasNodename c e | c -> e where
- class HasWVersion c e | c -> e where
- class HasWEdges c e | c -> e where
- class HasWResources c e | c -> e where
- wResources :: Lens' c e
- class HasTransactionUUID c e | c -> e where
- transactionUUID :: Lens' c e
- _wirecatalogWVersionLens :: Lens' WireCatalog Text
- _wirecatalogWResourcesLens :: Lens' WireCatalog (Vector Resource)
- _wirecatalogWEdgesLens :: Lens' WireCatalog (Vector PuppetEdge)
- _wirecatalogTransactionUUIDLens :: Lens' WireCatalog Text
- _wirecatalogNodenameLens :: Lens' WireCatalog Nodename
- class HasFactname c e | c -> e where
- class HasFactval c e | c -> e where
- _pfactinfoNodenameLens :: Lens' PFactInfo Text
- _pfactinfoFactvalLens :: Lens' PFactInfo Text
- _pfactinfoFactnameLens :: Lens' PFactInfo Text
- class HasDeactivated c e | c -> e where
- deactivated :: Lens' c e
- class HasCatalogT c e | c -> e where
- class HasFactsT c e | c -> e where
- class HasReportT c e | c -> e where
- _pnodeinfoReportTLens :: Lens' PNodeInfo (Maybe UTCTime)
- _pnodeinfoNodenameLens :: Lens' PNodeInfo Nodename
- _pnodeinfoFactsTLens :: Lens' PNodeInfo (Maybe UTCTime)
- _pnodeinfoDeactivatedLens :: Lens' PNodeInfo Bool
- _pnodeinfoCatalogTLens :: Lens' PNodeInfo (Maybe UTCTime)
- rcurcontainer :: Resource -> CurContainerDesc
- throwPosError :: Doc -> InterpreterMonad a
- getCurContainer :: InterpreterMonad CurContainer
- scopeName :: CurContainerDesc -> Text
- getScopeName :: InterpreterMonad Text
- getScope :: InterpreterMonad CurContainerDesc
- eitherDocIO :: IO (Either Doc a) -> IO (Either Doc a)
- interpreterIO :: IO (Either Doc a) -> InterpreterMonad a
- safeDecodeUtf8 :: ByteString -> InterpreterMonad Text
- interpreterError :: InterpreterMonad (Either Doc a) -> InterpreterMonad a
- resourceRelations :: Resource -> [(RIdentifier, LinkType)]
- ifromList :: (Monoid m, At m) => [(Index m, IxValue m)] -> m
- ikeys :: (Eq k, Hashable k) => HashMap k v -> HashSet k
- isingleton :: (Monoid b, At b) => Index b -> IxValue b -> b
- ifromListWith :: (Monoid m, At m) => (IxValue m -> IxValue m -> IxValue m) -> [(Index m, IxValue m)] -> m
- iinsertWith :: At m => (IxValue m -> IxValue m -> IxValue m) -> Index m -> IxValue m -> m -> m
- iunionWith :: (Hashable k, Eq k) => (v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
- fnull :: (Eq x, Monoid x) => x -> Bool
- rel2text :: LinkType -> Text
- rid2text :: RIdentifier -> Text
Documentation
data PValue
data HieraQueryType
The different kind of hiera queries
Constructors
Priority | standard hiera query |
ArrayMerge | hiera_array |
HashMerge | hiera_hash |
type HieraQueryFunc = Container ScopeInformation -> Text -> HieraQueryType -> IO (Either Doc (Pair InterpreterWriter (Maybe PValue)))
The type of the Hiera API function
data RSearchExpression
Constructors
REqualitySearch !Text !PValue | |
RNonEqualitySearch !Text !PValue | |
RAndSearch !RSearchExpression !RSearchExpression | |
ROrSearch !RSearchExpression !RSearchExpression | |
RAlwaysTrue |
Instances
data TopLevelType
This type is used to differenciate the distinct top level types that are exposed by the DSL.
Constructors
TopNode | This is for node entries. |
TopDefine | This is for defines. |
TopClass | This is for classes. |
TopSpurious | This one is special. It represents top level statements that are not part of a node, define or class. It is defined as spurious because it is not what you are supposed to be. Also the caching system doesn't like them too much right now. |
data ResDefaults
Constructors
ResDefaults | |
Fields
|
Instances
data CurContainerDesc
Constructors
ContRoot | Contained at node or root level |
ContClass !Text | Contained in a class |
ContDefine !Text !Text | Contained in a define |
ContImported !CurContainerDesc | Dummy container for imported resources, so that we know we must update the nodename |
ContImport !Nodename !CurContainerDesc | This one is used when finalizing imported resources, and contains the current node name |
data CurContainer
Constructors
CurContainer | |
Fields
|
Instances
data ScopeInformation
Constructors
ScopeInformation | |
Fields
|
Instances
data InterpreterState
Constructors
InterpreterState | |
Fields
|
Instances
data InterpreterReader
Constructors
InterpreterReader | |
Fields
|
Instances
type InterpreterLog = Pair Priority Doc
type InterpreterWriter = [InterpreterLog]
warn :: (Monad m, MonadWriter InterpreterWriter m) => Doc -> m ()
debug :: (Monad m, MonadWriter InterpreterWriter m) => Doc -> m ()
logWriter :: (Monad m, MonadWriter InterpreterWriter m) => Priority -> Doc -> m ()
data RIdentifier
Constructors
RIdentifier | |
data ModifierType
Constructors
ModifierCollector | For collectors, optional resources |
ModifierMustMatch | For stuff like realize |
Instances
data OverrideType
Constructors
CantOverride | Overriding forbidden, will throw an error |
Replace | Can silently replace |
CantReplace | Silently ignore errors |
Constructors
RealizeVirtual | |
RealizeCollected | |
DontRealize |
Instances
data ResourceModifier
Constructors
ResourceModifier | |
Fields
|
data LinkInformation
Constructors
LinkInformation | |
Fields
|
Instances
type EdgeMap = HashMap RIdentifier [LinkInformation]
data Resource
This is a fully resolved resource that will be used in the
FinalCatalog
.
Constructors
Resource | |
Fields
|
type PuppetTypeValidate = Resource -> Either Doc Resource
This is a function type than can be bound. It is the type of all subsequent validators.
type FinalCatalog = HashMap RIdentifier Resource
data DaemonMethods
Constructors
DaemonMethods | |
Fields
|
Instances
data WireCatalog
Constructors
WireCatalog | |
Fields |
data PFactInfo
Constructors
PFactInfo | |
Fields
|
data PNodeInfo
Constructors
PNodeInfo | |
Fields
|
data PuppetDBAPI
Constructors
PuppetDBAPI | |
Fields
|
data Query a
Pretty straightforward way to define the various PuppetDB queries
data FactField
Fields for the fact endpoint
data NodeField
Fields for the node endpoint
class HasRIdentifier t where
Instances
class HasResRefOverride t where
Methods
resRefOverride :: Lens' t ResRefOverride
rrid :: Lens' t RIdentifier
Instances
class HasLinkInformation t where
Methods
linkInformation :: Lens' t LinkInformation
linkdst :: Lens' t RIdentifier
linksrc :: Lens' t RIdentifier
Instances
class HasResDefaults t where
Instances
class HasResourceModifier t where
Methods
resourceModifier :: Lens' t ResourceModifier
rmDeclaration :: Lens' t PPosition
rmModifierType :: Lens' t ModifierType
rmMutation :: Lens' t (Resource -> InterpreterMonad Resource)
Instances
class HasDaemonMethods t where
Methods
daemonMethods :: Lens' t DaemonMethods
dCatalogStats :: Lens' t MStats
dGetCatalog :: Lens' t (Text -> Facts -> IO (Either Doc (FinalCatalog, EdgeMap, FinalCatalog)))
dParserStats :: Lens' t MStats
dTemplateStats :: Lens' t MStats
Instances
class HasPuppetTypeMethods t where
Instances
class HasScopeInformation t where
Methods
scopeInformation :: Lens' t ScopeInformation
scopeContainer :: Lens' t CurContainer
scopeDefaults :: Lens' t (Container ResDefaults)
scopeExtraTags :: Lens' t (HashSet Text)
scopeOverrides :: Lens' t (HashMap RIdentifier ResRefOverride)
scopeParent :: Lens' t (Maybe Text)
scopeVariables :: Lens' t (Container (Pair (Pair PValue PPosition) CurContainerDesc))
Instances
class HasResource t where
Methods
ralias :: Lens' t (HashSet Text)
rattributes :: Lens' t (Container PValue)
rid :: Lens' t RIdentifier
rrelations :: Lens' t (HashMap RIdentifier (HashSet LinkType))
rscope :: Lens' t [CurContainerDesc]
rtags :: Lens' t (HashSet Text)
rvirtuality :: Lens' t Virtuality
Instances
class HasInterpreterState t where
Methods
interpreterState :: Lens' t InterpreterState
curScope :: Lens' t [CurContainerDesc]
definedResources :: Lens' t (HashMap RIdentifier Resource)
extraRelations :: Lens' t [LinkInformation]
loadedClasses :: Lens' t (Container (Pair ClassIncludeType PPosition))
nestedDeclarations :: Lens' t (HashMap (TopLevelType, Text) Statement)
resMod :: Lens' t [ResourceModifier]
scopes :: Lens' t (Container ScopeInformation)
Instances
class HasInterpreterReader t where
Methods
interpreterReader :: Lens' t InterpreterReader
computeTemplateFunction :: Lens' t (Either Text Text -> Text -> Container ScopeInformation -> IO (Either Doc Text))
externalFunctions :: Lens' t (Container ([PValue] -> InterpreterMonad PValue))
getStatement :: Lens' t (TopLevelType -> Text -> IO (Either Doc Statement))
hieraQuery :: Lens' t HieraQueryFunc
nativeTypes :: Lens' t (Container PuppetTypeMethods)
pdbAPI :: Lens' t PuppetDBAPI
thisNodename :: Lens' t Text
Instances
class HasCurContainer t where
Methods
curContainer :: Lens' t CurContainer
cctags :: Lens' t (HashSet Text)
cctype :: Lens' t CurContainerDesc
Instances
class HasNodename c e | c -> e where
class HasWVersion c e | c -> e where
Instances
class HasWEdges c e | c -> e where
Instances
class HasCatalogT c e | c -> e where
Instances
class HasFactsT c e | c -> e where
class HasReportT c e | c -> e where
Instances
throwPosError :: Doc -> InterpreterMonad a
scopeName :: CurContainerDesc -> Text
interpreterIO :: IO (Either Doc a) -> InterpreterMonad a
interpreterError :: InterpreterMonad (Either Doc a) -> InterpreterMonad a
resourceRelations :: Resource -> [(RIdentifier, LinkType)]
ifromList :: (Monoid m, At m) => [(Index m, IxValue m)] -> m
helper for hashmap, in case we want another kind of map ..
isingleton :: (Monoid b, At b) => Index b -> IxValue b -> b
ifromListWith :: (Monoid m, At m) => (IxValue m -> IxValue m -> IxValue m) -> [(Index m, IxValue m)] -> m
rid2text :: RIdentifier -> Text