-- | Types used when parsing the Puppet DSL.
-- A good knowledge of the Puppet language in required to understand them.
module Puppet.DSL.Types where

import Text.Parsec.Pos

data Parameters = Parameters [(Expression, Expression)] deriving(Show, Ord, Eq)

-- |This type is used to differenciate the distinct top level types that are
-- exposed by the DSL.
data TopLevelType
    -- |This is for node entries.
    = TopNode
    -- |This is for defines.
    | TopDefine
    -- |This is for classes.
    | TopClass
    -- |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.
    | TopSpurious
    deriving (Show, Ord, Eq)

-- |This function returns the 'TopLevelType' of a statement if it is either a
-- node, class or define. It returns Nothing otherwise.
convertTopLevel :: Statement -> Either Statement (TopLevelType, String, Statement)
convertTopLevel x@(Node name _ _)                 = Right (TopNode, name, x)
convertTopLevel x@(ClassDeclaration name _ _ _ _) = Right (TopClass, name, x)
convertTopLevel x@(DefineDeclaration name _ _ _)  = Right (TopDefine, name, x)
convertTopLevel x                                 = Left x

-- | The 'Value' type represents a Puppet value. It is the terminal in a puppet
-- 'Expression'
data Value
    -- |String literal.
    = Literal String
    -- |An interpolable string, represented as a 'Value' list.
    | Interpolable [Value]
    -- |A Puppet Regexp. This is very hackish as it alters the behaviour of some
    -- functions (such as conditional values).
    | PuppetRegexp String
    | Double Double
    | Integer Integer
    -- |Reference to a variable. The string contains what is acutally typed in
    -- the manifest.
    | VariableReference String
    | Empty
    | ResourceReference String Expression -- restype resname
    | PuppetArray [Expression]
    | PuppetHash Parameters
    | FunctionCall String [Expression]
    -- |This is special and quite hackish too.
    | Undefined
    deriving(Show, Ord, Eq)

data Virtuality = Normal | Virtual | Exported deriving(Show, Ord, Eq)

-- | The actual puppet statements
data Statement
    = Node String ![Statement] SourcePos -- ^ This holds the node name and list of statements.
    -- | This holds the variable name and the expression that it represents.
    | VariableAssignment String Expression SourcePos
    | Include String SourcePos
    | Import String SourcePos
    | Require String SourcePos
    -- | This holds the resource type, name, parameter list and virtuality.
    | Resource String Expression ![(Expression, Expression)] Virtuality SourcePos
    {-| This is a resource default declaration, such as File {owner => \'root\';
    }. It holds the resource type and the list of default parameters.
    -}
    | ResourceDefault String ![(Expression, Expression)] SourcePos
    {-| This works like 'Resource', but the 'Expression' holds the resource
    name.
    -}
    | ResourceOverride String Expression ![(Expression, Expression)] SourcePos
    {-| The pairs hold on the left a value that is resolved as a boolean, and on
    the right the list of statements that correspond to this. This will be
    generated by if\/then\/else statement, but also by the case statement.
    -}
    | ConditionalStatement ![(Expression, [Statement])] SourcePos
    {-| The class declaration holds the class name, the optional name of the
    class it inherits from, a list of parameters with optional default values,
    and the list of statements it contains.
    -}
    | ClassDeclaration String (Maybe String) ![(String, Maybe Expression)] ![Statement] SourcePos
    {-| The define declaration is like the 'ClassDeclaration' except it can't
    inherit from anything.
    -}
    | DefineDeclaration String ![(String, Maybe Expression)] ![Statement] SourcePos
    {-| This is the resource collection syntax (\<\<\| \|\>\>). It holds
    the conditional expression, and an eventual list of overrides. This is
    important as the same token conveys two distinct Puppet concepts : resource
    collection and resource overrides.
    -}
    | ResourceCollection String !Expression ![(Expression, Expression)] SourcePos
    -- |Same as 'ResourceCollection', but for \<\| \|\>.
    | VirtualResourceCollection String !Expression ![(Expression, Expression)] SourcePos
    | DependenceChain !(String,Expression) !(String,Expression) SourcePos
    | MainFunctionCall String ![Expression] SourcePos
    {-| This is a magic statement that is used to hold the spurious top level
    statements that comes in the same file as the correct top level statement
    that is stored in the second field. The first field contains pairs of
    filenames and statements. This is designed so that the interpreter can know
    whether it has already been evaluated.
    -}
    | TopContainer ![(String, Statement)] !Statement -- magic statement that is used to embody the spurious top level statements
    deriving(Show, Ord, Eq)

-- | Expressions will be described with a and b being the first and second field
-- of the constructor.
data Expression
    = LookupOperation !Expression !Expression -- ^ a[b]
    | IsElementOperation !Expression !Expression -- ^ a in b
    | PlusOperation !Expression !Expression -- ^ a + b
    | MinusOperation !Expression !Expression -- ^ a - b
    | DivOperation !Expression !Expression -- ^ a / b
    | MultiplyOperation !Expression !Expression -- ^ a * b
    | ShiftLeftOperation !Expression !Expression -- ^ a << b
    | ShiftRightOperation !Expression !Expression -- ^ a >> b
    | AndOperation !Expression !Expression -- ^ a & b
    | OrOperation !Expression !Expression -- ^ a | b
    | EqualOperation !Expression !Expression -- ^ a == b
    | DifferentOperation !Expression !Expression -- ^ a != b
    | AboveOperation !Expression !Expression -- ^ a > b
    | AboveEqualOperation !Expression !Expression -- ^ a >= b
    | UnderEqualOperation !Expression !Expression -- ^ a <= b
    | UnderOperation !Expression !Expression -- ^ a < b
    | RegexpOperation !Expression !Expression
    -- ^ a =~ b (b should be a 'PuppetRegexp')
    | NotRegexpOperation !Expression !Expression -- ^ a !~ b
    | NotOperation !Expression -- ^ ! a
    | NegOperation !Expression -- ^ - a
    | ConditionalValue !Expression !Expression
    -- ^ a ? b (b should be a 'PuppetHash')
    | Value Value -- ^ 'Value' terminal
	| ResolvedResourceReference String String -- ^ Resolved resource reference
    | BTrue -- ^ True expression, this could have been better to use a 'Value'
    | BFalse -- ^ False expression
    | Error String -- ^ Not used anymore.
    deriving(Show, Ord, Eq)