# LANGUAGE FlexibleInstances #
# LANGUAGE MultiParamTypeClasses #
# LANGUAGE ExistentialQuantification #

module Evaluator where

import Data.List hiding (insert, tail)
import Control.Monad.Trans.State.Lazy
import Control.Monad.Error
import Control.Monad.Trans.Except
import qualified Data.Map as Map
import Data

type LillaEnvironment = Map.Map String LillaVal
type LillaProgram = [LillaVal]
type ThrowsLillaError = Either LillaError
type LillaProgramExecution = StateT LillaEnvironment ThrowsLillaError LillaVal

showLillaEnvironment :: LillaEnvironment -> String
showLillaEnvironment le = join $ formattedEnv where
    formattedEnv = zipWith (\a b -> a ++ b) (format <$> Map.toList le) (repeat "\n") 
    format = (\(var, val) -> (show var) ++ ": " ++ (show val))

data ExecutionContext = 
      Global
    | Function
    deriving (Eq, Show)

run :: LillaProgram -> ThrowsLillaError (LillaVal, LillaEnvironment)
  runs a LillaProgram with empty environment initialised
run lp = execute Global lp (return (Null, Map.empty))

execute :: ExecutionContext -> LillaProgram -> ThrowsLillaError (LillaVal, LillaEnvironment) -> 
           ThrowsLillaError (LillaVal, LillaEnvironment)
  if function gets empty lilla program return input
execute _ [] inp = inp
-- if next expression to evaluate in a Functional context is preceded by a return statement
-- then return expression and ignore all the following expressions
execute Function ((LillaList [AtomicLilla "return", expr]):_) inp = evaluate Function expr inp 
-- if return statement in Functional context is not directly followed by an expression then return Null
execute Function ((LillaList [AtomicLilla "return"]): expr) inp = evaluate Function Null inp 
-- if last expression in a Functional context is not preceded by return statement then return Null
execute Function [] inp = evaluate Function Null inp
-- base case: evaluate program expression by expression recursively
execute context (expr:exprs) inp = execute context exprs (evaluate context expr inp)

evaluate :: ExecutionContext -> LillaVal -> ThrowsLillaError (LillaVal, LillaEnvironment) -> 
            ThrowsLillaError (LillaVal, LillaEnvironment)
-- intermediary function to transfer environments between evaluation ticks
evaluate _ exp (Left err) = throwError err
evaluate context exp (Right (_, env)) = case runStateT ((return exp) >>= (eval context)) env of
    Left err        -> throwError err
    Right result    -> Right result

eval :: ExecutionContext -> LillaVal -> LillaProgramExecution
  evaluates a Lilla Expression
eval _ Null = return Null
eval _ val@(IntegerLilla _) = return val
eval _ val@(StringLilla _) = return val
eval _ val@(BooleanLilla _) = return val
eval _ val@(AtomicLilla var) = do
    env <- get
    case Map.lookup var env of
        Nothing  -> throwError $ RuntimeLillaError $ "NameError: " ++ (show var) ++ " is not defined."
        Just x   -> return x
eval context (LillaList [AtomicLilla var, AtomicLilla "=", val]) = do
    x <- (eval context) val
    modify (Map.insert var x)
    return val
eval context (LillaList [AtomicLilla "return", expr]) = case context of
    Function  -> (eval context) expr
    Global    -> throwError $ RuntimeLillaError "Cannot return in Global context." 

eval context (LillaList [AtomicLilla "if", pred, LillaList conseqs, 
              AtomicLilla "else", LillaList alts]) = do
        result <- (eval context) pred
        env <- get
        case result of 
            BooleanLilla x -> case execute context (if x then conseqs else alts) (return (Null, env)) of
                Left err  -> throwError $ err
                Right (val, env) -> do
                    put env
                    return val
            x@_              -> throwError $ RuntimeLillaError $ "TypeError: " ++ (show x) ++ " expecting Bool."

eval context (LillaList [AtomicLilla "primitive", AtomicLilla func, args@(LillaList _)]) = do
    args' <- (eval context) args
    case evaluatePrimitiveFunc func args' of
        Left err  -> throwError err
        Right val -> return val

eval context (LillaList [AtomicLilla "defined", AtomicLilla func, args@(LillaList _)]) = do
    env   <- get
    args' <- (eval context) args
    case evaluateUserDefinedFunc func env args' of
        Left err  -> throwError $ err
        Right val -> return val

eval context func@(LillaFunc name _ _) = do 
    modify (Map.insert name func)
    return func

eval context (LillaList xs) = do
    env <- get
    case mapM (\x -> runStateT (return x >>= (eval context)) env) xs of
        Left err -> throwError err
        Right ls -> return $ LillaList $ fst <$> ls

eval context val = throwError $ RuntimeLillaError $ "Bad special form (1). Context:" ++ show context ++ 
                                                    " Val: " ++  show val

evaluateUserDefinedFunc ::  String -> LillaEnvironment -> LillaVal -> ThrowsLillaError LillaVal
evaluateUserDefinedFunc func env (LillaList args) = case Map.lookup func env of
    Nothing -> throwError $ RuntimeLillaError $ "NameError: " ++ func ++ " is not defined."
    Just func'@(LillaFunc _ args' body) -> case (length args) == (length args') of
        True -> case execute Function body (return (Null,  Map.union (Map.fromList $ zip args' args) env)) of
            Right (val, _) -> return val
            Left err       -> throwError err
        False -> throwError $ RuntimeLillaError $ "TypeError: " ++ func ++ " is expecting " ++ (show $ length args') ++ " arguments." 
    Just _                            -> throwError $ RuntimeLillaError $ "TypeError: "  ++ func ++ " is not callable."
    Nothing                           -> throwError $ RuntimeLillaError $ "NameError: " ++ func ++ " is not defined."
evaluateUserDefinedFunc _ _ _ = throwError $ RuntimeLillaError "Bad special form (2)." 

evaluatePrimitiveFunc :: String -> LillaVal -> ThrowsLillaError LillaVal
evaluatePrimitiveFunc func (LillaList args) = case lookup func primitives of
    Nothing    -> throwError $ RuntimeLillaError $ "NameError: " ++ func ++ " is not defined."
    Just func' -> case func' args of
        Left  err -> throwError err
        Right val -> return val
evaluatePrimitiveFunc _ _ = throwError $ RuntimeLillaError "Bad special form (3)." 

primitives :: [(String, [LillaVal] -> ThrowsLillaError LillaVal)]
primitives = [
        ("plus", numericBinop (+)), 
        ("minus", numericBinop (-)), 
        ("mul", numericBinop (*)), 
        ("div", numericBinop div),
        ("mod", numericBinop mod), 
        ("quotient", numericBinop quot), 
        ("remainder", numericBinop rem),
        ("eqv", numBoolBinop (==)),
        ("lt", numBoolBinop (<)),
        ("gt", numBoolBinop (>)),
        ("ne", numBoolBinop (/=)),
        ("gte", numBoolBinop (>=)),
        ("lte", numBoolBinop (<=)),
        ("_eqv", strBoolBinop (==)),
        ("_lt", strBoolBinop (<)),
        ("_gt", strBoolBinop (>)),
        ("_ne", strBoolBinop (/=)),
        ("_gte", strBoolBinop (>=)),
        ("_lte", strBoolBinop (<=)),
        ("and", boolBoolBinop (&&)),
        ("or", boolBoolBinop (||)),
        ("head", head'),
        ("tail", tail'),
        ("cons", cons),
        ("concat", conc),
        ("replicate", repl),
        ("length", length'),
        ("toString", toString),
        ("toNumber", toNumber),
        ("take", take'),
        ("generateList", generateList),
        ("sum", sum'),
        ("max", max'),
        ("min", min'),
        ("split", split),
        ("not", not')
    ]

not' :: [LillaVal] -> ThrowsLillaError LillaVal
not' [BooleanLilla x] = return . BooleanLilla . not $ x
not' [_] = throwError . RuntimeLillaError $ "ValueError: function `not` takes one Bool argument." 
not' _ = throwError . RuntimeLillaError $ "ValueError: function `not` takes exactly one Bool argument." 

split :: [LillaVal] -> ThrowsLillaError LillaVal
split [StringLilla val, StringLilla splittingVal] = if length splittingVal > 1
    then throwError $ RuntimeLillaError "ValueError: split takes splitting string of length 1 character." 
    else return . LillaList $ (\x -> StringLilla x) <$> (split' val splittingVal) where
        split' [] _ = []
        split' word@(x:xs) s = if s == "" then (\c -> [c]) <$>  word else if [x] == s 
            then []
            else [wordUntilSplit] ++ (split' (snd $ splitAt (length wordUntilSplit) word) s) where
                wordUntilSplit = takeWhile (\x' -> x' /= (s !! 0)) word
split _ = throwError . RuntimeLillaError $ "TypeError: split takes exectly two String arguments."

min' :: [LillaVal] -> ThrowsLillaError LillaVal
min' [LillaList xs] = if boolAccumulator xs isNumeric
    then return . IntegerLilla $ minimum $ (\(IntegerLilla x) -> x) <$> xs
    else if boolAccumulator xs isBoolean
        then return . BooleanLilla $ minimum $ (\(BooleanLilla x) -> x) <$> xs
        else if boolAccumulator xs isString 
            then return . StringLilla $ minimum $ (\(StringLilla x) -> x) <$> xs
            else if boolAccumulator xs isCharacter
                then return . CharacterLilla $ minimum $ (\(CharacterLilla x) -> x) <$> xs
                else throwError . RuntimeLillaError $ "ValueError: no msg..."
min' _ = throwError . RuntimeLillaError $ "TypeError: min takes exactly one list argument"

max' :: [LillaVal] -> ThrowsLillaError LillaVal
max' [LillaList xs] = if boolAccumulator xs isNumeric
    then return . IntegerLilla $ maximum $ (\(IntegerLilla x) -> x) <$> xs
    else if boolAccumulator xs isBoolean
        then return . BooleanLilla $ maximum $ (\(BooleanLilla x) -> x) <$> xs
        else if boolAccumulator xs isString 
            then return . StringLilla $ maximum $ (\(StringLilla x) -> x) <$> xs
            else if boolAccumulator xs isCharacter
                then return . CharacterLilla $ maximum $ (\(CharacterLilla x) -> x) <$> xs
                else throwError . RuntimeLillaError $ "ValueError: no msg..."
max' _ = throwError . RuntimeLillaError $ "TypeError: min takes exactly one list argument"
    
sum' :: [LillaVal] -> ThrowsLillaError LillaVal
sum' [LillaList xs] = if allNumeric
    then return . IntegerLilla . sum $ (\(IntegerLilla x) -> x) <$> xs
    else throwError $ RuntimeLillaError "TypeError: expecting a list of Numbers."  where
        allNumeric = foldr (\x acc -> (isNumeric x) && acc) True xs
        isNumeric (IntegerLilla _) = True
        isNumeric _                = False 
sum' [_] = throwError $ RuntimeLillaError "TypeError: expecting a list of Numbers."
sum' _ = throwError $ RuntimeLillaError "TypeError: sum takes exactly one list argument." 

generateList :: [LillaVal] -> ThrowsLillaError LillaVal
generateList [IntegerLilla min, IntegerLilla max] = return . LillaList $ (\x -> IntegerLilla x) <$> [min .. max]
generateList [IntegerLilla min, _] = throwError $ RuntimeLillaError "TypeError: expecting a Number as 2nd argument."
generateList [_, IntegerLilla max] = throwError $ RuntimeLillaError "TypeError: expecting a Number as 1st argument."
generateList [_, _] = throwError $ RuntimeLillaError "TypeError: expecting Numbers as arguments"
generateList _ = throwError $ RuntimeLillaError "TypeError: `generateList` takes exactly 2 arguments."

take' :: [LillaVal] -> ThrowsLillaError LillaVal
take' [IntegerLilla n, LillaList xs] = return . LillaList $ take (fromIntegral n) xs
take' [IntegerLilla n, _] = throwError $ RuntimeLillaError "TypeError: expecting a List as 2nd argument."
take' [_, LillaList xs]   = throwError $ RuntimeLillaError "TypeError: expecting a Number as 1st argument."
take' [_, _] = throwError $ RuntimeLillaError "TypeError: expecting Number and List arguments."
take' _ = throwError $ RuntimeLillaError "TypeError: `take` takes exactly 2 arguments."

toNumber :: [LillaVal] -> ThrowsLillaError LillaVal
toNumber [StringLilla val] = if numericString
    then return . IntegerLilla . (\x -> read x :: Integer) $ val
    else throwError $ RuntimeLillaError "ValueError: toNumber takes only numeric strings" where 
        numericString = foldr (\c acc -> (c `elem` ['0' .. '9']) && acc) True val
toNumber [_] = throwError $ RuntimeLillaError "TypeError: toNumber takes argument of type string."
toNumber (x:xs) = throwError $ RuntimeLillaError "TypeError: toString takes exactly 1 argument."

toString :: [LillaVal] -> ThrowsLillaError LillaVal
toString [x] = return $ StringLilla . show $ x
toString (x:xs) = throwError $ RuntimeLillaError "TypeError: toString takes exactly 1 argument."

length' :: [LillaVal] -> ThrowsLillaError LillaVal
length' [LillaList xs] = return $ IntegerLilla . fromIntegral . length $ xs
length' val = throwError $ RuntimeLillaError $ "TypeError: length takes lists. Got " ++ (show val) ++ " instead."

head' :: [LillaVal] -> ThrowsLillaError LillaVal
head' [LillaList (x:_)] = return x
head' [LillaList _] = throwError $ RuntimeLillaError "Error: no head of empty list."
head' (x:xs) = throwError $ RuntimeLillaError "TypeError: head takes exactly 1 argument."
head' _ = throwError $ RuntimeLillaError "Bad special form (4)."

tail' :: [LillaVal] -> ThrowsLillaError LillaVal
tail' [LillaList (_:xs)] = return $ LillaList xs
tail' [LillaList _] = throwError $ RuntimeLillaError "Error: no tail of empty list."
tail' (x:xs) = throwError $ RuntimeLillaError "TypeError: head takes exactly 1 argument."
tail' _ = throwError $ RuntimeLillaError "Bad special form (5)."

cons :: [LillaVal] -> ThrowsLillaError LillaVal
cons [x, LillaList []] = return $ LillaList [x]
cons [x, LillaList xs] = return $ LillaList (x:xs)
cons [_, _] = throwError $ RuntimeLillaError "TypeError: expecting List as 2nd argument."
cons _ = throwError $ RuntimeLillaError "TypeError: cons takes exactly 2 arguments."

conc :: [LillaVal] -> ThrowsLillaError LillaVal
conc [LillaList xs, LillaList xs'] = return $ LillaList $ xs ++ xs'
conc [_, _] = throwError $ RuntimeLillaError "TypeError: concat takes exactly 2 arguments of type List."
conc _ =throwError $ RuntimeLillaError "TypeError: concat takes exactly 2 arguments."

repl :: [LillaVal] -> ThrowsLillaError LillaVal
repl [IntegerLilla n, LillaList xs] = return $ LillaList $ concat $ replicate (fromIntegral n) xs
repl [_, LillaList _] = throwError $ RuntimeLillaError "TypeError: expecting Integer as 1st argument."
repl [IntegerLilla _, _] = throwError $ RuntimeLillaError "TypeError: expecting List as 2nd argument."
repl [_, _] = throwError $ RuntimeLillaError "TypeError: expecting arguments of types Integer and List."
repl _ = throwError $ RuntimeLillaError "TypeError: repl takes exactly 2 arguments."

boolBinop :: (LillaVal -> ThrowsLillaError a) -> (a -> a -> Bool) -> [LillaVal] -> ThrowsLillaError LillaVal
boolBinop unpacker op args 
    | length args /= 2 = 
        throwError $ RuntimeLillaError $ "TypeError: function is expecting 2 args, currently has:"  ++ (show $ length args) ++ "."
    | otherwise        = do
        left <- unpacker $ args !! 0
        right <- unpacker $ args !! 1
        return . BooleanLilla $ left `op` right

numBoolBinop = boolBinop unpackNum
strBoolBinop = boolBinop unpackStr
boolBoolBinop = boolBinop unpackBool

unpackStr :: LillaVal -> ThrowsLillaError String
unpackStr (StringLilla s) = return s
unpackStr notString = throwError $ RuntimeLillaError "Typerror: expecting String." 

unpackBool :: LillaVal -> ThrowsLillaError Bool
unpackBool (BooleanLilla b) = return b
unpackBool notBool = throwError $ RuntimeLillaError "Typerror: expecting Bool."

numericBinop :: (Integer -> Integer -> Integer) -> [LillaVal] -> ThrowsLillaError LillaVal
numericBinop op [_] = throwError $ RuntimeLillaError "TypeError: expecting 2 arguments, got 1 instead."
numericBinop op params = mapM unpackNum params >>= return . IntegerLilla . foldl1 op

unpackNum :: LillaVal -> ThrowsLillaError Integer
unpackNum (IntegerLilla n) = return n
unpackNum _ = throwError $ RuntimeLillaError "Typerror: expecting Integer."

isNumeric :: LillaVal -> Bool
isNumeric (IntegerLilla _) = True
isNumeric _ = False

isBoolean :: LillaVal -> Bool
isBoolean (BooleanLilla _) = True
isBoolean _ = False

isString :: LillaVal -> Bool
isString (StringLilla _) = True
isString _ = False

isCharacter :: LillaVal -> Bool
isCharacter (CharacterLilla _) = True
isCharacter _ = False

boolAccumulator :: [LillaVal] -> (LillaVal -> Bool) -> Bool
boolAccumulator xs' f = foldr (\x' acc' -> x' && acc') True $ f <$> xs'

checkIfHomogenous :: [LillaVal] -> Bool
checkIfHomogenous xs = foldr (\x acc -> x || acc) False typeHomogenities where
    typeHomogenities = [
        boolAccumulator xs isNumeric, 
        boolAccumulator xs isBoolean, 
        boolAccumulator xs isString, 
        boolAccumulator xs isCharacter]

 if next expression to evaluate in a Functional context is preceded by a return statement
 then return expression and ignore all the following expressions
 if return statement in Functional context is not directly followed by an expression then return Null
 if last expression in a Functional context is not preceded by return statement then return Null
 base case: evaluate program expression by expression recursively
 intermediary function to transfer environments between evaluation ticks
# LANGUAGE FlexibleInstances #
# LANGUAGE MultiParamTypeClasses #
# LANGUAGE ExistentialQuantification #

module Evaluator where

import Data.List hiding (insert, tail)
import Control.Monad.Trans.State.Lazy
import Control.Monad.Error
import Control.Monad.Trans.Except
import qualified Data.Map as Map
import Data

type LillaEnvironment = Map.Map String LillaVal
type LillaProgram = [LillaVal]
type ThrowsLillaError = Either LillaError
type LillaProgramExecution = StateT LillaEnvironment ThrowsLillaError LillaVal

showLillaEnvironment :: LillaEnvironment -> String
showLillaEnvironment le = join $ formattedEnv where
    formattedEnv = zipWith (\a b -> a ++ b) (format <$> Map.toList le) (repeat "\n") 
    format = (\(var, val) -> (show var) ++ ": " ++ (show val))

data ExecutionContext = 
      Global
    | Function
    deriving (Eq, Show)

run :: LillaProgram -> ThrowsLillaError (LillaVal, LillaEnvironment)
  runs a LillaProgram with empty environment initialised
run lp = execute Global lp (return (Null, Map.empty))

execute :: ExecutionContext -> LillaProgram -> ThrowsLillaError (LillaVal, LillaEnvironment) -> 
           ThrowsLillaError (LillaVal, LillaEnvironment)
  if function gets empty lilla program return input
execute _ [] inp = inp
execute Function ((LillaList [AtomicLilla "return", expr]):_) inp = evaluate Function expr inp 
execute Function ((LillaList [AtomicLilla "return"]): expr) inp = evaluate Function Null inp 
execute Function [] inp = evaluate Function Null inp
execute context (expr:exprs) inp = execute context exprs (evaluate context expr inp)

evaluate :: ExecutionContext -> LillaVal -> ThrowsLillaError (LillaVal, LillaEnvironment) -> 
            ThrowsLillaError (LillaVal, LillaEnvironment)
evaluate _ exp (Left err) = throwError err
evaluate context exp (Right (_, env)) = case runStateT ((return exp) >>= (eval context)) env of
    Left err        -> throwError err
    Right result    -> Right result

eval :: ExecutionContext -> LillaVal -> LillaProgramExecution
  evaluates a Lilla Expression
eval _ Null = return Null
eval _ val@(IntegerLilla _) = return val
eval _ val@(StringLilla _) = return val
eval _ val@(BooleanLilla _) = return val
eval _ val@(AtomicLilla var) = do
    env <- get
    case Map.lookup var env of
        Nothing  -> throwError $ RuntimeLillaError $ "NameError: " ++ (show var) ++ " is not defined."
        Just x   -> return x
eval context (LillaList [AtomicLilla var, AtomicLilla "=", val]) = do
    x <- (eval context) val
    modify (Map.insert var x)
    return val
eval context (LillaList [AtomicLilla "return", expr]) = case context of
    Function  -> (eval context) expr
    Global    -> throwError $ RuntimeLillaError "Cannot return in Global context." 

eval context (LillaList [AtomicLilla "if", pred, LillaList conseqs, 
              AtomicLilla "else", LillaList alts]) = do
        result <- (eval context) pred
        env <- get
        case result of 
            BooleanLilla x -> case execute context (if x then conseqs else alts) (return (Null, env)) of
                Left err  -> throwError $ err
                Right (val, env) -> do
                    put env
                    return val
            x@_              -> throwError $ RuntimeLillaError $ "TypeError: " ++ (show x) ++ " expecting Bool."

eval context (LillaList [AtomicLilla "primitive", AtomicLilla func, args@(LillaList _)]) = do
    args' <- (eval context) args
    case evaluatePrimitiveFunc func args' of
        Left err  -> throwError err
        Right val -> return val

eval context (LillaList [AtomicLilla "defined", AtomicLilla func, args@(LillaList _)]) = do
    env   <- get
    args' <- (eval context) args
    case evaluateUserDefinedFunc func env args' of
        Left err  -> throwError $ err
        Right val -> return val

eval context func@(LillaFunc name _ _) = do 
    modify (Map.insert name func)
    return func

eval context (LillaList xs) = do
    env <- get
    case mapM (\x -> runStateT (return x >>= (eval context)) env) xs of
        Left err -> throwError err
        Right ls -> return $ LillaList $ fst <$> ls

eval context val = throwError $ RuntimeLillaError $ "Bad special form (1). Context:" ++ show context ++ 
                                                    " Val: " ++  show val

evaluateUserDefinedFunc ::  String -> LillaEnvironment -> LillaVal -> ThrowsLillaError LillaVal
evaluateUserDefinedFunc func env (LillaList args) = case Map.lookup func env of
    Nothing -> throwError $ RuntimeLillaError $ "NameError: " ++ func ++ " is not defined."
    Just func'@(LillaFunc _ args' body) -> case (length args) == (length args') of
        True -> case execute Function body (return (Null,  Map.union (Map.fromList $ zip args' args) env)) of
            Right (val, _) -> return val
            Left err       -> throwError err
        False -> throwError $ RuntimeLillaError $ "TypeError: " ++ func ++ " is expecting " ++ (show $ length args') ++ " arguments." 
    Just _                            -> throwError $ RuntimeLillaError $ "TypeError: "  ++ func ++ " is not callable."
    Nothing                           -> throwError $ RuntimeLillaError $ "NameError: " ++ func ++ " is not defined."
evaluateUserDefinedFunc _ _ _ = throwError $ RuntimeLillaError "Bad special form (2)." 

evaluatePrimitiveFunc :: String -> LillaVal -> ThrowsLillaError LillaVal
evaluatePrimitiveFunc func (LillaList args) = case lookup func primitives of
    Nothing    -> throwError $ RuntimeLillaError $ "NameError: " ++ func ++ " is not defined."
    Just func' -> case func' args of
        Left  err -> throwError err
        Right val -> return val
evaluatePrimitiveFunc _ _ = throwError $ RuntimeLillaError "Bad special form (3)." 

primitives :: [(String, [LillaVal] -> ThrowsLillaError LillaVal)]
primitives = [
        ("plus", numericBinop (+)), 
        ("minus", numericBinop (-)), 
        ("mul", numericBinop (*)), 
        ("div", numericBinop div),
        ("mod", numericBinop mod), 
        ("quotient", numericBinop quot), 
        ("remainder", numericBinop rem),
        ("eqv", numBoolBinop (==)),
        ("lt", numBoolBinop (<)),
        ("gt", numBoolBinop (>)),
        ("ne", numBoolBinop (/=)),
        ("gte", numBoolBinop (>=)),
        ("lte", numBoolBinop (<=)),
        ("_eqv", strBoolBinop (==)),
        ("_lt", strBoolBinop (<)),
        ("_gt", strBoolBinop (>)),
        ("_ne", strBoolBinop (/=)),
        ("_gte", strBoolBinop (>=)),
        ("_lte", strBoolBinop (<=)),
        ("and", boolBoolBinop (&&)),
        ("or", boolBoolBinop (||)),
        ("head", head'),
        ("tail", tail'),
        ("cons", cons),
        ("concat", conc),
        ("replicate", repl),
        ("length", length'),
        ("toString", toString),
        ("toNumber", toNumber),
        ("take", take'),
        ("generateList", generateList),
        ("sum", sum'),
        ("max", max'),
        ("min", min'),
        ("split", split),
        ("not", not')
    ]

not' :: [LillaVal] -> ThrowsLillaError LillaVal
not' [BooleanLilla x] = return . BooleanLilla . not $ x
not' [_] = throwError . RuntimeLillaError $ "ValueError: function `not` takes one Bool argument." 
not' _ = throwError . RuntimeLillaError $ "ValueError: function `not` takes exactly one Bool argument." 

split :: [LillaVal] -> ThrowsLillaError LillaVal
split [StringLilla val, StringLilla splittingVal] = if length splittingVal > 1
    then throwError $ RuntimeLillaError "ValueError: split takes splitting string of length 1 character." 
    else return . LillaList $ (\x -> StringLilla x) <$> (split' val splittingVal) where
        split' [] _ = []
        split' word@(x:xs) s = if s == "" then (\c -> [c]) <$>  word else if [x] == s 
            then []
            else [wordUntilSplit] ++ (split' (snd $ splitAt (length wordUntilSplit) word) s) where
                wordUntilSplit = takeWhile (\x' -> x' /= (s !! 0)) word
split _ = throwError . RuntimeLillaError $ "TypeError: split takes exectly two String arguments."

min' :: [LillaVal] -> ThrowsLillaError LillaVal
min' [LillaList xs] = if boolAccumulator xs isNumeric
    then return . IntegerLilla $ minimum $ (\(IntegerLilla x) -> x) <$> xs
    else if boolAccumulator xs isBoolean
        then return . BooleanLilla $ minimum $ (\(BooleanLilla x) -> x) <$> xs
        else if boolAccumulator xs isString 
            then return . StringLilla $ minimum $ (\(StringLilla x) -> x) <$> xs
            else if boolAccumulator xs isCharacter
                then return . CharacterLilla $ minimum $ (\(CharacterLilla x) -> x) <$> xs
                else throwError . RuntimeLillaError $ "ValueError: no msg..."
min' _ = throwError . RuntimeLillaError $ "TypeError: min takes exactly one list argument"

max' :: [LillaVal] -> ThrowsLillaError LillaVal
max' [LillaList xs] = if boolAccumulator xs isNumeric
    then return . IntegerLilla $ maximum $ (\(IntegerLilla x) -> x) <$> xs
    else if boolAccumulator xs isBoolean
        then return . BooleanLilla $ maximum $ (\(BooleanLilla x) -> x) <$> xs
        else if boolAccumulator xs isString 
            then return . StringLilla $ maximum $ (\(StringLilla x) -> x) <$> xs
            else if boolAccumulator xs isCharacter
                then return . CharacterLilla $ maximum $ (\(CharacterLilla x) -> x) <$> xs
                else throwError . RuntimeLillaError $ "ValueError: no msg..."
max' _ = throwError . RuntimeLillaError $ "TypeError: min takes exactly one list argument"
    
sum' :: [LillaVal] -> ThrowsLillaError LillaVal
sum' [LillaList xs] = if allNumeric
    then return . IntegerLilla . sum $ (\(IntegerLilla x) -> x) <$> xs
    else throwError $ RuntimeLillaError "TypeError: expecting a list of Numbers."  where
        allNumeric = foldr (\x acc -> (isNumeric x) && acc) True xs
        isNumeric (IntegerLilla _) = True
        isNumeric _                = False 
sum' [_] = throwError $ RuntimeLillaError "TypeError: expecting a list of Numbers."
sum' _ = throwError $ RuntimeLillaError "TypeError: sum takes exactly one list argument." 

generateList :: [LillaVal] -> ThrowsLillaError LillaVal
generateList [IntegerLilla min, IntegerLilla max] = return . LillaList $ (\x -> IntegerLilla x) <$> [min .. max]
generateList [IntegerLilla min, _] = throwError $ RuntimeLillaError "TypeError: expecting a Number as 2nd argument."
generateList [_, IntegerLilla max] = throwError $ RuntimeLillaError "TypeError: expecting a Number as 1st argument."
generateList [_, _] = throwError $ RuntimeLillaError "TypeError: expecting Numbers as arguments"
generateList _ = throwError $ RuntimeLillaError "TypeError: `generateList` takes exactly 2 arguments."

take' :: [LillaVal] -> ThrowsLillaError LillaVal
take' [IntegerLilla n, LillaList xs] = return . LillaList $ take (fromIntegral n) xs
take' [IntegerLilla n, _] = throwError $ RuntimeLillaError "TypeError: expecting a List as 2nd argument."
take' [_, LillaList xs]   = throwError $ RuntimeLillaError "TypeError: expecting a Number as 1st argument."
take' [_, _] = throwError $ RuntimeLillaError "TypeError: expecting Number and List arguments."
take' _ = throwError $ RuntimeLillaError "TypeError: `take` takes exactly 2 arguments."

toNumber :: [LillaVal] -> ThrowsLillaError LillaVal
toNumber [StringLilla val] = if numericString
    then return . IntegerLilla . (\x -> read x :: Integer) $ val
    else throwError $ RuntimeLillaError "ValueError: toNumber takes only numeric strings" where 
        numericString = foldr (\c acc -> (c `elem` ['0' .. '9']) && acc) True val
toNumber [_] = throwError $ RuntimeLillaError "TypeError: toNumber takes argument of type string."
toNumber (x:xs) = throwError $ RuntimeLillaError "TypeError: toString takes exactly 1 argument."

toString :: [LillaVal] -> ThrowsLillaError LillaVal
toString [x] = return $ StringLilla . show $ x
toString (x:xs) = throwError $ RuntimeLillaError "TypeError: toString takes exactly 1 argument."

length' :: [LillaVal] -> ThrowsLillaError LillaVal
length' [LillaList xs] = return $ IntegerLilla . fromIntegral . length $ xs
length' val = throwError $ RuntimeLillaError $ "TypeError: length takes lists. Got " ++ (show val) ++ " instead."

head' :: [LillaVal] -> ThrowsLillaError LillaVal
head' [LillaList (x:_)] = return x
head' [LillaList _] = throwError $ RuntimeLillaError "Error: no head of empty list."
head' (x:xs) = throwError $ RuntimeLillaError "TypeError: head takes exactly 1 argument."
head' _ = throwError $ RuntimeLillaError "Bad special form (4)."

tail' :: [LillaVal] -> ThrowsLillaError LillaVal
tail' [LillaList (_:xs)] = return $ LillaList xs
tail' [LillaList _] = throwError $ RuntimeLillaError "Error: no tail of empty list."
tail' (x:xs) = throwError $ RuntimeLillaError "TypeError: head takes exactly 1 argument."
tail' _ = throwError $ RuntimeLillaError "Bad special form (5)."

cons :: [LillaVal] -> ThrowsLillaError LillaVal
cons [x, LillaList []] = return $ LillaList [x]
cons [x, LillaList xs] = return $ LillaList (x:xs)
cons [_, _] = throwError $ RuntimeLillaError "TypeError: expecting List as 2nd argument."
cons _ = throwError $ RuntimeLillaError "TypeError: cons takes exactly 2 arguments."

conc :: [LillaVal] -> ThrowsLillaError LillaVal
conc [LillaList xs, LillaList xs'] = return $ LillaList $ xs ++ xs'
conc [_, _] = throwError $ RuntimeLillaError "TypeError: concat takes exactly 2 arguments of type List."
conc _ =throwError $ RuntimeLillaError "TypeError: concat takes exactly 2 arguments."

repl :: [LillaVal] -> ThrowsLillaError LillaVal
repl [IntegerLilla n, LillaList xs] = return $ LillaList $ concat $ replicate (fromIntegral n) xs
repl [_, LillaList _] = throwError $ RuntimeLillaError "TypeError: expecting Integer as 1st argument."
repl [IntegerLilla _, _] = throwError $ RuntimeLillaError "TypeError: expecting List as 2nd argument."
repl [_, _] = throwError $ RuntimeLillaError "TypeError: expecting arguments of types Integer and List."
repl _ = throwError $ RuntimeLillaError "TypeError: repl takes exactly 2 arguments."

boolBinop :: (LillaVal -> ThrowsLillaError a) -> (a -> a -> Bool) -> [LillaVal] -> ThrowsLillaError LillaVal
boolBinop unpacker op args 
    | length args /= 2 = 
        throwError $ RuntimeLillaError $ "TypeError: function is expecting 2 args, currently has:"  ++ (show $ length args) ++ "."
    | otherwise        = do
        left <- unpacker $ args !! 0
        right <- unpacker $ args !! 1
        return . BooleanLilla $ left `op` right

numBoolBinop = boolBinop unpackNum
strBoolBinop = boolBinop unpackStr
boolBoolBinop = boolBinop unpackBool

unpackStr :: LillaVal -> ThrowsLillaError String
unpackStr (StringLilla s) = return s
unpackStr notString = throwError $ RuntimeLillaError "Typerror: expecting String." 

unpackBool :: LillaVal -> ThrowsLillaError Bool
unpackBool (BooleanLilla b) = return b
unpackBool notBool = throwError $ RuntimeLillaError "Typerror: expecting Bool."

numericBinop :: (Integer -> Integer -> Integer) -> [LillaVal] -> ThrowsLillaError LillaVal
numericBinop op [_] = throwError $ RuntimeLillaError "TypeError: expecting 2 arguments, got 1 instead."
numericBinop op params = mapM unpackNum params >>= return . IntegerLilla . foldl1 op

unpackNum :: LillaVal -> ThrowsLillaError Integer
unpackNum (IntegerLilla n) = return n
unpackNum _ = throwError $ RuntimeLillaError "Typerror: expecting Integer."

isNumeric :: LillaVal -> Bool
isNumeric (IntegerLilla _) = True
isNumeric _ = False

isBoolean :: LillaVal -> Bool
isBoolean (BooleanLilla _) = True
isBoolean _ = False

isString :: LillaVal -> Bool
isString (StringLilla _) = True
isString _ = False

isCharacter :: LillaVal -> Bool
isCharacter (CharacterLilla _) = True
isCharacter _ = False

boolAccumulator :: [LillaVal] -> (LillaVal -> Bool) -> Bool
boolAccumulator xs' f = foldr (\x' acc' -> x' && acc') True $ f <$> xs'

checkIfHomogenous :: [LillaVal] -> Bool
checkIfHomogenous xs = foldr (\x acc -> x || acc) False typeHomogenities where
    typeHomogenities = [
        boolAccumulator xs isNumeric, 
        boolAccumulator xs isBoolean, 
        boolAccumulator xs isString, 
        boolAccumulator xs isCharacter]
