module Puppet.Parser.Types
(
Position,
PPosition,
initialPPos,
toPPos,
lSourceName,
lSourceLine,
lSourceColumn,
capitalize',
capitalizeRT,
array,
toBool,
rel2text,
Expression(..),
SelectorCase(..),
UValue(..),
HigherFuncType(..),
HFunctionCall(..),
HasHFunctionCall(..),
BlockParameters(..),
CompRegex(..),
CollectorType(..),
Virtuality(..),
NodeDesc(..),
LinkType(..),
SearchExpression(..),
Statement(..),
ResDec(..),
DefaultDec(..),
ResOver(..),
CondStatement(..),
ClassDecl(..),
DefineDec(..),
Nd(..),
VarAss(..),
MFC(..),
SFC(..),
RColl(..),
Dep(..)
) where
import Control.Lens
import Data.Aeson
import Data.Char (toUpper)
import Data.Hashable
import qualified Data.Maybe.Strict as S
import Data.Scientific
import Data.String
import qualified Data.Text as T
import Data.Tuple.Strict
import qualified Data.Vector as V
import GHC.Generics
import Text.Regex.PCRE.String
import Text.Parsec.Pos
capitalizeRT :: T.Text -> T.Text
capitalizeRT = T.intercalate "::" . map capitalize' . T.splitOn "::"
capitalize' :: T.Text -> T.Text
capitalize' t | T.null t = T.empty
| otherwise = T.cons (toUpper (T.head t)) (T.tail t)
type PPosition = Pair Position Position
type Position = SourcePos
lSourceName :: Lens' Position SourceName
lSourceName = lens sourceName setSourceName
lSourceLine :: Lens' Position Line
lSourceLine = lens sourceLine setSourceLine
lSourceColumn :: Lens' Position Column
lSourceColumn = lens sourceColumn setSourceColumn
initialPPos :: T.Text -> PPosition
initialPPos x =
let i = initialPos (T.unpack x)
in (i :!: i)
toPPos :: T.Text -> Int -> PPosition
toPPos fl ln =
let p = newPos (T.unpack fl) ln (1)
in (p :!: p)
data HigherFuncType = HFEach
| HFMap
| HFReduce
| HFFilter
| HFSlice
deriving (Eq, Show)
data BlockParameters = BPSingle !T.Text
| BPPair !T.Text !T.Text
deriving (Eq, Show)
data HFunctionCall = HFunctionCall
{ _hftype :: !HigherFuncType
, _hfexpr :: !(S.Maybe Expression)
, _hfparams :: !BlockParameters
, _hfstatements :: !(V.Vector Statement)
, _hfexpression :: !(S.Maybe Expression)
} deriving (Eq,Show)
data CompRegex = CompRegex !T.Text !Regex
instance Show CompRegex where
show (CompRegex t _) = show t
instance Eq CompRegex where
(CompRegex a _) == (CompRegex b _) = a == b
data UValue
= UBoolean !Bool
| UString !T.Text
| UInterpolable !(V.Vector Expression)
| UUndef
| UResourceReference !T.Text !Expression
| UArray !(V.Vector Expression)
| UHash !(V.Vector (Pair Expression Expression))
| URegexp !CompRegex
| UVariableReference !T.Text
| UFunctionCall !T.Text !(V.Vector Expression)
| UHFunctionCall !HFunctionCall
| UNumber Scientific
deriving (Show, Eq)
instance IsString UValue where
fromString = UString . T.pack
array :: [Expression] -> UValue
array = UArray . V.fromList
data SelectorCase = SelectorValue UValue
| 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 !(V.Vector (Pair SelectorCase Expression))
| FunctionApplication !Expression !Expression
| Terminal !UValue
deriving (Eq, Show)
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 !T.Text !Expression
| NonEqualitySearch !T.Text !Expression
| AndSearch !SearchExpression !SearchExpression
| OrSearch !SearchExpression !SearchExpression
| AlwaysTrue
deriving (Eq, Show)
data CollectorType = Collector | ExportedCollector
deriving (Eq, Show)
toBool :: UValue -> Bool
toBool (UString "") = False
toBool (UInterpolable v) = not (V.null v)
toBool UUndef = False
toBool (UBoolean x) = x
toBool _ = True
data Virtuality = Normal
| Virtual
| Exported
| ExportedRealized
deriving (Generic, Eq, Show)
data NodeDesc = NodeName !T.Text
| NodeMatch !CompRegex
| NodeDefault
deriving (Show, Eq)
data LinkType = RNotify | RRequire | RBefore | RSubscribe deriving(Show, Eq,Generic)
instance Hashable LinkType
rel2text :: LinkType -> T.Text
rel2text RNotify = "notify"
rel2text RRequire = "require"
rel2text RBefore = "before"
rel2text RSubscribe = "subscribe"
instance FromJSON LinkType where
parseJSON (String "require") = return RRequire
parseJSON (String "notify") = return RNotify
parseJSON (String "subscribe") = return RSubscribe
parseJSON (String "before") = return RBefore
parseJSON _ = fail "invalid linktype"
instance ToJSON LinkType where
toJSON = String . rel2text
data ResDec = ResDec !T.Text !Expression !(V.Vector (Pair T.Text Expression)) !Virtuality !PPosition deriving (Eq, Show)
data DefaultDec = DefaultDec !T.Text !(V.Vector (Pair T.Text Expression)) !PPosition deriving (Eq, Show)
data ResOver = ResOver !T.Text !Expression !(V.Vector (Pair T.Text Expression)) !PPosition deriving (Eq, Show)
data CondStatement = CondStatement !(V.Vector (Pair Expression (V.Vector Statement))) !PPosition deriving (Eq, Show)
data ClassDecl = ClassDecl !T.Text !(V.Vector (Pair T.Text (S.Maybe Expression))) !(S.Maybe T.Text) !(V.Vector Statement) !PPosition deriving (Eq, Show)
data DefineDec = DefineDec !T.Text !(V.Vector (Pair T.Text (S.Maybe Expression))) !(V.Vector Statement) !PPosition deriving (Eq, Show)
data Nd = Nd !NodeDesc !(V.Vector Statement) !(S.Maybe NodeDesc) !PPosition deriving (Eq, Show)
data VarAss = VarAss !T.Text !Expression !PPosition deriving (Eq, Show)
data MFC = MFC !T.Text !(V.Vector Expression) !PPosition deriving (Eq, Show)
data SFC = SFC !HFunctionCall !PPosition deriving (Eq, Show)
data RColl = RColl !CollectorType !T.Text !SearchExpression !(V.Vector (Pair T.Text Expression)) !PPosition deriving (Eq, Show)
data Dep = Dep !(Pair T.Text Expression) !(Pair T.Text Expression) !LinkType !PPosition deriving (Eq, Show)
data Statement
= ResourceDeclaration !ResDec
| DefaultDeclaration !DefaultDec
| ResourceOverride !ResOver
| ConditionalStatement !CondStatement
| ClassDeclaration !ClassDecl
| DefineDeclaration !DefineDec
| Node !Nd
| VariableAssignment !VarAss
| MainFunctionCall !MFC
| SHFunctionCall !SFC
| ResourceCollection !RColl
| Dependency !Dep
| TopContainer !(V.Vector Statement) !Statement
deriving (Eq, Show)
makeClassy ''HFunctionCall