{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
module Puppet.Parser.Types
(
Expression(..),
SelectorCase(..),
UnresolvedValue(..),
LambdaFunc(..),
HOLambdaCall(..),
ChainableRes(..),
HasHOLambdaCall(..),
LambdaParameter(..),
LambdaParameters,
CompRegex(..),
CollectorType(..),
Virtuality(..),
NodeDesc(..),
LinkType(..),
Parser,
PuppetParseError,
UDataType(..),
SearchExpression(..),
AttributeDecl(..),
ArrowOp(..),
ConditionalDecl(..),
ClassDecl(..),
ResDefaultDecl(..),
DepDecl(..),
Statement(..),
ResDecl(..),
ResOverrideDecl(..),
DefineDecl(..),
NodeDecl(..),
VarAssignDecl(..),
MainFuncDecl(..),
HigherOrderLambdaDecl(..),
ResCollDecl(..),
Parameters
) where
import XPrelude hiding (show)
import Data.List.NonEmpty (NonEmpty)
import qualified Data.Maybe.Strict as S
import qualified Data.Text as Text
import qualified Data.Vector as V
import qualified GHC.Exts as Exts
import GHC.Show (Show (..))
import Text.Megaparsec
import Puppet.Language
type PuppetParseError = ParseError Char Void
type Parser = Parsec Void Text
newtype LambdaFunc = LambdaFunc Text deriving (Eq, Show)
type LambdaParameters = Vector LambdaParameter
data LambdaParameter
= LambdaParam !(Maybe UDataType) !Text
deriving (Eq, Show)
data HOLambdaCall
= HOLambdaCall
{ _hoLambdaFunc :: !LambdaFunc
, _hoLambdaExpr :: !(Vector Expression)
, _hoLambdaParams :: !LambdaParameters
, _hoLambdaStatements :: !(Vector Statement)
, _hoLambdaLastExpr :: !(S.Maybe Expression)
} deriving (Eq,Show)
data ChainableRes
= ChainResColl !ResCollDecl
| ChainResDecl !ResDecl
| ChainResRefr !Text [Expression] !PPosition
deriving (Show, Eq)
data AttributeDecl
= AttributeDecl !Text !ArrowOp !Expression
| AttributeWildcard !Expression
deriving (Show, Eq)
data ArrowOp
= AppendArrow
| AssignArrow
deriving (Show, Eq)
data UnresolvedValue
= UBoolean !Bool
| UString !Text
| UInterpolable !(Vector Expression)
| UUndef
| UResourceReference !Text !Expression
| UArray !(Vector Expression)
| UHash !(Vector (Pair Expression Expression))
| URegexp !CompRegex
| UVariableReference !Text
| UFunctionCall !Text !(Vector Expression)
| UHOLambdaCall !HOLambdaCall
| UNumber !Scientific
| UDataType UDataType
deriving (Show, Eq)
instance Exts.IsList UnresolvedValue where
type Item UnresolvedValue = Expression
fromList = UArray . V.fromList
toList u = case u of
UArray lst -> V.toList lst
_ -> [Terminal u]
instance IsString UnresolvedValue where
fromString = UString . Text.pack
data SelectorCase
= SelectorValue !UnresolvedValue
| SelectorType !UDataType
| SelectorDefault
deriving (Eq, Show)
data Expression
= Equal !Expression !Expression
| Different !Expression !Expression
| Not !Expression
| And !Expression !Expression
| Or !Expression !Expression
| LessThan !Expression !Expression
| MoreThan !Expression !Expression
| LessEqualThan !Expression !Expression
| MoreEqualThan !Expression !Expression
| RegexMatch !Expression !Expression
| NotRegexMatch !Expression !Expression
| Contains !Expression !Expression
| Addition !Expression !Expression
| Substraction !Expression !Expression
| Division !Expression !Expression
| Multiplication !Expression !Expression
| Modulo !Expression !Expression
| RightShift !Expression !Expression
| LeftShift !Expression !Expression
| Lookup !Expression !Expression
| Negate !Expression
| ConditionalValue !Expression !(Vector (Pair SelectorCase Expression))
| FunctionApplication !Expression !Expression
| Terminal !UnresolvedValue
deriving (Eq, Show)
data UDataType
= UDTType
| UDTString (Maybe Int) (Maybe Int)
| UDTInteger (Maybe Int) (Maybe Int)
| UDTFloat (Maybe Double) (Maybe Double)
| UDTBoolean
| UDTArray UDataType Int (Maybe Int)
| UDTHash UDataType UDataType Int (Maybe Int)
| UDTUndef
| UDTScalar
| UDTData
| UDTOptional UDataType
| UNotUndef
| UDTVariant (NonEmpty UDataType)
| UDTPattern (NonEmpty CompRegex)
| UDTEnum (NonEmpty Expression)
| UDTAny
| UDTCollection
| UDTRegexp (Maybe CompRegex)
deriving (Eq, Show)
instance Exts.IsList Expression where
type Item Expression = Expression
fromList = Terminal . Exts.fromList
toList u = case u of
Terminal t -> Exts.toList t
_ -> [u]
instance Num Expression where
(+) = Addition
(-) = Substraction
(*) = Multiplication
fromInteger = Terminal . UNumber . fromInteger
abs x = ConditionalValue (MoreEqualThan x 0) (V.fromList [SelectorValue (UBoolean True) :!: x, SelectorDefault :!: negate x])
signum x = ConditionalValue (MoreThan x 0) (V.fromList [SelectorValue (UBoolean True) :!: 1, SelectorDefault :!:
ConditionalValue (Equal x 0) (V.fromList [SelectorValue (UBoolean True) :!: 0, SelectorDefault :!: (-1)])
])
instance Fractional Expression where
(/) = Division
recip x = 1 / x
fromRational = Terminal . UNumber . fromRational
instance IsString Expression where
fromString = Terminal . fromString
data SearchExpression
= EqualitySearch !Text !Expression
| NonEqualitySearch !Text !Expression
| AndSearch !SearchExpression !SearchExpression
| OrSearch !SearchExpression !SearchExpression
| AlwaysTrue
deriving (Eq, Show)
data CollectorType
= Collector
| ExportedCollector
deriving (Eq, Show)
data NodeDesc
= NodeName !Text
| NodeMatch !CompRegex
| NodeDefault
deriving (Show, Eq)
data ResDecl = ResDecl !Text !Expression !(Vector AttributeDecl) !Virtuality !PPosition deriving (Eq, Show)
data ResDefaultDecl = ResDefaultDecl !Text !(Vector AttributeDecl) !PPosition deriving (Eq, Show)
data ResOverrideDecl = ResOverrideDecl !Text !Expression !(Vector AttributeDecl) !PPosition deriving (Eq, Show)
data ConditionalDecl = ConditionalDecl !(Vector (Pair Expression (Vector Statement))) !PPosition deriving (Eq, Show)
data ClassDecl = ClassDecl !Text !Parameters !(S.Maybe Text) !(Vector Statement) !PPosition deriving (Eq, Show)
data DefineDecl = DefineDecl !Text !Parameters !(Vector Statement) !PPosition deriving (Eq, Show)
type Parameters = Vector (Pair (Pair Text (S.Maybe UDataType)) (S.Maybe Expression))
data NodeDecl = NodeDecl !NodeDesc !(Vector Statement) !(S.Maybe NodeDesc) !PPosition deriving (Eq, Show)
data VarAssignDecl
= VarAssignDecl
{ _vadtype :: Maybe UDataType
, _vadnames :: [Text]
, _vadvalue :: !Expression
, _vadpos :: !PPosition
} deriving (Eq, Show)
data MainFuncDecl = MainFuncDecl !Text !(Vector Expression) !PPosition deriving (Eq, Show)
data HigherOrderLambdaDecl = HigherOrderLambdaDecl !HOLambdaCall !PPosition deriving (Eq, Show)
data ResCollDecl = ResCollDecl !CollectorType !Text !SearchExpression !(Vector AttributeDecl) !PPosition deriving (Eq, Show)
data DepDecl = DepDecl !(Pair Text Expression) !(Pair Text Expression) !LinkType !PPosition deriving (Eq, Show)
data Statement
= ResourceDeclaration !ResDecl
| ResourceDefaultDeclaration !ResDefaultDecl
| ResourceOverrideDeclaration !ResOverrideDecl
| ResourceCollectionDeclaration !ResCollDecl
| ClassDeclaration !ClassDecl
| DefineDeclaration !DefineDecl
| NodeDeclaration !NodeDecl
| ConditionalDeclaration !ConditionalDecl
| VarAssignmentDeclaration !VarAssignDecl
| MainFunctionDeclaration !MainFuncDecl
| HigherOrderLambdaDeclaration !HigherOrderLambdaDecl
| DependencyDeclaration !DepDecl
| TopContainer !(Vector Statement) !Statement
deriving (Eq, Show)
makeClassy ''HOLambdaCall