module CSVQLEval where
import CSVQLTokens
import CSVQLGrammar
import CSVQLTypes

type VariableEnvironment = [(String, E)]
type State = (VariableEnvironment, E)
type BuiltIn = State -> IO State

-- evaluate a CSVQL expression
evalExpr :: [(String, BuiltIn)] -> BuiltInTypeMap -> State -> IO State

-- return base types
evalExpr _ _ (vars, Null) = return (vars, Null)
evalExpr _ _ (vars, String x) = return (vars, String x)
evalExpr _ _ (vars, Int x) = return (vars, Int x)
evalExpr _ _ (vars, Bool x) = return (vars, Bool x)

--evaluate compound types
evalExpr funcs fMap (vars, Table arity rows) = do
    (vars', arityEvaluated) <- evalExpr funcs fMap (vars, arity)
    (vars'', rowsEvaluated) <- evalExpr funcs fMap (vars', rows)
    return (vars'', Table arityEvaluated rowsEvaluated)
evalExpr funcs fMap (vars, Row x) = do
    (vars', evaluated) <- evalExpr funcs fMap (vars, x)
    return (vars', Row evaluated)
evalExpr funcs fMap (vars, List x) = do
    (vars', evaluated) <- evalExpr funcs fMap (vars, x)
    return (vars', List evaluated)
evalExpr funcs fMap (vars, ListBody exp1 exp2) = do
    (vars', eval1) <- evalExpr funcs fMap (vars, exp1)
    (vars'', eval2) <- evalExpr funcs fMap (vars', exp2)
    return (vars'', ListBody eval1 eval2)

-- return value assigned to variable or just expression of type Var if not found
evalExpr funcs fMap (vars, Var x) = case varLookup vars x of
    Just exp -> return (vars, exp)
    Nothing -> return (vars, Var x)

-- handle semicolons (subsequent expressions)
evalExpr funcs fMap (vars, Semi exp1 exp2) = do
    -- only log state changes from first expression, return doesn't matter
    (newGamma, _) <- evalExpr funcs fMap (vars, exp1)
    evalExpr funcs fMap (newGamma, exp2)

-- assign a variable and add it to the environment (or overwrite it if it already exists)
evalExpr funcs fMap (vars, Assign varName expr) = do
    (newVars, evaluated) <- evalExpr funcs fMap (vars, expr)
    assignExpr varName (newVars, evaluated)

-- call a function
evalExpr funcs fMap (vars, Func funcName arguments) = do
    (vars' , args) <- evalExpr funcs fMap (vars, arguments)
    case funcLookup funcs funcName of
        Just func -> func (vars', args)
        Nothing -> error $ "function " ++ funcName ++ " not found"

-- evaluates not function
evalExpr funcs fMap (vars, Not expr) = do
    (vars', evaluatedExpr) <- evalExpr funcs fMap (vars, expr)
    return (vars', CSVQLEval.not evaluatedExpr)

-- evaluates indexing
evalExpr funcs fMap (vars, Index expr1 expr2) = do
    (vars', expr1') <- evalExpr funcs fMap (vars, expr1)
    (vars'', expr2') <- evalExpr funcs fMap (vars', expr2)
    return (vars'', CSVQLEval.index expr1' expr2')

-- evaluates equality
evalExpr funcs fMap (vars, Equals expr1 expr2) = do
    (_, expr1') <- evalExpr funcs fMap (vars, expr1)
    (_, expr2') <- evalExpr funcs fMap (vars, expr2)
    return (vars, equator expr1' expr2')

evalExpr funcs fMap (vars, LessThan expr1 expr2) = do
    (_, expr1') <- evalExpr funcs fMap (vars, expr1)
    (_, expr2') <- evalExpr funcs fMap (vars, expr2)
    return (vars, lessThan expr1' expr2')

evalExpr funcs fMap (vars, GreaterThan expr1 expr2) = do
    (_, expr1') <- evalExpr funcs fMap (vars, expr1)
    (_, expr2') <- evalExpr funcs fMap (vars, expr2)
    return (vars, greaterThan expr1' expr2')

-- evaluates or
evalExpr funcs fMap (vars, Or expr1 expr2) = do
    (_, expr1') <- evalExpr funcs fMap (vars, expr1)
    (_, expr2') <- evalExpr funcs fMap (vars, expr2)
    return (vars, or' expr1' expr2')
        where or' :: E -> E -> E
              or' (Bool True) _ = Bool True
              or' _ (Bool True) = Bool True
              or' _ _ = Bool False

-- evaluates and
evalExpr funcs fMap (vars, And expr1 expr2) = do
    (_, expr1') <- evalExpr funcs fMap (vars, expr1)
    (_, expr2') <- evalExpr funcs fMap (vars, expr2)
    return (vars, and' expr1' expr2')
        where and' :: E -> E -> E
              and' (Bool True) (Bool True) = Bool True
              and' _ _ = Bool False


-- addition for quick combination of rows
evalExpr funcs fMap (vars, Plus expr1 expr2) = do
    (_, expr1') <- evalExpr funcs fMap (vars, expr1)
    (_, expr2') <- evalExpr funcs fMap (vars, expr2)
    return (vars, addExpr expr1' expr2')

-- for loop
evalExpr funcs fMap (vars, For varName iterable body) = forExpr funcs fMap vars varName iterable body

-- handle subfunctions
evalExpr funcs fMap (vars, Sub parentName childName args) = subExpr funcs fMap vars parentName childName args

evalExpr funcs fMap (vars, If condition result) = do
    (_, cond) <- evalExpr funcs fMap (vars, condition)
    case cond of
        (Bool True) -> evalExpr funcs fMap (vars, result)
        _ -> return (vars, Null)

evalExpr funcs fMap (vars, IfElse condition result1 result2) = do
    (_, cond) <- evalExpr funcs fMap (vars, condition)
    case cond of
        (Bool True) -> evalExpr funcs fMap (vars, result1)
        (Bool False) -> evalExpr funcs fMap (vars, result2)
        _ -> error "boolean not given as condition in if statement"

addExpr :: E -> E -> E
addExpr (Row e1) (Row e2) = appendToList e1 e2
addExpr (Int x) (Int y) = Int (x + y)

subExpr :: [(String, BuiltIn)] -> BuiltInTypeMap -> VariableEnvironment -> String -> String -> E -> IO State
subExpr funcs fMap vars parentName childName args = do
    case varLookup vars parentName of
        Just parent -> case funcLookup funcs childName of
                Just func -> do
                    let pType = getType parent [] fMap
                    case fInputTypeLookup fMap childName of
                        Just fType -> 
                            let contains :: UnTypes -> [UnTypes] -> Bool
                                contains _ [] = False
                                contains y (x:xs) | y == x = True
                                                  | otherwise = contains y xs
                                in
                            if contains pType fType
                                then func (vars, ListBody parent (ListBody (String parentName) args))
                                else error "function not relevant to that type"
                        Nothing -> error "function not in type map"
                Nothing -> error "function doesn't exist"
        Nothing -> error "variable doesn't exist"

-- assign/overwrite a variable
assignExpr :: String -> State -> IO State
assignExpr varName (vars, exp) = do
    case varLookup vars varName of
        Nothing -> return ((varName, exp):vars, Null)
        _ -> do
            let newVars = removeVar vars [] varName
            return ((varName, exp):newVars, Null)

-- extract arguments from iterable and call for loop
forExpr :: [(String, BuiltIn)] -> BuiltInTypeMap -> VariableEnvironment -> String -> String -> E -> IO State
forExpr funcs fMap vars varName iterableName body = do
    case varLookup vars iterableName of 
        Just exp2 -> do
            case exp2 of
                (List x) -> loopOver funcs fMap vars varName x body
                (Table width Null) -> return (vars, Null)
                (Table width rows) -> loopOver funcs fMap vars varName rows body
                (Row x) -> loopOver funcs fMap vars varName x body
        Nothing -> error ("iterable not found in variable " ++ varName)

loopOver :: [(String, BuiltIn)] -> BuiltInTypeMap -> VariableEnvironment -> String -> E -> E -> IO State
loopOver funcs fMap vars varName (ListBody current next) body = do
    -- add variable to environment, evaluate, then remove and call next loop
    (vars', evaluated) <- evalExpr funcs fMap ((varName, current):vars, body)
    let vars'' = removeVar vars' [] varName
    loopOver funcs fMap vars'' varName next body
-- final loop
loopOver funcs fMap vars varName current body = do
    (vars', exp3) <- evalExpr funcs fMap ((varName, current):vars, body)
    let vars'' = removeVar vars' [] varName
    return (vars'', exp3)

-- remove variable from var environment (if it exists)
removeVar :: VariableEnvironment -> VariableEnvironment -> String -> VariableEnvironment
removeVar ((name, exp):old) acc toRemove | name == toRemove = old ++ acc
                                         | otherwise = removeVar old ((name, exp):acc) toRemove
removeVar [] acc toRemove = acc

-- find variable in environment
varLookup :: VariableEnvironment -> String -> Maybe E
varLookup [] _ = Nothing
varLookup ((x, exp):gamma) y | x == y = Just exp
                             | otherwise = varLookup gamma y

-- find function in given list
funcLookup :: [(String, a -> b)] -> String -> Maybe (a -> b)
funcLookup [] _ = Nothing
funcLookup ((x, func):funcs) y | x == y = Just func
                               | otherwise = funcLookup funcs y

--compares two expressions, returns true if they are equal
equator :: E -> E -> E
equator e1 e2 = Bool (e1 == e2)

lessThan :: E -> E -> E
lessThan (Int e1) (Int e2) = Bool (e1 < e2)
lessThan _ _ = error "ERROR: Comparing size of non-int value"

greaterThan :: E -> E -> E
greaterThan (Int e1) (Int e2) = Bool (e1 > e2)
greaterThan _ _ = error "ERROR: Comparing size of non-int value"

--negates an expression of type bool
not :: E -> E
not (Bool True) = Bool False
not (Bool _) = Bool True
not _ = error "error negating input, can only negate bools"

-- Sorts a given list or table with bubble sort, is able to sort via rows
sort :: E -> E
sort a@(ListBody _ _) = sort (List a)
sort a@(List e) = List (sortStep e (lengthList a - 1))
    where sortStep :: E -> Int -> E
          sortStep e lim | lim > 0 = sortStep (sortTill e lim) (lim - 1)
                         | otherwise = e
          sortTill :: E -> Int -> E
          sortTill e 0 = e
          sortTill (ListBody e1 (ListBody e2 e3)) lim = ListBody (maxExpr e1 e2) (sortTill (ListBody (minExpr e1 e2) e3) (lim-1))
          sortTill (ListBody e1 e2) lim = ListBody (maxExpr e1 e2) (sortTill (minExpr e1 e2) (lim-1))
sort (Table a rows) = Table a rows'
    where (List rows') = (sort rows)
sort (Row a) = (List (Row a))
sort e = error "parsed expression is not list or table"

-- uses haskells comparison system to compare expressions and return the min expression, both expressions must be of the same type
-- works with all data types except tables
-- string priority is in the order A->a->B->b->C...z
minExpr :: E -> E -> E
minExpr (String e1) (String e2) = String (max e1 e2)
minExpr (Int e1) (Int e2) = Int (min e1 e2)
minExpr (Bool e1) (Bool e2) = Bool (min e1 e2)
minExpr (Row e1) (Row e2) = Row (minExpr e1 e2)
minExpr (List e1) (List e2) = List (minExpr e1 e2)
minExpr (ListBody e11 e12) (ListBody e21 e22) | fromBool $ equator e11 e21 = ListBody e11 (minExpr e12 e22)
                                              | fromBool $ equator e11 (minExpr e11 e21) = ListBody e11 e12
                                              | otherwise = ListBody e21 e22
                                                where fromBool :: E -> Bool
                                                      fromBool (Bool e) = e
minExpr _ _ = error "ERROR: failure to compare expressions, ensure both are of the same type"

-- takes two expressions and returns the larger one
maxExpr :: E -> E -> E
maxExpr (String e1) (String e2) = String (min e1 e2)
maxExpr (Int e1) (Int e2) = Int (max e1 e2)
maxExpr (Bool e1) (Bool e2) = Bool (max e1 e2)
maxExpr (Row e1) (Row e2) = Row (maxExpr e1 e2)
maxExpr (List e1) (List e2) = List (maxExpr e1 e2)
maxExpr (ListBody e11 e12) (ListBody e21 e22) | fromBool $ equator e11 e21 = ListBody e11 (maxExpr e12 e22)
                                              | fromBool $ equator e11 (maxExpr e11 e21) = ListBody e11 e12
                                              | otherwise = ListBody e21 e22
                                                where fromBool :: E -> Bool
                                                      fromBool (Bool e) = e
maxExpr _ _ = error "ERROR: failure to comapre expressions, ensure both are of the same type"

-- takes a list expression and returns the length as an int
lengthList :: E -> Int
lengthList lBody@(ListBody e1 e2) = lengthList (List lBody)
lengthList (Row e) = lengthList (List e)
lengthList (List e) = lengthList' e
    where lengthList' :: E -> Int
          lengthList' (ListBody e1 e2) = 1 + lengthList' e2
          lengthList' e = 1
lengthList (Table _ Null) = 0
lengthList (Table _ e) = lengthList (List e)

-- takes an iterable structure and an integer in expression form and returns the element at given index
index :: E -> E -> E
index (List e1) (Int e2) = indexList e1 e2
index (Row e1@(ListBody _ _)) (Int e2) = indexList e1 e2
index (Row e1) (Int 0) = e1
index (String e1) (Int e2) = index' e1 e2
    where index' :: String -> Int -> E
          index' [] i = error "index out of bounds"
          index' xs 0 = String [head xs]
          index' (x:xs) i = index' xs (i-1)
index (Table _ Null) (Int _) = error "index out of bounds, table empty"
index (Table _ e1@(ListBody _ _)) (Int e2) = indexList e1 e2
index (Table _ e@(Row _)) (Int 0) = e
index (Table _ (Row _)) (Int _) = error "index out of bounds"
index (Row e1) (Int _) = error "index out of bounds"
index e1 e2 = error ("index error, either index is not integer or non iterable structure inputted")

-- DO NOT USE
-- used in index function to index rows and lists
indexList :: E -> Int -> E
indexList (ListBody e1 e2) 0 = e1
indexList e 0 = e
indexList (ListBody e1 e2) i = indexList e2 (i-1)
indexList e i = error "index out of bounds"

-- takes basic types and turns them into a string
eToString :: E -> E
eToString (String x) = String x
eToString (Int x) = String (show x)
eToString (Bool x) = String (show x)
eToString (List e) = eToString e
eToString (ListBody e1 e2) = ListBody (eToString e1) (eToString e2)
eToString (Row e) = Row (eToString e)
eToString (Table x e) = Table x (eToString e)
eToString e = error $ show e ++ " eToString"

-- checks if the iterable expression is empty
eIsEmpty :: E -> E
eIsEmpty Null = Bool True
eIsEmpty (Table _ Null) = Bool True
eIsEmpty (Table _ _) = Bool False
eIsEmpty (List e) = eIsEmpty e
eIsEmpty (ListBody _ _) = Bool False
eIsEmpty (Row e) = eIsEmpty e
eIsEmpty (String "") = Bool True
eIsEmpty (String _) = Bool False
eIsEmpty (Int _) = Bool False
eIsEmpty (Bool _) = Bool False

-- appends two lists together
appendToList :: E -> E -> E
appendToList (List x) z = appendToList' x z
appendToList (ListBody x y) z = ListBody x (appendToList' y z)
appendToList x y | getVarType x == getVarType y = ListBody x y
                 | otherwise = error "list types do not match"
appendToList' :: E -> E -> E
appendToList' (ListBody x y) z = ListBody x (appendToList' y z)
appendToList' x y | getVarType x == getVarType y = ListBody x y
                  | getVarType x == getVarType (removeList y) = ListBody x (removeList y)
                  | otherwise = error "list types do not match"
                  where removeList :: E -> E
                        removeList (List x) = x
                        removeList x = x

-- checks if expressions match the given type
-- lists return true if it is checked against the type (Iterable (TypeList _))
checkType :: UnTypes -> E -> Bool
checkType (Iterable (TypeList x)) (List a) = checkType x a
checkType x (ListBody a b) = checkType x a && checkType x b
checkType TypeNull Null = True
checkType TypeInt (Int _) = True
checkType TypeString (String _) = True
checkType TypeBool (Bool _) = True
checkType (Iterable TypeRow) (Row _) = True
checkType (Iterable TypeTable) (Table _ _) = True
checkType _ _ = False

-- returns the type of the variable parsed
-- IS UNRELIABLE WITH LISTS, it will return the type of the list with the first element found, use with checkType to ensure uniformality
getVarType :: E -> UnTypes
getVarType (List a) = Iterable (TypeList (getVarType a))
getVarType (ListBody a _) = getVarType a
getVarType (Int _) = TypeInt
getVarType (String _) = TypeString
getVarType (Bool _) = TypeBool
getVarType (Row _) = Iterable TypeRow
getVarType (Table _ _) = Iterable TypeTable
getVarType Null = TypeNull