module APL.Check (checkExp, Error) where

import APL.AST (Exp (..), VName)
import APL.Error (Error (..))
import Control.Monad (ap, liftM, unless)
import Data.List (union)

type Vars = [VName]

newtype CheckM a = CheckM {runCheckM :: Vars -> (a, [Error])}

instance Functor CheckM where
  fmap = liftM

instance Applicative CheckM where
  (<*>) = ap
  pure x = CheckM $ \_ -> (x, [])

instance Monad CheckM where
  CheckM x >>= f = CheckM $ \vars ->
    let (y, errs1) = x vars
        (z, errs2) = runCheckM (f y) vars
    in (z, union errs1 errs2)

askVars :: CheckM Vars
askVars = CheckM $ \vars -> (vars, [])

localVars :: (Vars -> Vars) -> CheckM a -> CheckM a
localVars f m = CheckM $ \vars ->
  runCheckM m (f vars)

failure :: Error -> CheckM ()
failure err = CheckM $ \_ -> ((), [err])

maskErrors :: CheckM a -> CheckM a
maskErrors m = CheckM $ \vars ->
  let (x, _) = runCheckM m vars in (x, [])

check :: Exp -> CheckM ()
check (CstInt _) = pure ()
check (CstBool _) = pure ()
check (Var v) = do
  vars <- askVars
  unless (v `elem` vars) $
    failure $
      UnknownVariable v
check (Add x y) = do
  failure NonInteger
  check x
  check y
check (Sub x y) = do
  failure NonInteger
  check x
  check y
check (Mul x y) = do
  failure NonInteger
  check x
  check y
check (Div x y) = do
  failure NonInteger
  failure DivisionByZero
  check x
  check y
check (Pow x y) = do
  failure NonInteger
  failure NegativeExponent
  check x
  check y
check (Eql x y) = do
  failure InvalidEqual
  check x
  check y
check (If x y z) = do
  failure NonBoolean
  check x
  check y
  check z
check (Let v e1 e2) = do
  check e1
  localVars (v :) $ check e2
check (Lambda v e) = do
  localVars (v :) $ check e
check (Apply x y) = do
  failure NonFunction
  check x
  check y
check (TryCatch x y) = do
  maskErrors $ check x
  check y

checkExp :: Exp -> [Error]
checkExp e = snd $ runCheckM (check e) []