Eval.hs

module Eval where
import Types
import Debug
import Data.Maybe
import Data.List
import Debug.Trace

eval, evalFull :: Environment -> Expr -> Expr --only focus on one expression
findVar :: Environment -> SymbolName -> Expr
findVar e v = fromJust $ lookup v e
addVar :: Environment -> SymbolName -> Expr -> Environment
addVar = notImplemented

debug x = trace ("{{" ++ x ++ "}}")

eval env expr = traceShow expr $ let (eval', evalFull') = (eval env, evalFull env) in case expr of -- evaluates expression to weak-head normal form (i.e. top level data structure is not a FuncCall)
    FuncCall func inputSets args -> let (inputSets', args') = (map eval' inputSets, map eval' args) in case func of
        (PredefFunc f) -> case f of
            Filter -> let (Set inputRecords,predicate) = (eval' $ head inputSets, eval' $ head args) in
                Set $ filter ((==Boolean True).(\r -> eval' $ FuncCall predicate [] [r])) $ map eval' inputRecords
              
            Map -> Set (map (\record -> eval' $ FuncCall lambda [] [record]) records)
                where
                    (Set records:_) = inputSets
                    (lambda:_) = args

            IsEqual -> let (e1:e2:_) = args' in -- TODO not sufficent.
                Boolean (e1 == e2)
            
            XProduct -> let ((Set l1): (Set l2):_) = inputSets' in
                Set $ [ x `concatRecord` y | x <- l1, y <- l2]

            RecordIndex -> let (Record recordData:Int index:_) = args' in
                recordData !! (index - 1)

            RecordSelect -> Record filteredList
                where
                    (Record recordData: indexes) = map eval' args -- 
                    indexesRaw = map (\(Int i) -> i - 1) indexes

                    filteredList = map (recordData!!) indexesRaw
                    
                    {-numberedElems = zip [1..] recordData :: [(Int, Expr)]
                    filtered = filter ((`elem` indexesRaw).fst) numberedElems :: [(Int, Expr)]
                    filteredList = map snd filtered :: [Expr]-}
                
            IsEmpty -> case eval' (head args) of
                (String a) -> Boolean $ null a

            Contains -> case args of
                (mainString:containsWhat:_) -> case (eval' mainString , eval' containsWhat) of
                    (String a, String b) -> Boolean $ b `isSubList` a
            Plus -> let (e1:e2:_) = args in case (eval' e1, eval' e2) of
                (String a, String b) -> String (a ++ b)
                (Record a, Record b) -> Record (a ++ b)
                _ -> error "eval error"


            --implement later
            --(Map) -> Set $ (map (\r -> FuncCall predicate [] [r]) inputRecords)
        (FuncDef setParams argParams body) -> eval newEnv body
            where
                newEnv = let (setEnv, argsEnv) = (zip setParams inputSets, zip argParams args) in setEnv ++ argsEnv ++ env
                --newEnv = foldl (\env entry@(name, expr) -> addVar env name expr) env --adds entries to environment
                -- TODO FIX
    (Var name) -> eval' $ findVar env name


    (Let _ _ expr) -> expr

    (If cond e1 e2) -> case eval' cond of
        (Boolean True) -> e1
        (Boolean False) -> e2

    control@(Control lastResult exprs) -> if null exprs then lastResult else 
        let (newEnv, newControl) =  evalControl1 env control in
            eval newEnv newControl

    (Record exprs) -> Record $ map eval' exprs
    _ -> expr

evalControl1 :: Environment -> Expr -> (Environment, Expr)
evalControl1 env (Control last (currentExpr:exprs)) = (newEnv, Control newLast exprs)
    where
        newLast = eval env $ case currentExpr of
            (FuncCall func [] args) -> FuncCall func [last] args
            (Let False _ _) -> last
            _ -> currentExpr

        newEnv = case currentExpr of
            (Let _ var expr) -> (var,expr):env
            _ -> env

evalFull = eval
--evalFull env (Set xs) = Set (map (eval env) xs) -- evaluates expression fully (not just weak head normal form)
--evalFull _ e = e
--TODO implement properly
concatRecord (Record r1) (Record r2) = Record (r1 ++ r2)

listStartsWith, isSubList :: Eq a => [a] -> [a] -> Bool
listStartsWith = notImplemented -- check if first list starts with second list
isSubList main sub = sub `isInfixOf` main-- check if first list contains second list anywhere in it