<commit_before>module Puppet.Interpreter.Catalog (
    getCatalog
    ) where

import Puppet.Init
import Puppet.DSL.Types
import Puppet.Interpreter.Functions
import Puppet.Interpreter.Types

import Data.List
import Data.Char (isDigit)
import Data.Maybe (isJust, fromJust)
import Data.Either (lefts, rights)
import Text.Parsec.Pos
import Control.Monad (foldM)
import Control.Monad.State
import Control.Monad.Error
import qualified Data.Map as Map
import qualified Data.Set as Set

-- Int handling stuff
isInt :: String -> Bool
isInt = and . map isDigit
readint :: String -> CatalogMonad Integer
readint x = if (isInt x)
    then return (read x)
    else do
        pos <- getPos
        throwError ("Expected an integer instead of '" ++ x ++ "' at " ++ show pos)

modifyScope     f (ScopeState curscope curvariables curclasses curdefaults rid pos ntl gsf wrn)
    = ScopeState (f curscope) curvariables curclasses curdefaults rid pos ntl gsf wrn
modifyVariables f (ScopeState curscope curvariables curclasses curdefaults rid pos ntl gsf wrn)
    = ScopeState curscope (f curvariables) curclasses curdefaults rid pos ntl gsf wrn
modifyClasses   f (ScopeState curscope curvariables curclasses curdefaults rid pos ntl gsf wrn)
    = ScopeState curscope curvariables (f curclasses) curdefaults rid pos ntl gsf wrn
modifyDefaults  f (ScopeState curscope curvariables curclasses curdefaults rid pos ntl gsf wrn)
    = ScopeState curscope curvariables curclasses (f curdefaults) rid pos ntl gsf wrn
incrementResId    (ScopeState curscope curvariables curclasses curdefaults rid pos ntl gsf wrn)
    = ScopeState curscope curvariables curclasses curdefaults (rid + 1) pos ntl gsf wrn
setStatePos  npos (ScopeState curscope curvariables curclasses curdefaults rid pos ntl gsf wrn)
    = ScopeState curscope curvariables curclasses curdefaults rid npos ntl gsf wrn
modifyNestedTopLvl f (ScopeState curscope curvariables curclasses curdefaults rid pos ntl gsf wrn)
    = ScopeState curscope curvariables curclasses curdefaults rid pos (f ntl) gsf wrn
emptyDefaults     (ScopeState curscope curvariables curclasses _ rid pos ntl gsf wrn)
    = ScopeState curscope curvariables curclasses [] rid pos ntl gsf wrn

getCatalog :: (TopLevelType -> String -> IO (Either String Statement)) -> String -> Facts -> IO (Either String FinalCatalog, [String])
getCatalog getstatements nodename facts = do
    let convertedfacts = Map.map
            (\fval -> (Right fval, initialPos "FACTS"))
            facts
    (output, finalstate) <- runStateT ( runErrorT ( computeCatalog getstatements nodename ) ) (ScopeState [] convertedfacts Map.empty [] 1 (initialPos "dummy") Map.empty getstatements [])
    case output of
        Left x -> return (Left x, getWarnings finalstate)
        Right y -> return (output, getWarnings finalstate)

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

resolveRelation :: ResIdentifier -> (LinkType, GeneralValue, GeneralValue) -> CatalogMonad Relation
resolveRelation srcres (l,a,b) = do
    ra <- resolveGeneralValueString a
    rb <- resolveGeneralValueString b
    return (l,srcres, (ra,rb))

finalizeResource :: CResource -> CatalogMonad (ResIdentifier, RResource)
finalizeResource (CResource cid cname ctype cparams crelations _ cpos) = do
    setPos cpos
    rname <- resolveGeneralString cname
    rparams <- mapM (\(a,b) -> do { ra <- resolveGeneralString a; rb <- resolveGeneralValue b; return (ra,rb); }) cparams<commit_msg>More readable with syntactic sugar<commit_after>module Puppet.Interpreter.Catalog (
    getCatalog
    ) where

import Puppet.Init
import Puppet.DSL.Types
import Puppet.Interpreter.Functions
import Puppet.Interpreter.Types

import Data.List
import Data.Char (isDigit)
import Data.Maybe (isJust, fromJust)
import Data.Either (lefts, rights)
import Text.Parsec.Pos
import Control.Monad (foldM)
import Control.Monad.State
import Control.Monad.Error
import qualified Data.Map as Map
import qualified Data.Set as Set

-- Int handling stuff
isInt :: String -> Bool
isInt = and . map isDigit
readint :: String -> CatalogMonad Integer
readint x = if (isInt x)
    then return (read x)
    else do
        pos <- getPos
        throwError ("Expected an integer instead of '" ++ x ++ "' at " ++ show pos)

modifyScope     f sc = sc { curScope     = f $ curScope sc }
modifyVariables f sc = sc { curVariables = f $ curVariables sc }
modifyClasses   f sc = sc { curClasses   = f $ curClasses sc }
modifyDefaults  f sc = sc { curDefaults  = f $ curDefaults sc }
incrementResId    sc = sc { curResId     = (curResId sc) + 1 }
setStatePos  npos sc = sc { curPos       = npos }
modifyNestedTopLvl f sc = sc { netstedtoplevels = f $ netstedtoplevels sc }
emptyDefaults     sc = sc { curDefaults  = [] }

getCatalog :: (TopLevelType -> String -> IO (Either String Statement)) -> String -> Facts -> IO (Either String FinalCatalog, [String])
getCatalog getstatements nodename facts = do
    let convertedfacts = Map.map
            (\fval -> (Right fval, initialPos "FACTS"))
            facts
    (output, finalstate) <- runStateT ( runErrorT ( computeCatalog getstatements nodename ) ) (ScopeState [] convertedfacts Map.empty [] 1 (initialPos "dummy") Map.empty getstatements [])
    case output of
        Left x -> return (Left x, getWarnings finalstate)
        Right y -> return (output, getWarnings finalstate)

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

resolveRelation :: ResIdentifier -> (LinkType, GeneralValue, GeneralValue) -> CatalogMonad Relation
resolveRelation srcres (l,a,b) = do
    ra <- resolveGeneralValueString a
    rb <- resolveGeneralValueString b
    return (l,srcres, (ra,rb))

finalizeResource :: CResource -> CatalogMonad (ResIdentifier, RResource)
finalizeResource (CResource cid cname ctype cparams crelations _ cpos) = do
    setPos cpos
    rname <- resolveGeneralString cname
    rparams <- mapM (\(a,b) -> do { ra <- resolveGeneralString a; rb <- resolveGeneralValue b; return (ra,rb); }) cparams
{'fraction_non_alphanumeric': 0.07990867579908675, 'fraction_numerical': 0.0006088280060882801, 'mean_word_length': 3.903731343283582, 'pattern_counts': {'":': 0, '<': 21, '<?xml version=': 0, '>': 47, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1050691', 'n_tokens_mistral': 1935, 'n_tokens_neox': 1916, 'n_words': 684}