Safe Haskell | None |
---|
- 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
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
data TopLevelType
This type is used to differenciate the distinct top level types that are exposed by the DSL.
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
ResDefaults | |
|
data CurContainerDesc
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
CurContainer | |
|
data ScopeInformation
ScopeInformation | |
|
data InterpreterState
InterpreterState | |
|
data InterpreterReader
InterpreterReader | |
|
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
data LinkType
Relationship link type.
data ModifierType
ModifierCollector | For collectors, optional resources |
ModifierMustMatch | For stuff like realize |
data OverrideType
CantOverride | Overriding forbidden, will throw an error |
Replace | Can silently replace |
CantReplace | Silently ignore errors |
data ResourceModifier
data LinkInformation
LinkInformation | |
|
type EdgeMap = HashMap RIdentifier [LinkInformation]
data Resource
This is a fully resolved resource that will be used in the
FinalCatalog
.
Resource | |
|
type PuppetTypeValidate = Resource -> Either Doc Resource
This is a function type than can be bound. It is the type of all subsequent validators.
data PuppetTypeMethods
type FinalCatalog = HashMap RIdentifier Resource
data DaemonMethods
DaemonMethods | |
|
data PuppetEdge
data WireCatalog
data PFactInfo
data PNodeInfo
PNodeInfo | |
|
data PuppetDBAPI
PuppetDBAPI | |
|
data Query a
Pretty straightforward way to define the various PuppetDB queries
data FactField
Fields for the fact endpoint
data ResourceField
Fields for the resource endpoint
class HasRIdentifier t where
class HasResRefOverride t where
resRefOverride :: Lens' t ResRefOverride
rrid :: Lens' t RIdentifier
class HasLinkInformation t where
linkInformation :: Lens' t LinkInformation
linkdst :: Lens' t RIdentifier
linksrc :: Lens' t RIdentifier
class HasResDefaults t where
resDefaults :: Lens' t ResDefaults
defSrcScope :: Lens' t Text
class HasResourceModifier t where
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
puppetTypeMethods :: Lens' t PuppetTypeMethods
puppetFields :: Lens' t (HashSet Text)
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
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
class HasInterpreterState t where
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)
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 HasWResources c e | c -> e where
wResources :: Lens' c e
class HasTransactionUUID c e | c -> e where
transactionUUID :: Lens' c e
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