{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-}
-- | All the types used for parsing, and helpers working on these types.
module Puppet.Parser.Types
( -- * Position management
Position,
PPosition,
initialPPos,
toPPos,
-- ** Lenses
lSourceName,
lSourceLine,
lSourceColumn,
-- * Helpers
capitalizeRT,
rel2text,
-- * Types
-- ** Expressions
Expression(..),
SelectorCase(..),
UValue(..),
HigherFuncType(..),
HFunctionCall(..),
HasHFunctionCall(..),
BlockParameters(..),
CompRegex(..),
CollectorType(..),
Virtuality(..),
NodeDesc(..),
LinkType(..),
-- ** Search Expressions
SearchExpression(..),
-- ** Statements
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.Parsec.Pos
import Text.Regex.PCRE.String
-- | Properly capitalizes resource types
capitalizeRT :: T.Text -> T.Text
capitalizeRT = T.intercalate "::" . map capitalize' . T.splitOn "::"
where
capitalize' :: T.Text -> T.Text
capitalize' t | T.null t = T.empty
| otherwise = T.cons (toUpper (T.head t)) (T.tail t)
-- | A pair containing the start and end of a given token.
type PPosition = Pair Position Position
-- | Position in a puppet file. Currently an alias to 'SourcePos'.
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
-- | Generates an initial position based on a filename.
initialPPos :: T.Text -> PPosition
initialPPos x =
let i = initialPos (T.unpack x)
in (i :!: i)
-- | Generates a 'PPosition' based on a filename and line number.
toPPos :: T.Text -> Int -> PPosition
toPPos fl ln =
let p = newPos (T.unpack fl) ln (-1)
in (p :!: p)
-- | The distinct Puppet /higher order functions/
data HigherFuncType = HFEach
| HFMap
| HFReduce
| HFFilter
| HFSlice
deriving (Eq, Show)
-- | Currently only two types of block parameters are supported, single
-- values and pairs.
data BlockParameters = BPSingle !T.Text -- ^ @|k|@
| BPPair !T.Text !T.Text -- ^ @|k,v|@
deriving (Eq, Show)
-- The description of the /higher level function/ call.
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
-- | An unresolved value, typically the parser's output.
data UValue
= UBoolean !Bool -- ^ Special tokens generated when parsing the @true@ or @false@ literals.
| UString !T.Text -- ^ Raw string.
| UInterpolable !(V.Vector Expression) -- ^ A string that might contain variable references. The type should be refined at one point.
| UUndef -- ^ Special token that is generated when parsing the @undef@ literal.
| UResourceReference !T.Text !Expression -- ^ A Resource[reference]
| UArray !(V.Vector Expression)
| UHash !(V.Vector (Pair Expression Expression))
| URegexp !CompRegex -- ^ The regular expression compilation is performed during parsing.
| UVariableReference !T.Text
| UFunctionCall !T.Text !(V.Vector Expression)
| UHFunctionCall !HFunctionCall
| UNumber Scientific
deriving (Show, Eq)
instance IsString UValue where
fromString = UString . T.pack
data SelectorCase = SelectorValue UValue
| SelectorDefault
deriving (Eq, Show)
-- | The 'Expression's
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)) -- ^ All conditionals are stored in this format.
| FunctionApplication !Expression !Expression -- ^ This is for /higher order functions/.
| 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)
data Virtuality = Normal -- ^ Normal resource, that will be included in the catalog
| Virtual -- ^ Type for virtual resources
| Exported -- ^ Type for exported resources
| ExportedRealized -- ^ These are resources that are exported AND included in the catalog
deriving (Generic, Eq, Show)
data NodeDesc = NodeName !T.Text
| NodeMatch !CompRegex
| NodeDefault
deriving (Show, Eq)
-- | Relationship link type.
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)
-- | All types of conditional statements are stored that way (@case@, @if@, etc.)
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)
-- | /Higher order function/ call.
data SFC = SFC !HFunctionCall !PPosition deriving (Eq, Show)
-- | For all types of collectors.
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)
-- | All the possible statements
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 -- ^ This is a special statement that is used to include the expressions that are top level. This is certainly buggy, but probably just like the original implementation.
deriving (Eq, Show)
makeClassy ''HFunctionCall