RosettaHaskellCompiler/src/Semantic/ExpressionChecker.hs

module Semantic.ExpressionChecker where

import Model.Function
import Data.Either
import Data.Maybe
import Model.Type
import Semantic.TypeChecker
import Utils.Utils

-- |A declared variable or function
data Symbol = Var{
   varName :: String,
   declaredType :: Type,
   cardinality :: Cardinality
   }
   | Func {
   funcName :: String,
   argsType :: [(Type, Cardinality)],
   returnType :: (Type, Cardinality)
   } deriving (Show)

instance Eq Symbol where
    (==) (Var name1 _ _) (Var name2 _ _)
        | name1 == name2 = True
        | otherwise = False
    (==) (Func name1 _ _) (Func name2 _ _)
        | name1 == name2 = True
        | otherwise = False
    (==) _ _ = False


-- |A map of the predefined functions, their arguments and their return type
defaultMap :: [Symbol]
defaultMap = [
  Func "or" [(BasicType "Boolean", Bounds (1, 1)), (BasicType "Boolean", Bounds (1, 1))] (BasicType "Boolean", Bounds (1, 1)),
  Func "and" [(BasicType "Boolean", Bounds (1, 1)), (BasicType "Boolean", Bounds (1, 1))] (BasicType "Boolean", Bounds (1, 1)),
  Func "exists" [(BasicType "Any", OneBound 0)] (BasicType "Boolean", Bounds(1, 1)),
  Func "is absent" [(BasicType "Any", Bounds (0, 1))] (BasicType "Boolean", Bounds (1, 1)),
  Func "single exists" [(BasicType "Any", OneBound 0)] (BasicType "Boolean", Bounds (1, 1)),
  Func "multiple exists" [(BasicType "Any", OneBound 0)] (BasicType "Boolean", Bounds (1, 1)),
  Func "only exists" [(BasicType "Any", OneBound 0)] (BasicType "Boolean", Bounds (1, 1)),

  Func "=" [(BasicType "Any", Bounds(1, 1)), (BasicType "Any", Bounds(1, 1))] (BasicType "Boolean", Bounds(1, 1)),
  Func "=" [(BasicType "Any", Bounds(0, 1)), (BasicType "Any", Bounds(0, 1))] (BasicType "Boolean", Bounds(1, 1)),
  Func "=" [(BasicType "Any", OneBound 0), (BasicType "Any", OneBound 0)] (BasicType "Boolean", Bounds(1, 1)),
  Func ">=" [(BasicType "Any", Bounds(1, 1)), (BasicType "Any", Bounds(1, 1))] (BasicType "Boolean", Bounds(1, 1)),
  Func ">=" [(BasicType "Any", Bounds(0, 1)), (BasicType "Any", Bounds(0, 1))] (BasicType "Boolean", Bounds(1, 1)),
  Func ">=" [(BasicType "Any", OneBound 0), (BasicType "Any", OneBound 0)] (BasicType "Boolean", Bounds(1, 1)),
  Func "<=" [(BasicType "Any", Bounds(1, 1)), (BasicType "Any", Bounds(1, 1))] (BasicType "Boolean", Bounds(1, 1)),
  Func "<=" [(BasicType "Any", Bounds(0, 1)), (BasicType "Any", Bounds(0, 1))] (BasicType "Boolean", Bounds(1, 1)),
  Func "<=" [(BasicType "Any", OneBound 0), (BasicType "Any", OneBound 0)] (BasicType "Boolean", Bounds(1, 1)),
  Func "<>" [(BasicType "Any", Bounds(1, 1)), (BasicType "Any", Bounds(1, 1))] (BasicType "Boolean", Bounds(1, 1)),
  Func "<>" [(BasicType "Any", Bounds(0, 1)), (BasicType "Any", Bounds(0, 1))] (BasicType "Boolean", Bounds(1, 1)),
  Func "<>" [(BasicType "Any", OneBound 0), (BasicType "Any", OneBound 0)] (BasicType "Boolean", Bounds(1, 1)),
  Func ">" [(BasicType "Any", Bounds(1, 1)), (BasicType "Any", Bounds(1, 1))] (BasicType "Boolean", Bounds(1, 1)),
  Func ">" [(BasicType "Any", Bounds(0, 1)), (BasicType "Any", Bounds(0, 1))] (BasicType "Boolean", Bounds(1, 1)),
  Func ">" [(BasicType "Any", OneBound 0), (BasicType "Any", OneBound 0)] (BasicType "Boolean", Bounds(1, 1)),
  Func "<" [(BasicType "Any", Bounds(1, 1)), (BasicType "Any", Bounds(1, 1))] (BasicType "Boolean", Bounds(1, 1)),
  Func "<" [(BasicType "Any", Bounds(0, 1)), (BasicType "Any", Bounds(0, 1))] (BasicType "Boolean", Bounds(1, 1)),
  Func "<" [(BasicType "Any", OneBound 0), (BasicType "Any", OneBound 0)] (BasicType "Boolean", Bounds(1, 1)),

  Func "+" [(BasicType "Integer", Bounds (1, 1)), (BasicType "Integer", Bounds (1, 1))] (BasicType "Integer", Bounds (1, 1)),
  Func "+" [(BasicType "Double", Bounds (1, 1)), (BasicType "Double", Bounds (1, 1))] (BasicType "Double", Bounds (1, 1)),
  Func "+" [(BasicType "Integer", OneBound 0), (BasicType "Integer", OneBound 0)] (BasicType "Integer", Bounds (1, 1)),
  Func "+" [(BasicType "Double", OneBound 0), (BasicType "Double", OneBound 0)] (BasicType "Double", Bounds (1, 1)),
  Func "-" [(BasicType "Integer", Bounds (1, 1)), (BasicType "Integer", Bounds (1, 1))] (BasicType "Integer", Bounds (1, 1)),
  Func "-" [(BasicType "Double", Bounds (1, 1)), (BasicType "Double", Bounds (1, 1))] (BasicType "Double", Bounds (1, 1)),
  Func "*" [(BasicType "Integer", Bounds (1, 1)), (BasicType "Integer", Bounds (1, 1))] (BasicType "Integer", Bounds (1, 1)),
  Func "*" [(BasicType "Double", Bounds (1, 1)), (BasicType "Double", Bounds (1, 1))] (BasicType "Double", Bounds (1, 1)),
  Func "/" [(BasicType "Integer", Bounds (1, 1)), (BasicType "Integer", Bounds (1, 1))] (BasicType "Integer", Bounds (1, 1)),
  Func "/" [(BasicType "Double", Bounds (1, 1)), (BasicType "Double", Bounds (1, 1))] (BasicType "Double", Bounds (1, 1)),
  Func "^" [(BasicType "Integer", Bounds (1, 1)), (BasicType "Integer", Bounds (1, 1))] (BasicType "Integer", Bounds (1, 1)),
  Func "^" [(BasicType "Double", Bounds (1, 1)), (BasicType "Double", Bounds (1, 1))] (BasicType "Double", Bounds (1, 1)),

  Func "count" [(BasicType "Any", OneBound 0)] (BasicType "Integer", Bounds (1, 1))
  ]

-- |A list of the allowed list functions, the type of their expression and their return type
listFunctionTypes :: Coercion -> Coercion -> [(String, Coercion, Coercion)]
listFunctionTypes inp ex = [
    -- The function given to a filter must be boolean and it can return anything
    ("filter", MakeCoercion [MakeIdCoercion (BasicType "Boolean")] (MakeCardinalityIdCoercion (OneBound 0)), inp),
    ("map", MakeCoercion [MakeIdCoercion (BasicType "Any")] (MakeCardinalityIdCoercion (OneBound 0)), MakeCoercion (typeCoercion ex) (cardinalityCoercion inp)),
    ("reduce", MakeCoercion [MakeIdCoercion (BasicType "Any")] (MakeCardinalityIdCoercion (Bounds (1, 1))), ex)
    ]

listUnaryFunctionTypes :: Coercion -> [(String, Coercion)]
listUnaryFunctionTypes inp = [
    ("only-element", MakeCoercion (typeCoercion inp) (MakeCardinalityIdCoercion (Bounds (1, 1)))),
     ("flatten", inp)
    ]

-- |Checks whether a function is valid (inputs, outputs are of valid type and all variables are defined) and adds it to the symbol table
addFunction :: ([Type], [Symbol]) -> Function -> Either [TypeCheckError] [Symbol]
addFunction (definedTypes, definedSymbols) (MakeFunction (MakeFunctionSignature name _ inps out) _ _) =
    case head $ checkAttributes definedTypes [out] of
        Left err -> Left [err]
        Right checkedOutput -> if null (lefts checkedInputs)
            then if name `elem` map funcName definedSymbols
                then Left [MultipleDeclarations name]
                else Right $ Func name (map typeAndCardinality (rights checkedInputs)) (attributeType checkedOutput, Model.Type.cardinality out) : definedSymbols
            else Left $ lefts checkedInputs
    where
        checkedInputs = checkAttributes definedTypes inps

-- |Adds a newly defined variable to the symbol table
addVariables :: [Symbol] -> [TypeAttribute] -> [Symbol]
addVariables s [] = s
addVariables s ((MakeTypeAttribute name typ crd _)  : vars) = Var name (toHaskell typ) crd : addVariables s vars

-- |Checks the type of a given expression
checkExpression :: [Type] -> [Symbol] -> Expression -> Either TypeCheckError ExplicitExpression
--checkExpression sym _ = error $ show sym
checkExpression _ symbolMap (Variable var) = findVarType var symbolMap
checkExpression _ _ (Int val) = Right $ Value val $ MakeCoercion [MakeIdCoercion (BasicType "Integer")] (MakeCardinalityIdCoercion (Bounds (1, 1)))
checkExpression _ _ (Real val) = Right $ Value val $ MakeCoercion [MakeIdCoercion (BasicType "Double")] (MakeCardinalityIdCoercion (Bounds (1, 1)))
checkExpression _ _ (Boolean val) = Right $ Value val $ MakeCoercion [MakeIdCoercion (BasicType "Boolean")] (MakeCardinalityIdCoercion (Bounds (1, 1)))
checkExpression _ _ Empty = Right $ Value "empty" $ MakeCoercion [MakeIdCoercion (BasicType "Empty")] (MakeCardinalityIdCoercion (Bounds (0, 0)))
checkExpression defT symbolMap (Enum enum val) = case getType enum  defT of 
    Left err -> Left err
    Right typ -> if val `elem` map attributeName (typeAttributes typ) 
        then Right $ ExplicitEnumCall enum val $ MakeCoercion [MakeIdCoercion typ] (MakeCardinalityIdCoercion (Bounds (1, 1)))  
        else Left $ UndefinedVariable val
checkExpression defT symbolMap (Reduce op lst v1 v2 cond) =
    case checkExpression defT symbolMap lst of
        Left err -> Left $ ErrorInsideFunction $ op ++ ": " ++ show err
        Right checkedLst -> let it = getNextItem symbolMap in
            case checkExpression defT 
                (addVariables symbolMap [MakeTypeAttribute it (typeFromExpression checkedLst) (Bounds (1,1)) Nothing, 
                                                                MakeTypeAttribute v1 (typeFromExpression checkedLst) (Bounds (1,1)) Nothing,
                                                                MakeTypeAttribute v2 (typeFromExpression checkedLst) (Bounds (1,1)) Nothing])
                (replaceVar cond it) of
                    Left err -> Left $ ErrorInsideFunction $ op ++ ": " ++ show err
                    Right condType -> case returnCoercion condType `coercionIncluded` head [snd3 x | x <- listOps, fst3 x == op] of
                        Left err -> Left $ ErrorInsideFunction $ op ++ ": " ++ show err
                        Right checkedCond -> Right $ ExplicitReduce op checkedLst v1 v2 (changeCoercion condType checkedCond) (head [trd3 x | x <- listOps, fst3 x == op])
                        where
                            listOps = listFunctionTypes (returnCoercion checkedLst) (returnCoercion condType)

checkExpression defT symbolMap (ListOp op lst cond) =
    case checkExpression defT symbolMap lst of
        Left err -> Left $ ErrorInsideFunction $ op ++ ": " ++ show err
        Right checkedLst -> {-if toCardinality (cardinalityCoercion (returnCoercion checkedLst)) == Bounds(1, 1) 
            then Left $ ListOperationNotOnList $ show op ++ ": " ++ show lst
            else -}let it = getNextItem symbolMap in
                case checkExpression defT 
                    (addVariables symbolMap [MakeTypeAttribute it (typeFromExpression checkedLst) (Bounds (1,1)) Nothing]) 
                    (replaceVar cond it) of
                Left err -> Left $ ErrorInsideFunction $ op ++ ": " ++ show err
                Right condType -> case returnCoercion condType `coercionIncluded` head [snd3 x | x <- listOps, fst3 x == op] of
                    Left err -> Left $ ErrorInsideFunction $ op ++ ": " ++ show err
                    Right checkedCond -> Right $ ExplicitListOp op checkedLst (changeCoercion condType checkedCond) (head [trd3 x | x <- listOps, fst3 x == op])
                    where
                        listOps = listFunctionTypes (returnCoercion checkedLst) (returnCoercion condType)
checkExpression defT symbolMap (ListUnaryOp op lst) =
    case checkExpression defT symbolMap lst of
        Left err -> Left $ ErrorInsideFunction $ op ++ ": " ++ show err
        Right checkedLst -> {-if toCardinality (cardinalityCoercion (returnCoercion checkedLst)) == Bounds(1, 1) 
            then Left $ ListOperationNotOnList $ show op ++ ": " ++ show lst
            else -}if op `elem` map fst (listUnaryFunctionTypes (returnCoercion checkedLst))
                then Right $ ExplicitListUnaryOp op checkedLst (head [snd x | x <- listUnaryFunctionTypes (returnCoercion checkedLst), fst x == op])
                else Left $ UndefinedFunction op
checkExpression _ _ (Keyword k) = Right $ ExplicitKeyword k
checkExpression defT symbolMap (PathExpression ex1 (Variable b)) = 
    case checkExpression defT symbolMap ex1 of
        Left err -> Left err
        Right exp1 -> case findAttributeTypeRec defT b type1 of
            Left err -> Left $ UndefinedVariable $ show (typeName type1) ++ " -> " ++ b
            Right exp2 -> case cardC of
                    Left err -> Left $ PathExpressionOnList (show ex1) 
                    Right c -> if MakeCondition Nothing (Keyword "one-of") `elem` conditions (typeFromExpression exp1) 
                        then Right $ ExplicitPath (changeCoercion exp1 ((returnCoercion exp1){cardinalityCoercion = c})) (changeCoercion exp2 exp2C) exp2C
                        else Right $ ExplicitPath (changeCoercion exp1 ((returnCoercion exp1){cardinalityCoercion = c})) exp2 (returnCoercion exp2)
                    where
                        exp2C = MakeCoercion (typeCoercion $ returnCoercion exp2) (MakeOneOfCoercion (Bounds (1,1)))
                        cardC = case crd1 of
                            Bounds (1, 1) -> Right $ MakeCardinalityIdCoercion crd1
                            Bounds (0, 1) -> Right $ MakeMaybe2ObjectCoercion (Bounds (1, 1))
                            _ -> Left $ PathExpressionOnList (show ex1)

            where
                type1 = typeFromExpression exp1
                crd1 = toCardinality $ cardinalityCoercion $ returnCoercion exp1
-- |Getting here means that an expression is used inside a path expression and this is not supported
checkExpression _ _ (PathExpression _ ex) = Left $ UnsupportedExpressionInPathExpression $ show ex
--checkExpression symbolMap (PathExpression ex1 (PathExpression ))
checkExpression defT symbolMap (Parens ex) =
    case checkExpression defT symbolMap ex of
        Left err -> Left err
        Right exp -> Right $ ExplicitParens exp (returnCoercion exp)
checkExpression defT symbolMap (List lst) = checkList defT symbolMap lst
checkExpression defT symbolMap (PrefixExp name ex) = checkFunctionCall symbolMap name [checkExpression defT symbolMap ex]
checkExpression defT symbolMap (Function name exps) = checkFunctionCall symbolMap name (map (checkExpression defT symbolMap) exps)
checkExpression defT symbolMap (PostfixExp name ex) = checkFunctionCall symbolMap name [checkExpression defT symbolMap ex]
checkExpression defT symbolMap (InfixExp name ex1 ex2) = checkFunctionCall symbolMap name (checkExpression defT symbolMap ex1: [checkExpression defT symbolMap ex2])
-- |Checks if the condition of an if expression is of type boolean, and then checks the expression of the then statement
checkExpression defT symbolMap (IfSimple cond ex) =
    case checkExpression defT symbolMap cond of
        Left err -> Left $ IfConditionNotBoolean $ show err
        Right condType -> case returnCoercion condType `coercionIncluded` MakeCoercion [MakeIdCoercion (BasicType "Boolean")] (MakeCardinalityIdCoercion (Bounds (1, 1))) of
            Left err -> Left $ IfConditionNotBoolean $ show cond ++ " :: " ++ show (typeFromExpression condType)
            Right condCoerce ->
                case checkExpression defT symbolMap ex of
                    Left err -> Left err
                    Right thenExp ->
                        Right $ ExplicitIfSimple (condType, condCoerce)
                        (thenExp, thenCoercion)
                        (MakeCoercion [MakeIdCoercion $ typeFromExpression thenExp]
                            (MakeCardinalityIdCoercion $ smallestBound (Bounds (0, 0)) (toCardinality $ cardinalityCoercion $ returnCoercion thenExp)))
                        where
                            thenCoercion = MakeCoercion [MakeIdCoercion $ typeFromExpression thenExp]
                                (MakeCardinalityIdCoercion $ toCardinality $ cardinalityCoercion $ returnCoercion thenExp)

-- |Checks if the condition of the if statement is of type boolean, and then checks that both the then and else statements have the same type
checkExpression defT symbolMap (IfElse cond ex1 ex2) =
    case checkExpression defT symbolMap cond of
        Left err -> Left $ IfConditionNotBoolean $ show err
        Right condType -> case returnCoercion condType `coercionIncluded` MakeCoercion [MakeIdCoercion (BasicType "Boolean")] (MakeCardinalityIdCoercion (Bounds (1, 1))) of
            Left err -> Left $ IfConditionNotBoolean $ show cond ++ " :: " ++ show (typeFromExpression condType)
            Right condCoerce ->
                case checkExpression defT symbolMap ex1 of
                    Left err -> Left $ ErrorInsideFunction $ show err
                    Right thenExp -> case checkExpression defT symbolMap ex2 of
                        Left err -> Left $ ErrorInsideFunction $ show err
                        Right elseExp ->
                            Right $ ExplicitIfElse (condType, condCoerce)
                            (thenExp, MakeCoercion [MakeIdCoercion $ typeFromExpression thenExp]
                             (MakeCardinalityIdCoercion $ toCardinality $ cardinalityCoercion $ returnCoercion thenExp))
                            (elseExp, MakeCoercion [MakeIdCoercion $ typeFromExpression elseExp]
                             (MakeCardinalityIdCoercion $ toCardinality $ cardinalityCoercion $ returnCoercion elseExp)) (returnCoercion thenExp)
                        --(typeMatch ex1Type ex2Type, smallestBound ex1Card ex2Type)

-- |TODO Handle nested lists and lists with parens
-- |Checks that all the expressions in a list have compatible types
checkList :: [Type] -> [Symbol] -> [Expression] -> Either TypeCheckError ExplicitExpression
checkList _ _ [] = Right $ ExplicitList [ExplicitEmpty]
checkList defT symbs (ex : exps) =
    case checkExpression defT symbs ex of
        Left err -> Left err
        Right x ->
            case checkList1 defT symbs exps (typeFromExpression x, toCardinality $ cardinalityCoercion $ returnCoercion x) of
                Left err -> Left err
                Right exp -> Right $ ExplicitList exp

-- |Auxiliary function for the check list function
checkList1 :: [Type] -> [Symbol] -> [Expression] -> (Type, Cardinality) -> Either TypeCheckError [ExplicitExpression]
checkList1 _ _ [] typ = Right [ExplicitEmpty]
checkList1 defT symbs (ex : exps) typ =
    case checkExpression defT symbs ex of
        Left err -> Left err
        Right exCo ->
            case fst typ `isSubType` exTyp of
                Left err -> Left err
                Right _ ->
                    case checkList1 defT symbs exps (exTyp, smallestBound exCard (snd typ)) of
                        Left err -> Left err
                        Right explicitEx -> Right [ExplicitList explicitEx]
                where
                    exTyp = typeFromExpression exCo
                    exCard = toCardinality $ cardinalityCoercion $ returnCoercion exCo

-- |Checks whether the function that is called is already defined with the same argument types
checkFunctionCall :: [Symbol] -> String -> [Either TypeCheckError ExplicitExpression ] -> Either TypeCheckError ExplicitExpression
checkFunctionCall [] fun args = Left $ UndefinedFunction $ "Undefined function: " ++ fun ++ " [" 
    ++ show [(typeName $ typeFromExpression x, toCardinality $ cardinalityCoercion $ returnCoercion x) | x <- rights args] ++ "]"
checkFunctionCall ((Func n a r):symbolMap) name args
    | not $ null $ lefts args = Left $ ErrorInsideFunction (name ++ ": " ++ show (lefts args))
    | name == n = if all isRight coerce then Right $ ExplicitFunction name (zip (rights args) (rights coerce)) (MakeCoercion [MakeIdCoercion (fst r)] (MakeCardinalityIdCoercion (snd r)))
        else checkFunctionCall symbolMap name args--Left $ UndefinedFunction $ "Undefined function: " ++ name ++ " [" ++ show (rights args) ++ "]"
    | otherwise = checkFunctionCall symbolMap name args
    where
        argCoerce = map returnCoercion (rights args)
        coerce = zipWith coercionIncluded argCoerce (map createCoercion a)
checkFunctionCall (_:symbolMap) name args = checkFunctionCall symbolMap name args

getType :: String -> [Type] -> Either TypeCheckError Type
getType t [] = Left $ UndefinedType t
getType typ (t : ts) 
    | typ == typeName t = Right t
    | otherwise = getType typ ts 

typeIncluded :: (Type, Cardinality) -> (Type, Cardinality) -> Either TypeCheckError Coercion
typeIncluded (t1, c1) (t2, c2) =
    case t1 `isSubType` t2 of
        Left err -> Left err
        Right typeCoercion -> 
            case c1 `cardinalityIncluded` c2 of
                Left err -> Left err
                Right cardCoercion -> Right $ MakeCoercion typeCoercion cardCoercion

-- | Checks whether the first coercion can be transformed into the second coercion
coercionIncluded :: Coercion -> Coercion -> Either TypeCheckError Coercion
coercionIncluded c1 c2 = (coercionType (typeCoercion c1), coercionCardinality [cardinalityCoercion c1]) `typeIncluded` (coercionType (typeCoercion c2), coercionCardinality [cardinalityCoercion c2])

-- |Finds the most specific super type of the two types
typeMatch :: Type -> Type -> Type
-- |Any matches with any type
typeMatch (BasicType "Any") x = x
typeMatch x (BasicType "Any") = x
-- |Integer can be a double
-- typeMatch (BasicType "Integer") (BasicType "Double") = BasicType "Double"
-- typeMatch (BasicType "Double") (BasicType "Integer") = BasicType "Double"
typeMatch x (BasicType y) =
    case x `isSubType` BasicType y of
        Left err -> BasicType "Object"
        Right _ -> BasicType y
-- |First check x with all the supertypes of y, then go higher on the supertypes of x and repeat
typeMatch x y = case x `isSubType` y of
        Left err -> typeMatch x (superType y)
        Right _ -> y

-- |Looks in the symbol map for the type of a variable
findVarType :: String -> [Symbol] -> Either TypeCheckError ExplicitExpression
findVarType var [] = Left $ UndefinedVariable var
findVarType x ((Var name typ crd):symbols)
    | x == name = Right $ ExplicitVariable x (MakeCoercion [MakeIdCoercion typ] (MakeCardinalityIdCoercion crd))
    | otherwise = findVarType x symbols
findVarType x (_:symbols) = findVarType x symbols

-- |Look for a type attribute in a given type and its super types
findAttributeTypeRec :: [Type] -> String -> Type -> Either TypeCheckError ExplicitExpression
findAttributeTypeRec _ var (BasicType _) = Left $ UndefinedVariable var
findAttributeTypeRec defT var t = case findAttributeType var (getTypeAttributes defT t) of
    Left err -> case findAttributeTypeRec defT var (superType t) of
        Left err -> Left err
        Right (ExplicitVariable n (MakeCoercion tc cc)) -> Right $ 
            ExplicitVariable n 
                (MakeCoercion (MakeSuperCoercion t (toType $ head tc) : tc) cc)
        Right typ -> Right typ
    Right typ -> Right typ

-- |Find whether there is a attribute with the given name in the given type, and returns the attribute's type
findAttributeType :: String -> [TypeAttribute] -> Either TypeCheckError ExplicitExpression
findAttributeType var [] = Left $ UndefinedVariable var
findAttributeType var (t : ts)
    | var == attributeName t = Right $ ExplicitVariable var (MakeCoercion [MakeIdCoercion $ attributeType t] (MakeCardinalityIdCoercion $ Model.Type.cardinality t))
    | otherwise = findAttributeType var ts

-- |Removes the path expression from item in a list operation
-- ex: person map [item -> firstname] => person map [person -> firsname] 
replaceVar :: Expression -> String -> Expression
replaceVar (Variable "item") var = Variable var
replaceVar (PathExpression a b) var = PathExpression (replaceVar a var) b
replaceVar (Parens e) var = Parens (replaceVar e var)
replaceVar (ListUnaryOp o e) var = ListUnaryOp o (replaceVar e var)
replaceVar (ListOp o e c) var = ListOp o (replaceVar e var) c
replaceVar (Function f e) var = Function f [replaceVar ex var | ex <- e]
replaceVar (PrefixExp o e) var = PrefixExp o (replaceVar e var)
replaceVar (PostfixExp o e) var = PostfixExp o (replaceVar e var)
replaceVar (InfixExp o e1 e2) var = InfixExp o (replaceVar e1 var) (replaceVar e2 var)
replaceVar (IfSimple c e1) var = IfSimple (replaceVar c var) (replaceVar e1 var)
replaceVar (IfElse c e1 e2) var = IfElse (replaceVar c var) (replaceVar e1 var) (replaceVar e2 var)
replaceVar e _ = e

-- |Checks whether the first argument is a subtype of the second argument
isSubType :: Type -> Type -> Either TypeCheckError [TypeCoercion]
isSubType (BasicType "Empty") _ = Right [MakeIdCoercion (BasicType "Empty")]
isSubType (BasicType "Integer") (BasicType "Double") = Right [MakeTypeCoercion (BasicType "Integer") (BasicType "Double") "fromInteger"]
isSubType t (BasicType "Any") = Right [MakeIdCoercion t]
isSubType (BasicType x) y
    | x == typeName y = Right [MakeIdCoercion y]
    | otherwise = Left $ TypeMismatch x (typeName y)
isSubType x y
    | typeName x == typeName y = Right [MakeIdCoercion x]
    | otherwise = case isSubType (superType x) y of
        Left e -> Left e
        Right transforms -> Right $ MakeSuperCoercion x y : transforms

getNextItem :: [Symbol] -> String
getNextItem symbs
    | Var "item" (BasicType "Any") (OneBound 0) `notElem` symbs = "item"
    | otherwise = head ["list" ++ show x | x <- [1..], Var ("list" ++ show x) (BasicType "Any") (OneBound 0) `notElem` symbs]

-- |Finds the type attributes from a type in the symbol table
getTypeAttributes :: [Type] -> Type -> [TypeAttribute]
getTypeAttributes [] t = []
getTypeAttributes defT t
    | t `elem` defT = let typ = head [x | x <- defT, x == t] in
        [MakeTypeAttribute {attributeName = attributeName attr,
            attributeType = case getType (typeName $ attributeType attr) defT of
                Left _ -> toHaskell (attributeType attr)
                Right atTyp -> atTyp,
            Model.Type.cardinality = Model.Type.cardinality attr,
            attributeDescription = attributeDescription attr}
            | attr <- typeAttributes typ]
    | otherwise = []

-- |Checks whether the first cardinality is included into the second one 
cardinalityIncluded :: Cardinality -> Cardinality -> Either TypeCheckError CardinalityCoercion
-- |Special Cases
-- |Transform nothing into a maybe
cardinalityIncluded (Bounds (0, 0)) (Bounds (0, 1)) = Right $ MakeNothing2MaybeCoercion (Bounds (0, 0)) (Bounds (0, 1))
-- |Transform nothing into a list
cardinalityIncluded (Bounds (0, 0)) (OneBound 0) = Right $ MakeNothing2ListCoercion (Bounds (0, 0)) (OneBound 0)
-- |Transform maybe into list
cardinalityIncluded (Bounds (0, 1)) (OneBound 0) = Right $ MakeMaybe2ListCoercion (Bounds (0, 1)) (OneBound 0)
-- |Transform object into maybe
cardinalityIncluded (Bounds (1, 1)) (Bounds (0, 1)) = Right $ MakeObject2MaybeCoercion (Bounds (1, 1)) (Bounds (0, 1))
-- |Transform object into list
cardinalityIncluded (Bounds (1, 1)) (OneBound 1) = Right $ MakeObject2ListCoercion (Bounds (1, 1)) (OneBound 1)
cardinalityIncluded (Bounds (1, 1)) (OneBound 0) = Right $ MakeObject2ListCoercion (Bounds (1, 1)) (OneBound 1)
-- |General
cardinalityIncluded (OneBound x) (OneBound y)
    | x == y = Right $ MakeCardinalityIdCoercion (OneBound x)
    | x > y = Right $ MakeListCardinalityCoercion (OneBound x) (OneBound y)
    | otherwise = Left $ CardinalityMismatch (OneBound x) (OneBound y)
cardinalityIncluded (Bounds (x1, y1)) (OneBound y)
    | x1 >= y = Right $ MakeListCardinalityCoercion (Bounds (x1, y1)) (OneBound y)
    | otherwise = Left $ CardinalityMismatch (Bounds (x1, y1)) (OneBound y)
cardinalityIncluded (OneBound x) (Bounds (x2, y2)) = Left $ CardinalityMismatch (OneBound x) (Bounds (x2, y2))
cardinalityIncluded (Bounds (x1, x2)) (Bounds (y1, y2))
    | x1 == y1 && x2 == y2 = Right $ MakeCardinalityIdCoercion (Bounds (x1, x2))
    | x1 >= y1 && x2 <= y2 = Right $ MakeListCardinalityCoercion (Bounds (x1, x2)) (Bounds (y1, y2))
    | otherwise = Left $ CardinalityMismatch (Bounds (x1, x2)) (Bounds (y1, y2))