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 -> Maybe Expr
findVar e v = lookup v e
addVar :: Environment -> SymbolName -> Expr -> Environment
addVar = notImplemented

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

eval env 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 (func', inputSets', args') = (eval' func, map eval' inputSets, map eval' args) in case func' of
        (PredefFunc f) -> case f of                
            Filter -> case (inputSets', args') of
                ([Set inputRecords], [predicate]) -> let func = (\r -> eval' $ FuncCall predicate [] [r]) in
                    Set $ filter ((==Boolean True).func) inputRecords
                _ -> error "Filter argument error"


            Map -> eval' $ case(inputSets', args') of
                ([Set records], [lambda]) -> Set (map (\record -> FuncCall lambda [] [record]) records)
                _ -> error "Map argument error"

            IsEqual -> case args' of -- TODO not sufficent.
                [e1, e2] -> Boolean (e1 == e2)
                _ -> error "isEqual argument error"
            
            XProduct -> eval' $ case inputSets' of
                [Set l1, Set l2] -> Set $ [ x `concatRecord` y | x <- l1, y <- l2]
                _ -> error "X product takes in two sets"
            
            (ComparisonFunc op) -> case args' of
                [e1, e2] -> Boolean $ e1 `op` e2
                _ -> error "Comparison must take in two arguments"

            (BooleanFunc op) -> case args' of 
                [Boolean e1, Boolean e2] -> Boolean (e1 `op` e2)
                _ -> error "Boolean function AND/OR takes in two arguments."

            RecordIndex -> eval' $ case args' of --TODO rename
                [Record recordData,Int index] -> recordData `listAtIndex` index
                [String stringData,Int index] -> String [stringData `listAtIndex` index]

            RecordSelect -> case args' of
                (Record recordData: indexes ) -> Record filteredList
                    where
                        indexesRaw = map checkInt indexes
                        --filteredList = map (eval'.(recordData !!)) indexesRaw
                        filteredList = map (eval'.listAtIndex recordData) indexesRaw
                        checkInt (Int i) = i
                        checkInt _ = error "Arguments to index record must be integers"
                
                (String stringData: indexes ) -> String filteredList
                    where
                        indexesRaw = map checkInt indexes
                        --filteredList = map (eval'.(stringData !!)) indexesRaw
                        filteredList = map (listAtIndex stringData) indexesRaw
                        checkInt (Int i) = i
                        checkInt _ = error "Arguments to index list must be integers"
                        
                
                        {-numberedElems = zip [1..] recordData :: [(Int, Expr)]
                        filtered = filter ((`elem` indexesRaw).fst) numberedElems :: [(Int, Expr)]
                        filteredList = map snd filtered :: [Expr]-}


                
            IsEmpty -> case head args' of
                (String a) -> Boolean $ null a
                _ -> error "'isEmpty' operates on a string"
                
            NotEmpty -> case head args' of
                (String a) -> Boolean $ (not.null) a
                _ -> error "'notEmpty' operates on a string"

            Contains -> case args' of
                [String a, String b] -> Boolean $ b `isSubList` a
                _ -> error "Arguments to 'contains' must be two strings."

            Plus -> case args' of
                [String a, String b] -> String (a ++ b)
                [Record a, Record b] -> Record (a ++ b)
                _ -> error "Arguments to '+' must either be two strings or two records"

            Split -> case args' of
                [String a, Int i] -> if (i <= length a) then splitRecord else error "Splitat: index outside of range"
                    where
                        splitRecord = let (s1, s2) = splitAt i a in Record [String s1, String s2]
                _ -> error "'split' argument error"

            Not -> case args' of
                [Boolean exp1] -> Boolean $ not exp1

            Length -> case args' of
                [String a] -> Int $ length a
                _ -> error "'length' only operates on a String"

        (FuncDef setParams argParams body) -> eval newEnv body
            where
                newEnv = let (setEnv, argsEnv) = (zip setParams inputSets, zip argParams args) in setEnv ++ argsEnv ++ env

    (Var name) -> case findVar env name of
        (Just value) -> eval' value
        Nothing -> error $ "Variable " ++ name ++ " not found."


    (Let _ _ expr) -> expr

    (If cond e1 e2) -> eval' $ 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
    (Set exprs) -> Set $ map eval' exprs
    _ -> expr

listAtIndex :: [a] -> Int -> a
listAtIndex recordData i | i > length recordData = error $ "Index " ++ show i ++ " too large."
    | otherwise = recordData !! (i - 1)

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