{-# LANGUAGE OverloadedStrings #-}

module IR.Constraint.Error where

import qualified Common.Identifiers as Ident


data Type
  = Infinite
  | Error
  | FlexVar Ident.TVarId
  | RigidVar Ident.TVarId
  | Type Ident.TConId [Type]
  deriving (Int -> Type -> ShowS
[Type] -> ShowS
Type -> String
(Int -> Type -> ShowS)
-> (Type -> String) -> ([Type] -> ShowS) -> Show Type
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Type] -> ShowS
$cshowList :: [Type] -> ShowS
show :: Type -> String
$cshow :: Type -> String
showsPrec :: Int -> Type -> ShowS
$cshowsPrec :: Int -> Type -> ShowS
Show)


-- data Problem
--   = ArityMismatch Int Int
--   | BadRigidVar Ident.TVarId Type

data Error
  = BadExpr Type Type
  | BadPattern Type Type
  | InfiniteType Ident.Identifier Type


toErrorString :: Error -> String
toErrorString :: Error -> String
toErrorString Error
err = case Error
err of
  BadExpr Type
actualType Type
expectedType ->
    String
"Ill-typed expression. Expected "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ Type -> String
forall a. Show a => a -> String
show Type
expectedType
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", but got "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ Type -> String
forall a. Show a => a -> String
show Type
actualType
  BadPattern Type
actualType Type
expectedType ->
    String
"Ill-typed pattern. Expected "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ Type -> String
forall a. Show a => a -> String
show Type
expectedType
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", but got "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ Type -> String
forall a. Show a => a -> String
show Type
actualType
  InfiniteType Identifier
name Type
overallType ->
    String
"Infinite type for variable "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ Identifier -> String
forall a. Show a => a -> String
show Identifier
name
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", which has the infinite type: "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ Type -> String
forall a. Show a => a -> String
show Type
overallType