{-| This module exports the 'getCatalog' function, that computes catalogs from
parsed manifests. The behaviour of this module is probably non canonical on many
details. The problem is that most of Puppet behaviour is undocumented or
extremely vague. It might be possible to delve into the source code or to write
tests, but ruby is unreadable and tests are boring.

Here is a list of known discrepencies with Puppet :

* Resources references using the \<| |\> syntax are not yet supported.

* Things defined in classes that are not included cannot be accessed. In vanilla
puppet, you can use subclass to classes that are not imported themselves.

* Amending attributes with a reference will not cause an error when done out of
an inherited class.

* Variables $0 to $9, set after regexp matching, are not handled.

* Tags work like regular parameters, and are not automatically populated or inherited.

* Modules, nodes, classes and type names starting with _ are allowed.

* Arrows between resource declarations or collectors are not yet handled.

* Reversed form arrows are not handled.

* Node inheritance is not handled, and class inheritance seems to work well,
but is probably not Puppet-perfect.

-}
module Puppet.Interpreter.Catalog (
    getCatalog
    ) where

import Puppet.DSL.Types
import Puppet.Interpreter.Functions
import Puppet.Interpreter.Types
import Puppet.Printers
import Puppet.Plugins
import qualified PuppetDB.Query as PDB
import Puppet.Utils

import qualified Data.Aeson as JSON
import System.IO.Unsafe
import Control.Arrow (first,(***))
import Data.List
import Data.Char (isAlpha, isAlphaNum)
import Data.Maybe (isJust, fromJust, catMaybes, isNothing, mapMaybe)
import Data.Either (lefts, rights, partitionEithers)
import Data.Ord (comparing)
import Text.Parsec.Pos
import Control.Monad.State
import Control.Monad.Error
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.Traversable as DT
import qualified Data.Graph as Graph
import qualified Data.Tree as Tree
import qualified Data.Text as T

qualified :: T.Text -> Bool
qualified = T.isInfixOf "::"

-- Int handling stuff
readint :: T.Text -> CatalogMonad Integer
readint x = case readDecimal x of
                Right y -> return y
                Left _ -> throwPosError $ "Expected an integer instead of '" <> x

-- | This function returns an error, or the 'FinalCatalog' of resources to
-- apply, the map of all edges between resources, and the 'FinalCatalog' of
-- exported resources.
getCatalog :: (TopLevelType -> T.Text -> IO (Either String Statement))
    -- ^ The \"get statements\" function. Given a top level type and its name it
    -- should return the corresponding statement.
    -> (Either T.Text T.Text -> T.Text -> Map.Map T.Text GeneralValue -> IO (Either String T.Text))
    -- ^ The \"get template\" function. Given a file name, a scope name and a
    -- list of variables, it should return the computed template.
    -> (T.Text -> PDB.Query -> IO (Either String JSON.Value))
    -- ^ The \"puppetDB Rest API\" function. Given the machine fqdn, a request
    -- type (resources, nodes, facts, ..) and a query, it returns a
    -- JSON value, or some error.
    -> T.Text -- ^ Name of the node.
    -> Facts -- ^ Facts of this node.
    -> Maybe T.Text -- ^ Path to the modules, for user plugins. If set to Nothing, plugins are disabled.
    -> Map.Map PuppetTypeName PuppetTypeMethods -- ^ The list of native types
    -> IO (Either String (FinalCatalog, EdgeMap, FinalCatalog), [T.Text])
getCatalog getstatements gettemplate puppetdb nodename facts modules ntypes = do
    let convertedfacts = Map.map
            (\fval -> (Right fval, initialPos "FACTS"))
            facts
    (luastate, userfunctions) <- case modules of
        Just m  -> fmap (first Just) (initLua m)
        Nothing -> return (Nothing, [])
    (!output, !finalstate) <- runStateT ( runErrorT ( computeCatalog getstatements nodename ) )
                                ScopeState
                                   { curScope                   = [["::"]]
                                   , curVariables               = convertedfacts
                                   , curClasses                 = Map.empty
                                   , curDefaults                = Map.empty
                                   , curResId                   = 1
                                   , curPos                     = (initialPos "dummy")
                                   , nestedtoplevels            = Map.empty
                                   , getStatementsFunction      = getstatements
                                   , getWarnings                = []
                                   , curCollect                 = []
                                   , unresolvedRels             = []
                                   , computeTemplateFunction    = gettemplate
                                   , puppetDBFunction           = puppetdb
                                   , luaState                   = luastate
                                   , userFunctions              = Set.fromList userfunctions
                                   , nativeTypes                = ntypes
                                   , definedResources           = Map.singleton ("node",nodename) (newPos "site.pp" 0 0)
                                   , currentDependencyStack     = [("node",nodename)]
                                   }
    case luastate of
        Just l  -> closeLua l
        Nothing -> return ()
    case output of
        Left x -> return (Left (T.unpack x), getWarnings finalstate)
        Right x -> return (Right x, getWarnings finalstate)

computeCatalog :: (TopLevelType -> T.Text -> IO (Either String Statement)) -> T.Text -> CatalogMonad (FinalCatalog, EdgeMap, FinalCatalog)
computeCatalog getstatements nodename = do
    nodestatements <- liftIO $ getstatements TopNode nodename
    case nodestatements of
        Left x -> throwError (T.pack x)
        Right nodestmts -> evaluateStatements nodestmts >>= finalResolution

resolveResource :: CResource -> CatalogMonad (ResIdentifier, RResource)
resolveResource cr@(CResource cid cname ctype cparams _ scopes cpos) = do
    setPos cpos
    rname <- resolveGeneralString cname
    rparams <- mapM (\(a,b) -> do { ra <- resolveGeneralString a; rb <- resolveGeneralValue b; return (ra,rb); }) (Map.toList cparams)
    nparams <- processOverride cr (Map.fromList rparams)
    let mrrelations = []
        prefinalresource = RResource cid rname ctype nparams mrrelations scopes cpos
    return ((ctype, rname), prefinalresource)

-- this validates the resolved resources
-- it should only be called with native types or the validatefunction lookup with abord with an error
finalizeResource :: CResource -> CatalogMonad (ResIdentifier, RResource)
finalizeResource cr = do
    ((_, rname), prefinalresource) <- extractRelations cr >>= resolveResource
    let ctype   = rrtype   prefinalresource
        cpos    = rrpos    prefinalresource
        saveAlias :: ResolvedValue -> CatalogMonad ()
        saveAlias (ResolvedString al) | al == rname = return ()
                                      | otherwise = addDefinedResource (ctype, al) cpos
        saveAlias x = throwPosError ("This alias is not a string:" <> tshow x)
    setPos cpos
    ntypes <- fmap nativeTypes get
    unless (Map.member ctype ntypes) $ throwPosError $ "Can't find native type " <> ctype
    -- now run the collection checks for overrides
    let validatefunction = puppetvalidate (ntypes Map.! ctype)
        validated = validatefunction prefinalresource
    case validated of
        Left err -> throwPosError (T.pack err <> " for resource " <> ctype <> "[" <> rname <> "]")
        Right finalresource -> do
            case Map.findWithDefault (ResolvedArray []) "alias" (rrparams finalresource) of
                (ResolvedArray aliases) -> mapM_ saveAlias aliases
                s@(ResolvedString _)    -> saveAlias s
                x                       -> throwPosError ("Aliases should be arrays of strings, not " <> tshow x)
            return ((ctype, rname), finalresource)

-- This checks if a resource is to be collected.
-- This returns a list as it can either return the original
-- resource, the resource with a "normal" virtuality, or both,
-- for exported resources (so that they can still be found as collected)
collectionChecks :: CResource -> CatalogMonad [CResource]
collectionChecks res =
    if crvirtuality res == Normal
        then return [res]
        else do
            -- Note that amending attributes with a collector does collect virtual
            -- values. Hence no filtering on the collectors is done here.
            isCollected <- liftM curCollect get >>= mapM (\(x, _, _) -> x res)
            case (or isCollected, crvirtuality res) of
                (True, Exported)    -> return [res { crvirtuality = Normal }, res]
                (True,  _)          -> return [res { crvirtuality = Normal }     ]
                (False, _)          -> return [res                               ]

processOverride :: CResource -> Map.Map T.Text ResolvedValue -> CatalogMonad (Map.Map T.Text ResolvedValue)
processOverride cr prms =
    let applyOverride :: CResource -> Map.Map T.Text ResolvedValue -> (CResource -> CatalogMonad Bool, Map.Map GeneralString GeneralValue, Maybe PDB.Query) -> CatalogMonad (Map.Map T.Text ResolvedValue)
        -- this checks if the collection function matches
        applyOverride c prm (func, overs, _) = do
            check <- func c
            if check
                then foldM tryReplace prm (Map.toList overs)
                else return prm
        tryReplace :: Map.Map T.Text ResolvedValue -> (GeneralString, GeneralValue) -> CatalogMonad (Map.Map T.Text ResolvedValue)
        -- if it does, this resolves the override and applies it
        -- this is obviously wasteful
        tryReplace curmap (gs, gv) = do
            rs <- resolveGeneralString gs
            rv <- resolveGeneralValue gv
            return $ Map.insert rs rv curmap
    -- Collectors are filtered so that only those with overrides are passed to the fold.
    in liftM (filter (\(_, x, _) -> not $ Map.null x) . curCollect) get >>= foldM (applyOverride cr) prms

retrieveRemoteResources :: (PDB.Query -> IO (Either String [CResource])) -> PDB.Query -> CatalogMonad [CResource]
retrieveRemoteResources f q = do
    res <- liftIO $ f q
    case res of
        Right h     -> return h
        Left err    -> throwError $ "PuppetDB error: " <> T.pack err

extractRelations :: CResource -> CatalogMonad CResource
extractRelations cr = do
    setPos (pos cr)
    (params, relations) <- partitionParamsRelations (crparams cr)
    addUnresRel (relations, (crtype cr, crname cr), UNormal, pos cr, crscope cr)
    return cr { crparams = params }

-- resolves a single relationship
resolveRelationship :: ([(LinkType, GeneralValue, GeneralValue)], (T.Text, GeneralString), RelUpdateType, SourcePos, [[ScopeName]])
                        -> CatalogMonad ([(LinkType, ResIdentifier)], ResIdentifier, RelUpdateType, SourcePos, [[ScopeName]])
resolveRelationship (udsts, (stype, usname), uptype, spos, scop) = do
    let resolveSrcRel (ltype, udtype, udname) = do
            dtype <- resolveGeneralValue udtype >>= rstring
            resolveGeneralValue udname >>= rstrings >>= mapM (\dname -> return (ltype, (dtype, dname)))
    dsts  <- fmap concat (mapM resolveSrcRel udsts)
    sname <- resolveGeneralString usname
    return (dsts, (stype, sname), uptype, spos, scop)

-- this does all the relation stuff
finalizeRelations :: FinalCatalog -> FinalCatalog -> CatalogMonad (FinalCatalog, EdgeMap)
finalizeRelations exported cat = do
    grels <- fmap unresolvedRels get >>= mapM resolveRelationship
    drs   <- fmap definedResources get
    let extr :: ([(LinkType, ResIdentifier)], ResIdentifier, RelUpdateType, SourcePos, [[ScopeName]])
                    -> [(ResIdentifier, ResIdentifier, LinkInfo)]
        extr (dsts, src, rutype, spos, scp) = do
            (ltype, dst) <- dsts
            return (dst, src, (ltype, rutype, spos, scp))
        !rels = concatMap extr grels :: [(ResIdentifier, ResIdentifier, LinkInfo)]
        checkRelationExists :: (ResIdentifier, ResIdentifier, LinkInfo) -> CatalogMonad (Maybe (ResIdentifier, ResIdentifier, LinkInfo))
        checkRelationExists !o@(!src, !dst, (!ltype,!lutype,!lpos,!lscope)) =
            -- if the source of the relation doesn't exist (is exported),
            -- then when drop this relation
            case (Map.member src drs, Map.member dst drs, Map.member src exported, Map.member dst exported) of
                (_, _, _, True)     -> return Nothing
                -- we have a good relation, reorder it so that all arrows point the same way
                (True, True,_ , _)  -> case ltype of
                                RNotify -> return $ Just (dst, src, (RSubscribe, lutype,lpos,lscope))
                                RBefore -> return $ Just (dst, src, (RRequire  , lutype,lpos,lscope))
                                _ -> return (Just o)
                (False, _, _, _)  -> throwError $ "Unknown resources " <> tshow src <> " used as source (destination: " <> tshow dst <> ") in a relation at " <> tshow lpos <> " debug: " <> tshow (Map.member src drs, Map.member dst drs, Map.member src exported, Map.member dst exported) <> " " <> showScope lscope
                (_, False, _, _)  -> throwError $ "Unknown resources " <> tshow dst <> " used as destination (source: " <> tshow src <> ") in a relation at " <> tshow lpos <> " debug: " <> tshow (Map.member src drs, Map.member dst drs, Map.member src exported, Map.member dst exported) <> " " <> showScope lscope
    -- now look for cycles in the graph
    checkedrels <- fmap catMaybes $ mapM checkRelationExists rels
    let !edgeMap = Map.fromList (map (\(d,s,i) -> ((s,d),i)) checkedrels) :: EdgeMap -- warning, in the edgemap we have (src, dst), contrary to all other uses
        !nodeRel = Map.fromListWith (++) (map (\(d,s,_) -> (s,[d])) checkedrels) :: Map.Map ResIdentifier [ResIdentifier]
        !(relgraph,qfunc) = Graph.graphFromEdges' $ map (\(a,b) -> (a,a,b)) $ Map.toList nodeRel
        !cycles = map (map ((\(a,_,_) -> a) . qfunc) . Tree.flatten) $ filter (not . null . Tree.subForest) $ Graph.scc relgraph :: [[ResIdentifier]]
        describe :: [ResIdentifier] -> T.Text
        describe [] = "[]"
        describe x = let rx = map (\i -> (i, drs Map.! i)) x
                     in  T.intercalate "\n\t\t" (showRRef (head x) : zipWith describe' x (tail rx))
        describe' :: ResIdentifier -> (ResIdentifier, SourcePos) -> T.Text
        describe' src (dst,dpos) = " -> " <> showRRef dst <> " [" <> tshow dpos <> "] link is " <> tshow (Map.lookup (src,dst) edgeMap)
    if null cycles
        then return (cat, edgeMap)
        else throwError $ "The following cycles have been found:\n\t" <> T.intercalate "\n\t" (map describe cycles)


finalResolution :: Catalog -> CatalogMonad (FinalCatalog, EdgeMap, FinalCatalog)
finalResolution cat = do
    pdbfunction     <- fmap puppetDBFunction get
    fqdnr           <- getVariable "::fqdn"
    collectedRemote <- do
                           fqdn <- case fqdnr of
                               Just (Right (ResolvedString f'), _) -> return f'
                               _ -> throwError "Could not get FQDN during final resolution"
                           remoteCollects <- fmap (mapMaybe (\(_,_,x) -> x) . curCollect) get
                           let
                               isNotLocal :: CResource -> Bool
                               isNotLocal cr = case Map.lookup (Right "EXPORTEDSOURCE") (crparams cr) of
                                                        Just (Right (ResolvedString x)) -> x /= fqdn
                                                        _ -> True
                               toCR :: Either String JSON.Value -> Either String [CResource]
                               toCR (Left r) = Left r
                               toCR (Right x) = case json2puppet x of
                                                    Left rr -> Left rr
                                                    Right s -> Right $ filter isNotLocal s
                           fmap concat (mapM (retrieveRemoteResources (fmap toCR . pdbfunction "resources")) remoteCollects)
    let -- this adds the collected remote defines to the index of know resources, so that the dependencies check
        addCollectedDefines cr = do
            let rtype  = crtype cr
            rname <- resolveGeneralString (crname cr)
            isdef <- checkDefine rtype
            case isdef of
               Just _  -> addDefinedResource (rtype, rname) (pos cr)
               Nothing -> return ()
    collectedRemote' <- mapM extractRelations collectedRemote
    mapM_ addCollectedDefines collectedRemote'
    collectedLocal   <- fmap concat $ mapM collectionChecks cat
    collectedLocalD  <- fmap concat $ mapM evaluateDefine collectedLocal
    collectedRemoteD <- fmap concat $ mapM evaluateDefine collectedRemote'
    -- collectedRemoteD resource names SHOULD be resolved (coming from
    -- PuppetDB)
    let addCollectedRemoteResource :: CResource -> CatalogMonad ()
        addCollectedRemoteResource (CResource _ (Right cn) ct prms _ _ cp) = do
            addDefinedResource (ct, cn) cp
            case Map.lookup (Right "alias") prms of
                Just (Right (ResolvedString s)) -> addDefinedResource (ct, s) cp
                Just x -> throwPosError ("Alias must be a single string, not " <> tshow x)
                _ -> return ()
        addCollectedRemoteResource x = throwPosError $ "finalResolution/addCollectedRemoteResource the remote resource name was not properly defined: " <> tshow (crname x)
    mapM_ addCollectedRemoteResource collectedRemoteD
    let collected = collectedLocalD ++ collectedRemoteD
        (real,  allvirtual)  = partition (\x -> crvirtuality x == Normal) collected
        (_,  exported) = partition (\x -> crvirtuality x == Virtual)  allvirtual
    rexported <- mapM resolveResource exported
    let !exportMap = Map.fromList rexported
    -- TODO
    --export stuff
    --liftIO $ putStrLn "EXPORTED:"
    --liftIO $ mapM print exported
    --get >>= return . unresolvedRels >>= liftIO . (mapM print)
    (fc, em) <- mapM finalizeResource real >>= createResourceMap >>= finalizeRelations exportMap
    return (fc, em, exportMap)

createResourceMap :: [(ResIdentifier, RResource)] -> CatalogMonad FinalCatalog
createResourceMap = foldM insertres Map.empty
    where
        insertres :: FinalCatalog -> (ResIdentifier, RResource) -> CatalogMonad FinalCatalog
        insertres curmap (resid, res) = let
            oldres = Map.lookup resid curmap
            newmap = Map.insert resid res curmap
            in case (rrtype res, oldres) of
                ("class", _) -> return newmap
                (_, Just r ) -> throwError ("Resource already defined:"
                    <> "\n\t" <> rrtype r   <> "[" <> rrname r   <> "] at " <> tshow (rrpos r)   <> " " <> showScope (rrscope r)
                    <> "\n\t" <> rrtype res <> "[" <> rrname res <> "] at " <> tshow (rrpos res) <> " " <> showScope (rrscope res) :: T.Text)
                (_, Nothing) -> return newmap

getstatement :: TopLevelType -> T.Text -> CatalogMonad Statement
getstatement qtype name = do
    curcontext <- get
    let stmtsfunc = getStatementsFunction curcontext
    estatement <- liftIO $ stmtsfunc qtype name
    case estatement of
        Left x -> throwPosError (T.pack x)
        Right y -> return y

-- State alteration functions

pushDefaults :: ResDefaults -> CatalogMonad ()
pushDefaults d = do
    curstate <- get
    let curscope = (head . curScope) curstate
        curdefaults = curDefaults curstate
        newdefaults = Map.insertWith (++) curscope [d] curdefaults
    put (curstate { curDefaults = newdefaults })

emptyDefaults :: CatalogMonad ()
emptyDefaults = do
    curstate <- get
    let curscope = (head . curScope) curstate
        curdefaults = curDefaults curstate
        newdefaults = Map.delete curscope curdefaults
    put (curstate { curDefaults = newdefaults })

getCurDefaults :: CatalogMonad [ResDefaults]
getCurDefaults = do
    curstate <- get
    let curscope = (head . curScope) curstate
        curdefaults = curDefaults curstate
    case Map.lookup curscope curdefaults of
        Nothing -> return []
        Just  x -> return x

pushDependency :: ResIdentifier -> CatalogMonad ()
pushDependency = modify . modifyDeps . (:)
popDependency :: CatalogMonad ()
popDependency = modify (modifyDeps tail)
pushScope :: [ScopeName] -> CatalogMonad ()
pushScope = modify . modifyScope . (:)
popScope :: CatalogMonad ()
popScope       = modify (modifyScope tail)
getScope :: CatalogMonad [T.Text]
getScope        = do
    scope <- liftM curScope get
    if null scope
        then throwError "empty scope, shouldn't happen"
        else return $ head scope
addLoaded :: T.Text -> SourcePos -> CatalogMonad ()
addLoaded name = modify . modifyClasses . Map.insert name
getNextId = do
    curscope <- get
    put $ incrementResId curscope
    return (curResId curscope)
setPos = modify . setStatePos

-- qualifies a variable k depending on the context cs
qualify k cs | qualified k || (cs == "::") = cs <> k
             | otherwise = cs <> "::" <> k

-- This is a bit convoluted and misses a critical feature.
-- It adds the variable to all the scopes that are currently active.
-- BUG TODO : check that a variable is not already defined.
putVariable k v = getScope >>= mapM_ (\x -> modify (modifyVariables (Map.insert (qualify k x) v)))

-- Saves the current module name
setModuleName :: T.Text -> CatalogMonad ()
setModuleName str = do
    let (amodulename, remain) = T.break (==':') str
        modulename = if T.null remain
                         then "topmodule"
                         else amodulename
    cpos <- getPos
    vars <- fmap curVariables get
    let nvars = Map.insert "::caller_module_name" (Right (ResolvedString modulename), cpos) vars
    saveVariables nvars

getVariable vname = liftM (Map.lookup vname . curVariables) get

-- BUG TODO : top levels are qualified only with the head of the scopes
addNestedTopLevel rtype rname rstatement = do
    curstate <- get
    let ctop = nestedtoplevels curstate
        curscope = head $ head (curScope curstate)
        nname = qualify rname curscope
        nstatement = case rstatement of
            DefineDeclaration _ prms stms cpos      -> DefineDeclaration nname prms stms cpos
            ClassDeclaration  _ inhe prms stms cpos -> ClassDeclaration  nname inhe prms stms cpos
            x -> x
        ntop = Map.insert (rtype, nname) nstatement ctop
        nstate = curstate { nestedtoplevels = ntop }
    put nstate
addWarning :: T.Text -> CatalogMonad ()
addWarning = modify . pushWarning
addCollect ((func, query), overrides) = modify $ pushCollect (func, overrides, query)
-- this pushes the relations only if they exist
-- the parameter is of the form
-- ( [dstrelations], srcresource, type, pos )
addUnresRel :: ([(LinkType, GeneralValue, GeneralValue)], (T.Text, GeneralString), RelUpdateType, SourcePos, [[ScopeName]]) -> CatalogMonad ()
addUnresRel ncol@(rels, _, _, _, _)  = unless (null rels) (modify (pushUnresRel ncol))

-- finds out if a resource name refers to a define
checkDefine :: T.Text -> CatalogMonad (Maybe Statement)
checkDefine dname = fmap nativeTypes get >>= \nt -> if Map.member dname nt
  then return Nothing
  else do
    curstate <- get
    let ntop = nestedtoplevels curstate
        getsmts = getStatementsFunction curstate
        check = Map.lookup (TopDefine, dname) ntop
    case check of
        Just x -> return $ Just x
        Nothing -> do
            def1 <- liftIO $ getsmts TopDefine dname
            case def1 of
                Left err -> throwPosError ("Could not find the definition of " <> dname <> " err = " <> T.pack err)
                Right s -> return $ Just s

{-
Partition parameters between those that are actual parameters and those that define relationships.

Those that define relationship must be properly resolved or hell will break loose. This is a BUG.
-}
partitionParamsRelations :: Map.Map GeneralString GeneralValue -> CatalogMonad (Map.Map GeneralString GeneralValue, [(LinkType, GeneralValue, GeneralValue)])
partitionParamsRelations rparameters = do
    let realparams = filteredparams :: Map.Map GeneralString GeneralValue
        convertrelation :: (GeneralString, GeneralValue) -> CatalogMonad [(LinkType, GeneralValue, GeneralValue)]
        convertrelation (_,       Right ResolvedUndefined)          = return []
        convertrelation (reltype, Right (ResolvedArray rs))         = fmap concat $ mapM (\x -> convertrelation (reltype, Right x)) rs
        convertrelation (reltype, Right (ResolvedRReference rt rv)) = return [(fromJust $ getRelationParameterType reltype, Right $ ResolvedString rt, Right rv)]
        convertrelation (reltype, Right (ResolvedString "undef"))   = return [(fromJust $ getRelationParameterType reltype, Right $ ResolvedString "undef", Right $ ResolvedString "undef")]
        convertrelation (reltype, Right (ResolvedString x))         = case parseResourceReference x of
                                                                          Just rr -> convertrelation (reltype, Right rr)
                                                                          Nothing -> throwPosError ("partitionParamsRelations unknown string error : " <> tshow x)
        convertrelation (_,       Left x)                           = throwPosError ("partitionParamsRelations unresolved : " <> tshow x)
        convertrelation x                                           = throwPosError ("partitionParamsRelations error : " <> tshow x)
        (filteredrelations, filteredparams)                         = Map.partitionWithKey (const . isJust . getRelationParameterType) rparameters -- filters relations with actual parameters
    relations <- fmap concat (mapM convertrelation (Map.toList filteredrelations)) :: CatalogMonad [(LinkType, GeneralValue, GeneralValue)]
    return (realparams, relations)

-- TODO check whether parameters changed
checkLoaded :: T.Text -> CatalogMonad Bool
checkLoaded name = do
    curscope <- get
    case Map.lookup name (curClasses curscope) of
        Nothing -> return False
        Just _  -> return True

-- function that takes a pair of Expressions and try to resolve the first as a string, the second as a generalvalue
resolveParams :: (Expression, Expression) -> CatalogMonad (GeneralString, GeneralValue)
resolveParams (a,b) = do
    ra <- tryResolveExpressionString a
    rb <- tryResolveExpression b
    return (ra, rb)

-- safely insert parameters, checking they are not already defined
addParameters :: Map.Map GeneralString GeneralValue -> [(Expression, Expression)] -> CatalogMonad (Map.Map GeneralString GeneralValue)
addParameters = foldM rp
    where
        rp :: Map.Map GeneralString GeneralValue -> (Expression, Expression) -> CatalogMonad (Map.Map GeneralString GeneralValue)
        rp curmap prm = do
            (k, v) <- resolveParams prm
            case Map.lookup k curmap of
                Just _ -> throwPosError $ "Parameter " <> tshow k <> " had been declared twice!"
                Nothing -> return (Map.insert k v curmap)

-- apply default values to a resource
applyDefaults :: CResource -> CatalogMonad CResource
applyDefaults res = getCurDefaults >>= foldM applyDefaults' res

applyDefaults' :: CResource -> ResDefaults -> CatalogMonad CResource
applyDefaults' r@(CResource i rname rtype rparams rvirtuality scopes rpos) (RDefaults dtype rdefs _) =
    let nparams = mergeParams rparams rdefs False
    in  return $ if dtype == rtype
                     then CResource i rname rtype nparams rvirtuality scopes rpos
                     else r
applyDefaults' r@(CResource i rname rtype rparams rvirtuality scopes rpos) (ROverride dtype dname rdefs _) = do
    srname <- resolveGeneralString rname
    sdname <- resolveGeneralString dname
    let nparams = mergeParams rparams rdefs True
    return $ if (dtype == rtype) && (srname == sdname)
                 then CResource i rname rtype nparams rvirtuality scopes rpos
                 else r

-- merge defaults and actual parameters depending on the override flag
mergeParams :: Map.Map GeneralString GeneralValue -> Map.Map GeneralString GeneralValue -> Bool -> Map.Map GeneralString GeneralValue
mergeParams srcprm defs override = if override
                                       then defs   `Map.union` srcprm
                                       else srcprm `Map.union` defs

-- The actual meat

evaluateDefine :: CResource -> CatalogMonad [CResource]
evaluateDefine r@(CResource _ rname rtype rparams rvirtuality _ rpos) = let
    evaluateDefineDeclaration dtype args dstmts dpos = do
        rexpr <- resolveGeneralString rname
        pushScope ["#DEFINE#" <> dtype <> "/" <> rexpr]
        pushDependency (dtype, rexpr)
        -- add variables
        mparams <- fmap Map.fromList $ mapM (\(gs, gv) -> do { rgs <- resolveGeneralString gs; rgv <- tryResolveGeneralValue gv; return (rgs, (rgv, dpos)); }) (Map.toList rparams)
        let expr = Right (ResolvedString rexpr)
            defineparamset = Set.fromList $ map fst args
            mandatoryparams = Set.fromList $ map fst $ filter (isNothing . snd) args
            resourceparamset = Map.keysSet mparams
            extraparams = Set.difference resourceparamset (defineparamset `Set.union` metaparameters)
            unsetparams = Set.difference mandatoryparams resourceparamset
        unless (Set.null extraparams) $ throwPosError $ "Spurious parameters set for " <> dtype <> ": " <> T.intercalate ", " (Set.toList extraparams)
        unless (Set.null unsetparams) $ throwPosError $ "Unset parameters set for "    <> dtype <> ": " <> T.intercalate ", " (Set.toList unsetparams)
        putVariable "title" (expr, rpos)
        putVariable "name" (expr, rpos)
        mapM_ (loadClassVariable rpos mparams) args

        setPos dpos
        setModuleName dtype
        -- parse statements
        res <- mapM evaluateStatements dstmts
        nres <- handleDelayedActions (concat res)
        popDependency
        popScope
        return nres
    in do
    setPos rpos
    isdef <- checkDefine rtype
    case (rvirtuality, isdef) of
        (Normal, Just (TopContainer topstmts (DefineDeclaration dtype args dstmts dpos))) -> do
            mapM_ (\(n,x) -> evaluateClass x Map.empty (Just n)) topstmts
            evaluateDefineDeclaration dtype args dstmts dpos
        (Normal, Just (DefineDeclaration dtype args dstmts dpos)) -> evaluateDefineDeclaration dtype args dstmts dpos
        _ -> return [r]


-- handling delayed actions (such as defaults and define resolution)
handleDelayedActions :: Catalog -> CatalogMonad Catalog
handleDelayedActions res = do
    dres <- liftM concat (mapM applyDefaults res >>= mapM evaluateDefine)
    emptyDefaults
    return dres

addResource :: T.Text -> [(Expression, Expression)] -> Virtuality -> SourcePos -> GeneralValue -> CatalogMonad [CResource]
addResource rtype parameters virtuality position grname = do
    resid <- getNextId
    rparameters <- addParameters Map.empty parameters
    case grname of
        Right e -> do
            rse <- rstring e
            curpos <- getPos
            addDefinedResource (rtype, rse) curpos
            case Map.lookup (Right "alias") rparameters of
                Just (Right (ResolvedString s)) -> addDefinedResource (rtype, s) curpos
                Just x -> throwPosError ("Alias must be a single string, not " <> tshow x)
                _ -> return ()
            (curdeptype, curdepname) <- fmap (head . currentDependencyStack) get
            let defaultdependency = (RRequire, Right (ResolvedString curdeptype), Right (ResolvedString curdepname))
            scopes <- fmap curScope get
            addUnresRel ([defaultdependency], (rtype, Right rse), UNormal, position, scopes)
            return [CResource resid (Right rse) rtype rparameters virtuality scopes position]
        Left r -> throwPosError ("Could not determine the current resource name: " <> tshow r)

-- node
evaluateStatements :: Statement -> CatalogMonad Catalog
evaluateStatements (Node _ stmts position) = do
    setPos position
    res <- mapM evaluateStatements stmts
    handleDelayedActions (concat res)

-- include
evaluateStatements (Include includename position) = setPos position >> resolveExpressionString includename >>= getstatement TopClass >>= \st -> evaluateClass st Map.empty Nothing
evaluateStatements x@(ClassDeclaration cname _ _ _ _) = do
    addNestedTopLevel TopClass cname x
    return []
evaluateStatements n@(DefineDeclaration dtype _ _ _) = do
    addNestedTopLevel TopDefine dtype n
    return []
evaluateStatements (ConditionalStatement exprs position) = do
    setPos position
    trues <- filterM (\(expr, _) -> resolveBoolean (Left expr)) exprs
    case trues of
        ((_,stmts):_) -> liftM concat (mapM evaluateStatements stmts)
        _ -> return []

evaluateStatements (Resource rtype rname parameters virtuality position) = do
    setPos position
    case rtype of
        -- checks whether we are handling a parametrized class
        "class" -> do
            rparameters <- fmap Map.fromList $ mapM (\(a,b) -> do { pa <- resolveExpressionString a; pb <- tryResolveExpression b; return (pa, pb) } ) parameters
            classname <- resolveExpressionString rname
            topstatement <- getstatement TopClass classname
            let classparameters = Map.map (\pvalue -> (pvalue, position)) rparameters :: Map.Map T.Text (GeneralValue, SourcePos)
            evaluateClass topstatement classparameters Nothing
        _ -> do
            srname <- tryResolveExpression rname
            case srname of
                (Right (ResolvedArray arr)) -> fmap concat (mapM (addResource rtype parameters virtuality position . Right) arr)
                _ -> addResource rtype parameters virtuality position srname

evaluateStatements (ResourceDefault rdtype rdparams rdpos) = do
    rrdparams <- addParameters Map.empty rdparams
    pushDefaults $ RDefaults rdtype rrdparams rdpos
    return []
evaluateStatements (ResourceOverride rotype roname roparams ropos) = do
    rroname <- tryResolveExpressionString roname
    rroparams <- addParameters Map.empty roparams
    pushDefaults $ ROverride rotype rroname rroparams ropos
    return []
evaluateStatements (DependenceChain (srctype, srcname) (dsttype, dstname) position) = do
    setPos position
    gdstname <- tryResolveExpression dstname
    gsrcname <- tryResolveExpressionString srcname
    scp <- fmap curScope get
    addUnresRel ( [(RRequire, Right $ ResolvedString dsttype, gdstname)], (srctype, gsrcname), UPlus, position, scp)
    return []
-- <<| |>>
evaluateStatements (ResourceCollection rtype expr overrides position) = do
    setPos position
    unless (null overrides) $ throwPosError "Amending attributes with a Collector only works with <| |>, not <<| |>>."
    func <- collectionFunction Exported rtype expr
    addCollect (func, Map.empty)
    return []
-- <| |>
-- TODO : check that this is a native type when overrides are defined.
-- The behaviour is not explained in the documentation, so I won't support it.
evaluateStatements (VirtualResourceCollection rtype expr overrides position) = do
    setPos position
    func <- collectionFunction Virtual rtype expr
    prms <- addParameters Map.empty overrides
    addCollect (func, prms)
    return []

evaluateStatements (VariableAssignment vname vexpr position) = do
    setPos position
    rvexpr <- tryResolveExpression vexpr
    putVariable vname (rvexpr, position)
    return []

evaluateStatements (MainFunctionCall fname fargs position) = do
    setPos position
    rargs <- mapM resolveExpression fargs
    executeFunction fname rargs

evaluateStatements (TopContainer toplevels curstatement) = do
    mapM_ (\(fname, stmt) -> evaluateClass stmt Map.empty (Just fname)) toplevels
    evaluateStatements curstatement

evaluateStatements x = throwError ("Can't evaluate " <> tshow x)

-- function used to load defines / class variables into the global context
loadClassVariable :: SourcePos -> Map.Map T.Text (GeneralValue, SourcePos) -> (T.Text, Maybe Expression) -> CatalogMonad (T.Text, GeneralValue)
loadClassVariable position inputs (paramname, defvalue) = do
    let inputvalue = Map.lookup paramname inputs
    (v, vpos) <- case (inputvalue, defvalue) of
        (Just x , _      ) -> return x
        (Nothing, Just y ) -> return (Left y, position)
        (Nothing, Nothing) -> throwError $ "Must define parameter " <> paramname <> " at " <> tshow position
    rv <- tryResolveGeneralValue v
    putVariable paramname (rv, vpos)
    return (paramname, rv)

-- class
-- ClassDeclaration String (Maybe String) [(String, Maybe Expression)] [Statement] SourcePos
-- nom, heritage, parametres, contenu
evaluateClass :: Statement -> Map.Map T.Text (GeneralValue, SourcePos) -> Maybe T.Text -> CatalogMonad Catalog
evaluateClass (ClassDeclaration classname inherits parameters statements position) inputparams actualname = do
    isloaded <- case actualname of
        Nothing -> checkLoaded classname
        Just x  -> checkLoaded x
    if isloaded
        then return []
        else do
        oldpos <- getPos    -- saves where we were at class declaration so that we known were the class was included
        addDefinedResource ("class", classname) oldpos
        -- detection of spurious parameters
        let classparamset = Set.fromList $ map fst parameters
            inputparamset = Set.filter (isNothing . getRelationParameterType . Right) $ Map.keysSet inputparams
            overparams = Set.difference inputparamset (Set.union metaparameters classparamset)
            -- to insert into the final resource

        unless (Set.null overparams) (throwError $ "Spurious parameters " <> T.intercalate ", " (Set.toList overparams) <> " at " <> tshow position)

        resid <- getNextId  -- get this resource id, for the dummy class that will be used to handle relations
        case actualname of
            Nothing -> pushScope [classname] -- sets the scope
            Just ac -> pushScope [classname, ac]
        mparameters <- mapM (loadClassVariable position inputparams) parameters -- add variables for parametrized classes
        setPos position -- the setPos is that late so that the error message about missing parameters is about the calling site
        pushDependency ("class", classname)
        setModuleName classname

        -- load inherited classes
        inherited <- case inherits of
            Just parentclass -> do
                mystatement <- getstatement TopClass parentclass
                case mystatement of
                    ClassDeclaration _ ni np ns no -> evaluateClass (ClassDeclaration classname ni np ns no) Map.empty (Just parentclass)
                    _ -> throwError "Should not happen : TopClass return something else than a ClassDeclaration in evaluateClass"
            Nothing -> return []
        case actualname of
            Nothing -> addLoaded classname oldpos
            Just x  -> addLoaded x oldpos

        -- parse statements
        res <- mapM evaluateStatements statements
        nres <- handleDelayedActions (concat res)
        mapM_ (addClassDependency classname) nres   -- this adds a dummy dependency to this class
                                                    -- for all resources that do not already depend on a class
                                                    -- this is probably not puppet perfect with resources that
                                                    -- depend explicitely on a class
        scopes <- fmap curScope get
        popScope
        popDependency
        return $
            [CResource resid (Right classname) "class" (Map.fromList $ map (first Right) mparameters) Normal scopes position]
            ++ inherited
            ++ nres

evaluateClass (TopContainer topstmts myclass) inputparams actualname = do
    mapM_ (\(n,x) -> evaluateClass x Map.empty (Just n)) topstmts
    evaluateClass myclass inputparams actualname

evaluateClass x _ _ = throwError ("Someone managed to run evaluateClass against " <> tshow x)

addClassDependency :: T.Text -> CResource -> CatalogMonad ()
addClassDependency cname (CResource _ rname rtype _ _ scp position) =
    addUnresRel (
        [(RRequire, Right $ ResolvedString "class", Right $ ResolvedString cname)]
        , (rtype, rname)
        , UPlus
        , position
        , scp
        )

tryResolveExpression :: Expression -> CatalogMonad GeneralValue
tryResolveExpression = tryResolveGeneralValue . Left

tryResolveGeneralValue :: GeneralValue -> CatalogMonad GeneralValue
tryResolveGeneralValue n@(Right _) = return n
tryResolveGeneralValue   (Left BTrue) = return $ Right $ ResolvedBool True
tryResolveGeneralValue   (Left BFalse) = return $ Right $ ResolvedBool False
tryResolveGeneralValue   (Left (Value x)) = tryResolveValue x
tryResolveGeneralValue n@(Left (ResolvedResourceReference _ _)) = return n
tryResolveGeneralValue   (Left (ConditionalValue checkedvalue (Value (PuppetHash (Parameters hash))))) = do
    rcheck <- resolveExpression checkedvalue
    rhash <- mapM (\(vn, vv) -> do { rvn <- resolveExpression vn; return (rvn, vv) }) hash
    case filter (\(a,_) -> (a == ResolvedString "default") || compareRValues a rcheck) rhash of
        [] -> throwPosError ("No value could be selected when comparing to " <> tshow rcheck)
        ((_,x):_) -> tryResolveExpression x
tryResolveGeneralValue n@(Left (EqualOperation      a b))   = compareGeneralValue n a b [EQ]
tryResolveGeneralValue n@(Left (AboveEqualOperation a b))   = compareGeneralValue n a b [GT,EQ]
tryResolveGeneralValue n@(Left (AboveOperation      a b))   = compareGeneralValue n a b [GT]
tryResolveGeneralValue n@(Left (UnderEqualOperation a b))   = compareGeneralValue n a b [LT,EQ]
tryResolveGeneralValue n@(Left (UnderOperation      a b))   = compareGeneralValue n a b [LT]
tryResolveGeneralValue n@(Left (DifferentOperation  a b))   = compareGeneralValue n a b [LT,GT]
tryResolveGeneralValue n@(Left (RegexpOperation     a b)) = do
    ra <- tryResolveExpression a
    rb <- tryResolveExpression b
    case (ra, rb) of
        (Right (ResolvedString src), Right (ResolvedRegexp reg)) -> do
                m <- liftIO $ regmatch src reg
                case m of
                    Right x  -> return $ Right $ ResolvedBool x
                    Left err -> throwPosError $ "Error with regexp " <> tshow reg <> ": " <> T.pack err
        (Right x, _) -> throwPosError $ "Was expecting a string to match to a regexp, not " <> tshow x
        (_, Right x) -> throwPosError $ "Was expecting a regexp, not " <> tshow x
        _            -> return n
tryResolveGeneralValue n@(Left (OrOperation a b)) = do
    ra <- tryResolveBoolean $ Left a
    if ra == Right (ResolvedBool True)
        then return $ Right $ ResolvedBool True
        else do
            rb <- tryResolveBoolean $ Left b
            case (ra, rb) of
                (_, Right (ResolvedBool True)) -> return $ Right $ ResolvedBool True
                (Right (ResolvedBool rra), Right (ResolvedBool rrb)) -> return $ Right $ ResolvedBool $ rra || rrb
                _ -> return n
tryResolveGeneralValue n@(Left (AndOperation a b)) = do
    ra <- tryResolveBoolean $ Left a
    if ra == Right (ResolvedBool False)
        then return $ Right $ ResolvedBool False
        else do
            rb <- tryResolveBoolean $ Left b
            case (ra, rb) of
                (_, Right (ResolvedBool False)) -> return $ Right $ ResolvedBool False
                (Right (ResolvedBool rra), Right (ResolvedBool rrb)) -> return $ Right $ ResolvedBool $ rra && rrb
                _ -> return n
tryResolveGeneralValue   (Left (NotOperation x)) = do
    rx <- tryResolveBoolean $ Left x
    case rx of
        Right (ResolvedBool b) -> return $ Right $ ResolvedBool $ not b
        _ -> return rx
tryResolveGeneralValue (Left (LookupOperation a b)) = do
    ra <- tryResolveExpression a
    rb <- tryResolveExpressionString b
    case (ra, rb) of
        (Right (ResolvedArray ar), Right num) -> do
            bnum <- readint num
            let nnum = fromIntegral bnum
            if length ar <= nnum
                then throwPosError ("Invalid array index " <> num <> " " <> tshow ar)
                else return $ Right (ar !! nnum)
        (Right (ResolvedHash ar), Right idx) -> do
            let filtered = filter (\(x,_) -> x == idx) ar
            case filtered of
                [] -> return $ Right ResolvedUndefined
                [(_,x)] -> return $ Right x
                x  -> throwPosError ("Hum, WTF tryResolveGeneralValue " <> tshow x)
        (_, Left y) -> throwPosError ("Could not resolve index " <> tshow y)
        (Left x, _) -> throwPosError ("Could not resolve lookup " <> tshow x)
        (Right x, _) -> throwPosError ("Could not resolve something that is not an array nor a hash, but " <> tshow x)
-- TODO : for hashes, checks the keys
-- for strings, substrings
tryResolveGeneralValue o@(Left (IsElementOperation b a)) = do
    ra <- tryResolveExpression a
    rb <- tryResolveExpressionString b
    case (ra, rb) of
        (Right (ResolvedArray ar), Right idx) ->
            let filtered = filter (compareRValues (ResolvedString idx)) ar
            in  return $! Right $! ResolvedBool $! not $! null filtered
        (Right (ResolvedHash h), Right idx) ->
            let filtered = filter (\(fa,_) -> fa == idx) h
            in  return $! Right $! ResolvedBool $! not $! null filtered
        (Right (ResolvedString _), Right _) -> throwPosError "in operator not yet implemented for substrings"
        (Right ba, Right bb) -> throwPosError $ "Expected a string and a hash, array or string for the in operator, not " <> tshow (ba,bb)
        _ -> return o
-- horrible hack, because I do not know how to supply a single operator for Int and Float
tryResolveGeneralValue o@(Left (PlusOperation a b)) = arithmeticOperation a b (+) (+) o
tryResolveGeneralValue o@(Left (MinusOperation a b)) = arithmeticOperation a b (-) (-) o
tryResolveGeneralValue o@(Left (DivOperation a b)) = arithmeticOperation a b div (/) o
tryResolveGeneralValue o@(Left (MultiplyOperation a b)) = arithmeticOperation a b (*) (*) o

tryResolveGeneralValue e = throwPosError ("tryResolveGeneralValue not implemented for " <> tshow e)

resolveGeneralValue :: GeneralValue -> CatalogMonad ResolvedValue
resolveGeneralValue e = do
    x <- tryResolveGeneralValue e
    case x of
        Left n -> throwPosError  ("Could not resolveGeneralValue " <> tshow n)
        Right p -> return p

tryResolveExpressionString :: Expression -> CatalogMonad GeneralString
tryResolveExpressionString s = do
    resolved <- tryResolveExpression s
    case resolved of
        Right e -> liftM Right (rstring e)
        Left  e -> return $ Left e

rstring :: ResolvedValue -> CatalogMonad T.Text
rstring resolved = case resolved of
        ResolvedString s -> return s
        ResolvedInt i    -> return (tshow i)
        e                -> throwPosError ("'" <> tshow e <> "' will not resolve to a string")

rstrings :: ResolvedValue -> CatalogMonad [T.Text]
rstrings resolved = case resolved of
         ResolvedString s -> return [s]
         ResolvedInt i    -> return [tshow i]
         ResolvedArray xs -> mapM rstring xs
         e                -> throwPosError ("'" <> tshow e <> "' will not resolve to a string")

resolveExpression :: Expression -> CatalogMonad ResolvedValue
resolveExpression e = do
    resolved <- tryResolveExpression e
    case resolved of
        Right r -> return r
        Left  x -> do
            p <- getPos
            throwError ("Can't resolve expression '" <> tshow x <> "' at " <> tshow p <> " was '" <> tshow e <> "'")

resolveExpressionString :: Expression -> CatalogMonad T.Text
resolveExpressionString x = do
    resolved <- resolveExpression x
    case resolved of
        ResolvedString s -> return s
        ResolvedInt i -> return (tshow i)
        e -> do
            p <- getPos
            throwError ("Can't resolve expression '" <> tshow e <> "' to a string at " <> tshow p)

tryResolveValue :: Value -> CatalogMonad GeneralValue
tryResolveValue (Literal x) = return $ Right $ ResolvedString x
tryResolveValue (Integer x) = return $ Right $ ResolvedInt x
tryResolveValue (Double  x) = return $ Right $ ResolvedDouble x
tryResolveValue (PuppetBool x) = return $ Right $ ResolvedBool x

tryResolveValue n@(ResourceReference rtype vals) = do
    rvals <- tryResolveExpression vals
    case rvals of
        Right resolved -> return $ Right $ ResolvedRReference rtype resolved
        _              -> return $ Left $ Value n
-- special variables first
tryResolveValue   (VariableReference "module_name") = liftM (\x ->
    let headname = T.takeWhile (/= ':') (head x)
    in  Right $ ResolvedString $ if T.isPrefixOf "#DEFINE#" headname
                                     then T.drop 8 headname
                                     else headname
    ) getScope
tryResolveValue   (VariableReference vname) = do
    -- TODO check scopes !!!
    curscp <- getScope
    let gvarnm sc | qualified vname = vname : remtopscope vname                 -- scope is explicit
                  | sc == "::"      = ["::" <> vname]                           -- we are toplevel
                  | otherwise       = [sc <> "::" <> vname, "::" <> vname]  -- check for local scope, then global
        varnames = concatMap gvarnm curscp
        remtopscope x | T.isPrefixOf "::" x = [T.drop 2 x]
                      | otherwise           = []
    matching <- liftM catMaybes (mapM getVariable varnames)
    if null matching
        then do
            position <- getPos
            addWarning ("Could not resolveValue variables " <> tshow varnames <> " at " <> tshow position)
            return $ Left $ Value $ VariableReference (head varnames)
        else return $ case head matching of
            (x,_) -> x

tryResolveValue   (Interpolable x) = do
    resolved <- mapM tryResolveValueString x
    if null $ lefts resolved
        then return $ Right $ ResolvedString $ T.concat $ rights resolved
        -- if it is not resolved, we will try to store it as resolved as
        -- possible, so as not to lose the context
        else fmap (Left . Value . Interpolable)
                    (mapM tryResolveValue x >>= mapM generalValue2Value)

tryResolveValue n@(PuppetHash (Parameters x)) = do
    resolvedKeys <- mapM (tryResolveExpressionString . fst) x
    resolvedValues <- mapM (tryResolveExpression . snd) x
    return $ if null (lefts resolvedKeys) && null (lefts resolvedValues)
                 then Right $ ResolvedHash $ zip (rights resolvedKeys) (rights resolvedValues)
                 else Left $ Value n

tryResolveValue n@(PuppetArray expressions) = do
    resolvedExpressions <- mapM tryResolveExpression expressions
    return $ if null $ lefts resolvedExpressions
                 then Right $ ResolvedArray $ rights resolvedExpressions
                 else Left $ Value n


tryResolveValue   (FunctionCall "generate" args) = if null args
    then throwPosError "Empty argument list in generate"
    else do
        nargs   <- mapM resolveExpressionString args
        let cmdname:cmdargs = nargs
        gens    <- liftIO $ generate cmdname cmdargs
        case gens of
            Just w  -> return $ Right $ ResolvedString w
            Nothing -> throwPosError $ "Function call generate for command " <> cmdname <> " (" <> tshow cmdargs <> ") failed"

tryResolveValue n@(FunctionCall "pdbresourcequery" (query:xs)) = do
    let
        rvalue2query :: ResolvedValue -> Either String PDB.Query
        rvalue2query (ResolvedArray (ResolvedString o : nxs)) = case PDB.getOperator o of
                                                                    Just PDB.OAnd -> fmap (PDB.Query PDB.OAnd) (mapM rvalue2query nxs)
                                                                    Just PDB.OOr  -> fmap (PDB.Query PDB.OOr)  (mapM rvalue2query nxs)
                                                                    Just PDB.ONot -> fmap (PDB.Query PDB.ONot) (mapM rvalue2query nxs)
                                                                    Just op       -> fmap (PDB.Query op)       (mapM rvalue2query' nxs)
                                                                    Nothing       -> Left $ "Can't resolve operator " ++ T.unpack o
        rvalue2query x = Left $ "Don't know what to do with " ++ T.unpack (showValue x)

        rvalue2query' :: ResolvedValue -> Either String PDB.Query
        rvalue2query' (ResolvedArray x)  = fmap PDB.Terms (mapM rvalue2string x)
        rvalue2query' x = fmap PDB.Term (rvalue2string x)
        rvalue2string :: ResolvedValue -> Either String T.Text
        rvalue2string (ResolvedString s) = Right s
        rvalue2string (ResolvedBool True) = Right "true"
        rvalue2string (ResolvedBool False) = Right "false"
        rvalue2string x = Left $ "Don't know why we had " ++ T.unpack (showValue x)
    rkey <- case xs of
                [key] -> do
                    r <- tryResolveExpression key
                    case r of
                        Right (ResolvedString keyname) -> return $ Right $ Just keyname
                        Right x                        -> throwPosError $ "The pdbresourcequery function expects a string as the second argument, not " <> showValue x
                        Left  y                        -> return $ Left y
                []    -> return $ Right Nothing
                _     -> throwPosError "Bad number of arguments for function pdbresourcequery"
    rquery <- tryResolveExpression query
    case (rquery, rkey) of
        (Right a@(ResolvedArray _), Right keyname)  -> case rvalue2query a of
                                                           Right q -> fmap Right (pdbresourcequery q keyname)
                                                           Left rr -> throwPosError ("Could not transform " <> showValue a <> " to a PuppetDB query: " <> T.pack rr)
        (Right a, Right _) -> throwPosError $ "The pdbresourcequery function expects an array as the first argument, not " <> showValue a
        _ -> return $ Left $ Value n

tryResolveValue n@(FunctionCall "is_domain_name" [x]) = do
    rx <- tryResolveExpressionString x
    case rx of
        Right s -> let
            goodpart gs = T.length gs < 64 && not (T.null gs) && isAlpha (T.head gs) && (T.all (\gx -> gx == '-' || isAlphaNum gx) gs)
            badparts "" = False
            badparts str =
                let (b,e) = T.break (=='.') str
                in case (goodpart b, e) of
                    (True , "") -> False
                    (True ,  y) -> badparts (T.tail y)
                    (False,  _) -> True
            bad = T.null s || T.length s > 255 || badparts s
            -- TODO check the parts are 63 char long
            in return $ Right $ ResolvedBool $ not bad
        _ -> return $ Left $ Value n

tryResolveValue   (FunctionCall "fqdn_rand" args) = if null args
    then throwPosError "Empty argument list in fqdn_rand call"
    else do
        nargs  <- mapM resolveExpressionString args
        curmax <- readint (head nargs)
        hostname <- getVariable "::fqdn" >>= \x -> case x of
                                                       Just (Right (ResolvedString g),_) -> return g
                                                       _ -> throwPosError "Can't get fqdn in fqdn_rand?"
        let targs = tail nargs
            rargs = if null targs
                        then [hostname, ""]
                        else hostname : targs
        liftM (Right . ResolvedInt) (fqdn_rand curmax rargs)
tryResolveValue   (FunctionCall "mysql_password" args) = if length args /= 1
    then throwPosError "mysql_password takes a single argument"
    else do
        es <- tryResolveExpressionString (head args)
        case es of
            Right s -> liftM (Right . ResolvedString) (mysql_password s)
            Left  u -> return $ Left u
tryResolveValue   (FunctionCall "template" [name]) = do
    fname <- tryResolveExpressionString name
    case fname of
        Left x -> throwPosError $ "Can't resolve template path " <> tshow x
        Right filename -> do
            vars <- fmap curVariables get >>= DT.mapM (\(v,p) -> fmap (\x -> (x,p)) (tryResolveGeneralValue v))
            saveVariables vars
            scp <- liftM head getScope -- TODO check if that sucks
            templatefunc <- liftM computeTemplateFunction get
            out <- liftIO (templatefunc (Right filename) scp (Map.map fst vars))
            case out of
                Right x -> return $ Right $ ResolvedString x
                Left err -> throwPosError (T.pack err)
tryResolveValue   (FunctionCall "inline_template" [cnt]) = do
    rcnt <- tryResolveExpressionString cnt
    case rcnt of
        Left x -> throwPosError $ "Can't resolve inline_template content " <> tshow x
        Right content -> do
            vars <- fmap curVariables get >>= DT.mapM (\(v,p) -> fmap (\x -> (x,p)) (tryResolveGeneralValue v))
            saveVariables vars
            scp <- liftM head getScope -- TODO check if that sucks
            templatefunc <- liftM computeTemplateFunction get
            out <- liftIO (templatefunc (Left content) scp (Map.map fst vars))
            case out of
                Right x -> return $ Right $ ResolvedString x
                Left err -> throwPosError (T.pack err)
tryResolveValue   (FunctionCall "defined" [v]) = do
    rv <- tryResolveExpression v
    case rv of
        Left n -> return $ Left n
        -- TODO BUG
        Right (ResolvedString typeorclass) -> do
            ntypes <- fmap nativeTypes get
            -- is it a loaded class or a define ?
            if Map.member typeorclass ntypes
                then return $ Right $ ResolvedBool True
                else do
                    isdefine <- checkDefine typeorclass
                    case isdefine of
                        Just _  -> return $ Right $ ResolvedBool True
                        Nothing -> liftM (Right . ResolvedBool . Map.member typeorclass . curClasses) get
        Right (ResolvedRReference rtype (ResolvedString rname)) -> do
            defset <- fmap definedResources get
            return $ Right $ ResolvedBool (Map.member (rtype, rname) defset)
        Right x -> throwPosError $ "Can't know if this could be defined : " <> tshow x
tryResolveValue n@(FunctionCall "regsubst" [str, src, dst, flags]) = do
    rstr   <- tryResolveExpressionString str
    rsrc   <- tryResolveExpressionString src
    rdst   <- tryResolveExpressionString dst
    rflags <- tryResolveExpressionString flags
    case (rstr, rsrc, rdst, rflags) of
        (Right sstr, Right ssrc, Right sdst, Right sflags) -> liftM (Right . ResolvedString) (regsubst sstr ssrc sdst sflags)
        _                                                  -> return $ Left $ Value n
tryResolveValue   (FunctionCall "regsubst" [str, src, dst]) = tryResolveValue (FunctionCall "regsubst" [str, src, dst, Value $ Literal ""])
tryResolveValue   (FunctionCall "regsubst" args) = throwPosError ("Bad argument count for regsubst " <> tshow args)

tryResolveValue n@(FunctionCall "chomp" [str]) = do
    let mmychomp (ResolvedString s) = return $ ResolvedString (T.stripEnd s)
        mmychomp r                    = throwPosError $ "The chomp function expects strings or arrays of strings, not this: " <> tshow r
    rstr <- tryResolveExpression str
    case rstr of
        Left  _ -> return $ Left $ Value n
        Right (ResolvedArray  arr) -> fmap (Right . ResolvedArray) (mapM mmychomp arr)
        Right x                    -> fmap Right (mmychomp x)

tryResolveValue n@(FunctionCall "split" [str, reg]) = do
    rstr   <- tryResolveExpressionString str
    rreg   <- tryResolveExpressionString reg
    case (rstr, rreg) of
        (Right sstr, Right sreg) -> do
            sp <- liftIO $ puppetSplit sstr sreg
            case sp of
                Right o -> return $ Right $ ResolvedArray $ map ResolvedString o
                Left  r -> throwPosError $ "split error: " <> tshow r
        _                        -> return $ Left $ Value n
tryResolveValue   (FunctionCall "split" _) = throwPosError "Bad argument count for function split"
tryResolveValue n@(FunctionCall "upcase"  args) = stringTransform args n T.toUpper
tryResolveValue n@(FunctionCall "lowcase" args) = stringTransform args n T.toLower
tryResolveValue n@(FunctionCall "sha1"    args) = stringTransform args n puppetSHA1
tryResolveValue n@(FunctionCall "md5"     args) = stringTransform args n puppetMD5

tryResolveValue n@(FunctionCall "versioncmp" [a,b]) = do
    ra <- tryResolveExpressionString a
    rb <- tryResolveExpressionString b
    case (ra, rb) of
        (Right sa, Right sb)    -> return $ Right $ ResolvedInt (versioncmp sa sb)
        _                       -> return $ Left $ Value n
tryResolveValue n@(FunctionCall "file" filelist) = do
    -- resolving the list of file pathes
    rfilelist <- mapM tryResolveExpressionString filelist
    let (lf, rf) = partitionEithers rfilelist
    if null lf
        then do
            content <- liftIO $ file rf
            case content of
                Nothing -> throwPosError $ "Files " <> tshow rf <> " could not be found"
                Just x  -> return $ Right $ ResolvedString x
        else return $ Left $ Value n
tryResolveValue n@(FunctionCall "getvar" [varinfo]) = do
    varname <- tryResolveExpressionString varinfo
    case varname of
        Right s -> tryResolveValue (VariableReference s)
        Left  _ -> return $ Left $ Value n
tryResolveValue   (FunctionCall "getvar" nn) = throwPosError $ "getvar expects a single argument, not " <> tshow (length nn)
tryResolveValue n@(FunctionCall "is_string" [varinfo]) = do
    varname <- tryResolveExpression varinfo
    case varname of
        Right (ResolvedString _) -> return $ Right $ ResolvedBool True
        Right _ -> return $ Right $ ResolvedBool False
        Left _ -> return $ Left $ Value n
tryResolveValue n@(FunctionCall fname args) = do
    ufunctions <- fmap userFunctions get
    l <- fmap luaState get
    case (l, Set.member fname ufunctions) of
     (Just ls, True) -> do
        rargs <- mapM tryResolveExpression args
        if null (lefts rargs)
            then fmap Right (puppetFunc ls fname (rights rargs))
            else return $ Left $ Value n
     _               -> throwPosError ("FunctionCall " <> fname <> " not implemented")

tryResolveValue Undefined = return $ Right ResolvedUndefined
tryResolveValue (PuppetRegexp x) = return $ Right $ ResolvedRegexp x

tryResolveValue x = throwPosError ("tryResolveValue not implemented for " <> tshow x)

tryResolveValueString :: Value -> CatalogMonad GeneralString
tryResolveValueString x = do
    r <- tryResolveValue x
    case r of
        Right (ResolvedString v)   -> return $ Right v
        Right (ResolvedInt    i)   -> return $ Right (tshow i)
        Right (ResolvedDouble i)   -> return $ Right (tshow i)
        Right (ResolvedBool True)  -> return $ Right "True"
        Right (ResolvedBool False) -> return $ Right "False"
        Right v                    -> throwPosError ("Can't resolve valuestring for " <> tshow v)
        Left  v                    -> return $ Left v

getRelationParameterType :: GeneralString -> Maybe LinkType
getRelationParameterType (Right "require" )  = Just RRequire
getRelationParameterType (Right "notify"  )  = Just RNotify
getRelationParameterType (Right "before"  )  = Just RBefore
getRelationParameterType (Right "subscribe") = Just RSubscribe
getRelationParameterType _                   = Nothing

-- this function saves a new condition for collection
pushRealize :: ResolvedValue -> CatalogMonad ()
pushRealize (ResolvedRReference rtype (ResolvedString rname)) = do
    let myfunction :: CResource -> CatalogMonad Bool
        myfunction (CResource _ mcrname mcrtype _ _ _ _) = do
            srname <- resolveGeneralString mcrname
            return ((srname == rname) && (mcrtype == rtype))
    addCollect ((myfunction, Just $ PDB.queryRealize rtype rname) , Map.empty)
    return ()
pushRealize (ResolvedRReference _ x) = throwPosError (tshow x <> " was not resolved to a string")
pushRealize x                        = throwPosError ("A reference was expected instead of " <> tshow x)

executeFunction :: T.Text -> [ResolvedValue] -> CatalogMonad Catalog
executeFunction "fail" [ResolvedString errmsg] = throwPosError ("Error: " <> errmsg)
executeFunction "fail" args = throwPosError ("Error: " <> tshow args)
executeFunction "realize" rlist = mapM_ pushRealize rlist >> return []
executeFunction "dumpvariables" _ = do
    vars <- fmap curVariables get
    mapM_ (liftIO . print) (Map.toList vars)
    return []
executeFunction "create_resources" (mrtype:rdefs:rest) = do
--        applyDefaults' :: CResource -> ResDefaults -> CatalogMonad CResource
--        data ResDefaults = RDefaults String [(GeneralString, GeneralValue)] SourcePos
--
--
    mrrtype <- case mrtype of
        ResolvedString x -> return x
        _                -> throwPosError $ "Resource type must be a string and not " <> tshow mrtype
    arghash <- case rdefs of
        ResolvedHash x -> return x
        _              -> throwPosError $ "Resource definition must be a hash, and not " <> tshow rdefs
    position <- getPos
    defaults <- case rest of
                    [ResolvedHash h] -> return $ RDefaults mrrtype (Map.fromList $ map (Right *** Right) h) position
                    []  -> return $ RDefaults mrrtype Map.empty position
                    _   -> throwPosError ("Bad many arguments to create_resources: " <> tshow rest)
    let prestatements = map (\(rname, rargs) -> (Value $ Literal rname, resolved2expression rargs)) arghash
    resources <- mapM (\(resname, pval) -> do
            realargs <- case pval of
                Value (PuppetHash (Parameters h)) -> return h
                _                    -> throwPosError "This should not happen, create_resources argument is not a hash"
            return $ Resource mrrtype resname realargs Normal position
        ) prestatements
    liftM concat (mapM evaluateStatements resources) >>= mapM (\r -> applyDefaults' r defaults)
executeFunction "create_resources" x = throwPosError ("Bad arguments to create_resources: " <> tshow x)
executeFunction "validate_array" [x] = case x of
    ResolvedArray _ -> return []
    y               -> throwPosError $ tshow y <> " is not an array"
executeFunction "validate_hash" [x] = case x of
    ResolvedHash _ -> return []
    y              -> throwPosError $ tshow y <> " is not a hash"
executeFunction "validate_string" [x] = case x of
    ResolvedString _ -> return []
    y                -> throwPosError $ tshow y <> " is not an string"
executeFunction "validate_re" [x,re] = case (x,re) of
    (ResolvedString z, ResolvedString rre) -> do
        m <- liftIO $ regmatch z rre
        case m of
            Right True  -> return []
            Right False -> throwPosError $ tshow x <> " does not match the regexp " <> tshow rre
            Left err    -> throwPosError $ "Error with regexp " <> tshow rre <> ": " <> T.pack err
    (y,z) -> throwPosError $ "Can't compare " <> tshow y <> " to regexp " <> tshow z
executeFunction "validate_bool" [x] = case x of
    ResolvedBool _ -> return []
    y              -> throwPosError $ tshow y <> " is not a boolean"
executeFunction fname args = do
    ufunctions <- fmap userFunctions get
    l <- fmap luaState get
    case (l, Set.member fname ufunctions) of
     (Just ls, True) -> do
         o <- puppetFunc ls fname args
         case o of
             ResolvedBool True  -> return []
             ResolvedBool False -> throwPosError ("Function " <> fname <> "(" <> tshow args <> ") returned false")
             x                  -> throwPosError ("Function " <> fname <> "(" <> tshow args <> ") did not return a bool: " <> tshow x)
     _               -> do
         position <- getPos
         addWarning $ "Function " <> fname <> "(" <> tshow args <> ") not handled at " <> tshow position
         return []

compareExpression :: Expression -> Expression -> CatalogMonad (Maybe Ordering)
compareExpression a b = do
    ra <- tryResolveExpression a
    rb <- tryResolveExpression b
    case (ra, rb) of
        (Right rra, Right rrb) -> return $ Just $ compareValues rra rrb
        _ -> return $ compareSemiResolved ra rb

compareSemiResolved :: GeneralValue -> GeneralValue -> Maybe Ordering
compareSemiResolved a@(Right _) b@(Left _) = compareSemiResolved b a
compareSemiResolved (Left (Value (VariableReference _))) (Left (Value (VariableReference _))) = Just EQ
compareSemiResolved (Left (Value (VariableReference _))) (Left (Value (Literal "")))          = Just EQ
compareSemiResolved (Left (Value (VariableReference _))) (Left (Value (Literal "false")))     = Just EQ
compareSemiResolved a b                                                                       = Just (compare a b)

compareGeneralValue :: GeneralValue -> Expression -> Expression -> [Ordering] -> CatalogMonad GeneralValue
compareGeneralValue n a b acceptable = do
    cmp <- compareExpression a b
    case cmp of
        Nothing -> return n
        Just x  -> return $ Right $ ResolvedBool (x `elem` acceptable)
compareValues :: ResolvedValue -> ResolvedValue -> Ordering
compareValues (ResolvedString s) (ResolvedBool b)  = case (s,b) of
                                                         ("true", True)   -> EQ
                                                         ("false", False) -> EQ
                                                         _                -> LT
compareValues a@(ResolvedBool _)   b@(ResolvedString _) = compareValues b a
compareValues a@(ResolvedString _) b@(ResolvedInt _) = compareValues b a
compareValues   (ResolvedInt a)      (ResolvedString b) = case readDecimal b of
                                                              Right bi -> compare a bi
                                                              _ -> LT
compareValues (ResolvedString a) (ResolvedRegexp b) = case unsafePerformIO (regmatch a b) of
                                                          Right True  -> EQ
                                                          _           -> LT
compareValues (ResolvedString a)   (ResolvedString b)   = comparing T.toCaseFold a b
compareValues x y = compare x y

compareRValues :: ResolvedValue -> ResolvedValue -> Bool
compareRValues a b = compareValues a b == EQ

-- used to handle the special cases when we know it is a boolean context
tryResolveBoolean :: GeneralValue -> CatalogMonad GeneralValue
tryResolveBoolean v = do
    rv <- tryResolveGeneralValue v
    case rv of
        Left BFalse                     -> return $ Right $ ResolvedBool False
        Left BTrue                      -> return $ Right $ ResolvedBool True
        Right (ResolvedString "")       -> return $ Right $ ResolvedBool False
        Right (ResolvedString _)        -> return $ Right $ ResolvedBool True
        Right (ResolvedInt _)           -> return $ Right $ ResolvedBool True
        Right  ResolvedUndefined        -> return $ Right $ ResolvedBool False
        Right (ResolvedArray _)         -> return $ Right $ ResolvedBool True
        Right (ResolvedRReference _ _)  -> return $ Right $ ResolvedBool True
        Left (Value (VariableReference _)) -> return $ Right $ ResolvedBool False
        Left (EqualOperation (Value (VariableReference _)) (Value (Literal ""))) -> return $ Right $ ResolvedBool True -- case where a variable was not resolved and compared to the empty string
        Left (EqualOperation (Value (VariableReference _)) (Value (Literal "true"))) -> return $ Right $ ResolvedBool False -- case where a variable was not resolved and compared to the string "true"
        Left (EqualOperation (Value (VariableReference _)) (Value (Literal "false"))) -> return $ Right $ ResolvedBool True -- case where a variable was not resolved and compared to the string "false"
        _ -> return rv

resolveBoolean :: GeneralValue -> CatalogMonad Bool
resolveBoolean v = do
    rv <- tryResolveBoolean v
    case rv of
        Right (ResolvedBool x) -> return x
        n -> throwPosError ("Could not resolve " <> tshow n <> "(was " <> tshow rv <> ") as a boolean")

resolveGeneralString :: GeneralString -> CatalogMonad T.Text
resolveGeneralString (Right x) = return x
resolveGeneralString (Left y) = resolveExpressionString y

collectionFunction :: Virtuality -> T.Text -> Expression -> CatalogMonad (CResource -> CatalogMonad Bool, Maybe PDB.Query)
collectionFunction virt mrtype exprs = do
    (finalfunc, pdbquery) <- case exprs of
        BTrue -> return (\_ -> return True, Just (PDB.collectAll mrtype))
        EqualOperation a b -> do
            ra <- resolveExpression a
            rb <- resolveExpression b
            paramname <- case ra of
                ResolvedString pname -> return pname
                _ -> throwPosError "We only support collection of the form 'parameter == value'"
            defstatement <- checkDefine mrtype
            paramset <- case defstatement of
                Nothing -> fmap nativeTypes get >>= \nt -> case Map.lookup mrtype nt of
                    Just (PuppetTypeMethods _ ps) -> return ps
                    Nothing -> throwPosError $ "Unknown type " <> mrtype <> " when trying to collect"
                Just (DefineDeclaration _ params _ _) -> return $ Set.fromList $ map fst params
                Just x -> throwPosError $ "Expected a DefineDeclaration here instead of " <> tshow x
            when (Set.notMember paramname paramset && not (Set.member paramname metaparameters)) $
                throwPosError $ "Parameter " <> paramname <> " is not a valid parameter. It should be in : " <> tshow (Set.toList paramset)
            return (\r ->
                case Map.lookup (Right paramname) (crparams r) of
                    Nothing -> return False
                    Just prmmatch -> do
                        cmp <- resolveGeneralValue prmmatch
                        case (paramname, cmp) of
                            ("tag", ResolvedArray xs) ->
                                let filtered = filter (compareRValues rb) xs
                                in  return $ not $ null filtered
                            _ -> return $ compareRValues cmp rb
                , case (paramname, rb) of
                      ("tag", ResolvedString tagval) -> Just (PDB.collectTag mrtype tagval)
                      (param, ResolvedString prmval) -> Just (PDB.collectParam mrtype param prmval)
                      _                              -> Nothing
                )
        x -> throwPosError $ "TODO : implement collection function for " <> tshow x
    return (\res ->
        -- <| |> matches Normal resources
        if (crtype res == mrtype) && ( ((virt == Virtual) &&  (crvirtuality res == Normal)) || (crvirtuality res == virt))
            then finalfunc res
            else return False
        , if virt == Exported
              then pdbquery
              else Nothing
        )


generalValue2Expression :: GeneralValue -> Expression
generalValue2Expression (Left x) = x
generalValue2Expression (Right y) = resolved2expression y

generalValue2Value :: GeneralValue -> CatalogMonad Value
generalValue2Value x = case generalValue2Expression x of
                           (Value z) -> return z
                           y         -> throwPosError $ "Could not downgrade this to a value: " <> tshow y

resolved2expression :: ResolvedValue -> Expression
resolved2expression (ResolvedString str) = Value $ Literal str
resolved2expression (ResolvedInt i) = Value $ Integer i
resolved2expression (ResolvedBool True) = BTrue
resolved2expression (ResolvedBool False) = BFalse
resolved2expression (ResolvedRReference mrtype name) = Value $ ResourceReference mrtype (resolved2expression name)
resolved2expression (ResolvedArray vals) = Value $ PuppetArray $ map resolved2expression vals
resolved2expression (ResolvedHash hash) = Value $ PuppetHash $ Parameters $ map (\(s,v) -> (Value $ Literal s, resolved2expression v)) hash
resolved2expression  ResolvedUndefined = Value Undefined
resolved2expression (ResolvedRegexp a) = Value $ PuppetRegexp a
resolved2expression (ResolvedDouble d) = Value $ Double d

arithmeticOperation :: Expression -> Expression -> (Integer -> Integer -> Integer) -> (Double -> Double -> Double) -> GeneralValue -> CatalogMonad GeneralValue
arithmeticOperation a b opi opf def = do
    ra <- tryResolveExpression a
    rb <- tryResolveExpression b
    case (ra, rb) of
        (Right (ResolvedInt sa)   , Right (ResolvedInt    sb)) -> return $ Right $ ResolvedInt $ opi sa sb
        (Right (ResolvedDouble sa), Right (ResolvedInt    sb)) -> return $ Right $ ResolvedDouble $ opf sa (fromIntegral sb)
        (Right (ResolvedInt sa)   , Right (ResolvedDouble sb)) -> return $ Right $ ResolvedDouble $ opf (fromIntegral sa) sb
        (Right (ResolvedDouble sa), Right (ResolvedDouble sb)) -> return $ Right $ ResolvedDouble $ opf sa sb
        _ -> return def


stringTransform :: [Expression] -> Value -> (T.Text -> T.Text) -> CatalogMonad GeneralValue
stringTransform [u] n f = do
    r <- tryResolveExpressionString u
    case r of
        Right s -> return $ Right $ ResolvedString $ f s
        Left _  -> return $ Left $ Value n
stringTransform _ _ _ = throwPosError "This function takes a single argument."