module Puppet.Lens
(
_PResolveExpression
, _PResolveValue
, _PHash
, _PBoolean
, _PString
, _PNumber
, _PResourceReference
, _PUndef
, _PArray
, _PParse
, _ResourceDeclaration
, _DefaultDeclaration
, _ResourceOverride
, _ConditionalStatement
, _ClassDeclaration
, _DefineDeclaration
, _Node
, _VariableAssignment
, _MainFunctionCall
, _SHFunctionCall
, _ResourceCollection
, _Dependency
, _TopContainer
, _Statements
, _ResourceDeclaration'
, _DefaultDeclaration'
, _ResourceOverride'
, _ConditionalStatement'
, _ClassDeclaration'
, _DefineDeclaration'
, _Node'
, _VariableAssignment'
, _MainFunctionCall'
, _SHFunctionCall'
, _ResourceCollection'
, _Dependency'
, _Equal
, _Different
, _Not
, _And
, _Or
, _LessThan
, _MoreThan
, _LessEqualThan
, _MoreEqualThan
, _RegexMatch
, _NotRegexMatch
, _Contains
, _Addition
, _Substraction
, _Division
, _Multiplication
, _Modulo
, _RightShift
, _LeftShift
, _Lookup
, _Negate
, _ConditionalValue
, _FunctionApplication
, _Terminal
) where
import Control.Lens
import Control.Applicative
import Puppet.PP (displayNocolor)
import Puppet.Parser.Types
import Puppet.Interpreter.Types
import Puppet.Interpreter.Pure
import Puppet.Interpreter.Resolve
import Puppet.Parser
import Puppet.Parser.PrettyPrinter (ppStatements)
import qualified Data.Vector as V
import qualified Data.HashMap.Strict as HM
import qualified Data.Text as T
import qualified Data.Maybe.Strict as S
import Data.Tuple.Strict hiding (uncurry)
import Text.Parser.Combinators (eof)
makePrisms ''PValue
makePrisms ''Expression
makePrisms ''ResDec
makePrisms ''DefaultDec
makePrisms ''ResOver
makePrisms ''CondStatement
makePrisms ''ClassDecl
makePrisms ''DefineDec
makePrisms ''Nd
makePrisms ''VarAss
makePrisms ''MFC
makePrisms ''SFC
makePrisms ''RColl
makePrisms ''Dep
_ResourceDeclaration' :: Prism' Statement ResDec
_ResourceDeclaration' = prism ResourceDeclaration $ \x -> case x of
ResourceDeclaration a -> Right a
_ -> Left x
_DefaultDeclaration' :: Prism' Statement DefaultDec
_DefaultDeclaration' = prism DefaultDeclaration $ \x -> case x of
DefaultDeclaration a -> Right a
_ -> Left x
_ResourceOverride' :: Prism' Statement ResOver
_ResourceOverride' = prism ResourceOverride $ \x -> case x of
ResourceOverride a -> Right a
_ -> Left x
_ConditionalStatement' :: Prism' Statement CondStatement
_ConditionalStatement' = prism ConditionalStatement $ \x -> case x of
ConditionalStatement a -> Right a
_ -> Left x
_ClassDeclaration' :: Prism' Statement ClassDecl
_ClassDeclaration' = prism ClassDeclaration $ \x -> case x of
ClassDeclaration a -> Right a
_ -> Left x
_DefineDeclaration' :: Prism' Statement DefineDec
_DefineDeclaration' = prism DefineDeclaration $ \x -> case x of
DefineDeclaration a -> Right a
_ -> Left x
_Node' :: Prism' Statement Nd
_Node' = prism Node $ \x -> case x of
Node a -> Right a
_ -> Left x
_VariableAssignment' :: Prism' Statement VarAss
_VariableAssignment' = prism VariableAssignment $ \x -> case x of
VariableAssignment a -> Right a
_ -> Left x
_MainFunctionCall' :: Prism' Statement MFC
_MainFunctionCall' = prism MainFunctionCall $ \x -> case x of
MainFunctionCall a -> Right a
_ -> Left x
_SHFunctionCall' :: Prism' Statement SFC
_SHFunctionCall' = prism SHFunctionCall $ \x -> case x of
SHFunctionCall a -> Right a
_ -> Left x
_ResourceCollection' :: Prism' Statement RColl
_ResourceCollection' = prism ResourceCollection $ \x -> case x of
ResourceCollection a -> Right a
_ -> Left x
_Dependency' :: Prism' Statement Dep
_Dependency' = prism Dependency $ \x -> case x of
Dependency a -> Right a
_ -> Left x
_TopContainer :: Prism' Statement (V.Vector Statement, Statement)
_TopContainer = prism (uncurry TopContainer) $ \x -> case x of
TopContainer vs s -> Right (vs,s)
_ -> Left x
_ResourceDeclaration :: Prism' Statement (T.Text, Expression, V.Vector (Pair T.Text Expression), Virtuality, PPosition)
_ResourceDeclaration = _ResourceDeclaration' . _ResDec
_DefaultDeclaration :: Prism' Statement (T.Text, V.Vector (Pair T.Text Expression), PPosition)
_DefaultDeclaration = _DefaultDeclaration' . _DefaultDec
_ResourceOverride :: Prism' Statement (T.Text, Expression, V.Vector (Pair T.Text Expression), PPosition)
_ResourceOverride = _ResourceOverride' . _ResOver
_ConditionalStatement :: Prism' Statement (V.Vector (Pair Expression (V.Vector Statement)), PPosition)
_ConditionalStatement = _ConditionalStatement' . _CondStatement
_ClassDeclaration :: Prism' Statement (T.Text, V.Vector (Pair T.Text (S.Maybe Expression)), S.Maybe T.Text, V.Vector Statement, PPosition)
_ClassDeclaration = _ClassDeclaration' . _ClassDecl
_DefineDeclaration :: Prism' Statement (T.Text, V.Vector (Pair T.Text (S.Maybe Expression)), V.Vector Statement, PPosition)
_DefineDeclaration = _DefineDeclaration' . _DefineDec
_Node :: Prism' Statement (NodeDesc, V.Vector Statement, S.Maybe NodeDesc, PPosition)
_Node = _Node' . _Nd
_VariableAssignment :: Prism' Statement (T.Text, Expression, PPosition)
_VariableAssignment = _VariableAssignment' . _VarAss
_MainFunctionCall :: Prism' Statement (T.Text, V.Vector Expression, PPosition)
_MainFunctionCall = _MainFunctionCall' . _MFC
_SHFunctionCall :: Prism' Statement (HFunctionCall, PPosition)
_SHFunctionCall = _SHFunctionCall' . _SFC
_ResourceCollection :: Prism' Statement (CollectorType, T.Text, SearchExpression, V.Vector (Pair T.Text Expression), PPosition)
_ResourceCollection = _ResourceCollection' . _RColl
_Dependency :: Prism' Statement (Pair T.Text Expression, Pair T.Text Expression, LinkType, PPosition)
_Dependency = _Dependency' . _Dep
_PResolveExpression :: Prism' Expression PValue
_PResolveExpression = prism reinject extract
where
extract e = case dummyEval (resolveExpression e) of
Right x -> Right x
Left _ -> Left e
reinject = Terminal . review _PResolveValue
_PResolveValue :: Prism' UValue PValue
_PResolveValue = prism toU toP
where
toP uv = case dummyEval (resolveValue uv) of
Right x -> Right x
Left _ -> Left uv
toU (PBoolean x) = UBoolean x
toU (PNumber x) = UNumber x
toU PUndef = UUndef
toU (PString s) = UString s
toU (PResourceReference t n) = UResourceReference t (Terminal (UString n))
toU (PArray r) = UArray (fmap (Terminal . toU) r)
toU (PHash h) = UHash (V.fromList $ map (\(k,v) -> (Terminal (UString k) :!: Terminal (toU v))) $ HM.toList h)
_PParse :: Prism' T.Text (V.Vector Statement)
_PParse = prism dspl prs
where
prs i = case runPParser (puppetParser <* eof) "dummy" i of
Left _ -> Left i
Right x -> Right x
dspl = T.pack . displayNocolor . ppStatements
_Statements :: Lens' Statement [Statement]
_Statements = lens (V.toList . sget) (\s v -> sset s (V.fromList v))
where
sget :: Statement -> V.Vector Statement
sget (ClassDeclaration (ClassDecl _ _ _ s _)) = s
sget (DefineDeclaration (DefineDec _ _ s _)) = s
sget (Node (Nd _ s _ _)) = s
sget (TopContainer s _) = s
sget (SHFunctionCall (SFC (HFunctionCall _ _ _ s _) _)) = s
sget _ = V.empty
sset :: Statement -> V.Vector Statement -> Statement
sset (ClassDeclaration (ClassDecl n args inh _ p)) s = ClassDeclaration (ClassDecl n args inh s p)
sset (Node (Nd ns _ nd' p)) s = Node (Nd ns s nd' p)
sset (DefineDeclaration (DefineDec n args _ p)) s = DefineDeclaration (DefineDec n args s p)
sset (TopContainer _ p) s = TopContainer s p
sset (SHFunctionCall (SFC (HFunctionCall t e pr _ e2) p)) s = SHFunctionCall (SFC (HFunctionCall t e pr s e2) p)
sset x _ = x