MonadTransformers.hs

MonadTInterpreter

{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeApplications #-}

module Interpreter where

import Control.Monad.Except
import Control.Monad.State

import Data.Map
import qualified Data.Map as M

import Data.Monoid ((<>))

import Text.Read (readMaybe)

type Env = Map String Int

data Expr =
    Lit Int
  | Add Expr Expr
  | Div Expr Expr
  | Var String
  | Assign String Expr
  | Seq Expr Expr
  | Get

-- Seems like both new type and type synonyms works in a same way..
newtype Eval a = Eval (StateT Env (ExceptT String IO) a)
  deriving (Functor, Applicative, Monad, MonadState Env, MonadError String, MonadIO)

type EvalT a = StateT Env (ExceptT String IO) a

eval :: Expr -> EvalT Int
eval (Lit n)      = pure n
eval (Add e1 e2)  = (+) <$> eval e1 <*> eval e2
eval (Div e1 e2)  = doDiv e1 e2
eval (Var x)      = varLookup x
eval (Seq e1 e2)  = eval e1 >> eval e2
eval (Assign x e) = varSet x e
eval Get          = getNum

doDiv :: Expr -> Expr -> EvalT Int
doDiv e1 e2 = do
  v1 <- eval e1
  v2 <- eval e2
  if v2 == 0
    then divByZeroError
    else return (v1 `div` v2)

divByZeroError :: EvalT a
divByZeroError = throwError "Division by 0"

varLookup :: String -> EvalT Int
varLookup x = do
  env <- get
  case M.lookup x env of
    Nothing -> unknownVar x
    Just num -> return num

varSet :: String -> Expr -> EvalT Int
varSet x e = do
  v <- eval e
  modify (M.insert x v)
  return v

getNum :: EvalT Int
getNum = do
  liftIO $ putStrLn "Please enter a number"
  v <- liftIO getLine
  case readMaybe @Int v of
    Just n -> pure n
    Nothing -> invalidInput v
  
invalidInput :: String -> EvalT a
invalidInput v = throwError $ "Invalid input: " <> show v

unknownVar :: String -> EvalT a
unknownVar x = throwError $ "Variable not found: " <> show x

runEval :: EvalT a -> Env -> IO (Either String a)
runEval m env = runExceptT (evalStateT m env)

program :: Expr
program = Assign "x" (Lit 10)
          `Seq` Assign "x" (Div (Var "x") (Lit 2))
          `Seq` Add (Var "x") Get