import Control.Monad (ap, liftM)

-- | Reader is een wrapper rondom een functie, zodat we een groot aantal
-- functies die op hetzelfde argument (de omgeving) toegepast worden, kunnen
-- combineren.
newtype Reader env a = Reader { runReader :: env -> a }

-- | Een Reader is een Monad.
instance Monad (Reader env) where
    return = pure
    (Reader m) >>= k  = Reader $ \env -> runReader (k $ m env) env

instance Applicative (Reader env) where
    pure x = Reader $ const x
--  (<*>) = ap
    (Reader f) <*> (Reader x) = Reader $ \env -> f env (x env)

instance Functor (Reader env) where
-- fmap = liftM
   fmap f (Reader a) = Reader $ \env -> f (a env)

-- | Vraag de omgeving op - gelijkaardig aan "get" van State.
ask :: Reader env env
ask = Reader id

-- | Voer een gegeven Reader uit binnen een lokaal gewijzigde omgeving.
-- local :: (env -> env') -> (Reader env' a -> Reader env a)
-- local f g = Reader $ \env -> runReader g (f env)

local :: (env -> env') -> (Reader env' a -> Reader env a)
local f (Reader m) = Reader $ \env -> m $ f env

type Name = String

data Term = Add Term Term
          | App Term Term
          | Lam Name Term
          | Var Name
          | Con Int
          deriving (Eq, Show)

-- Een omgeving werkt hier iets anders dan in de 'Monadische Interpreters'
-- oefeningenreeks. Een variabelenaam wordt gemapt op een closure. Een closure
-- is een (nog te berekenen) term, tesamen met de context (zelf een omgeving)
-- waarin die berekend moet worden.

type Env = [(String, Closure)]
data Closure = Closure Term Env deriving (Eq, Show)

-- Dit geeft ook een iets andere functie-waarde definitie. Een functie bestaat
-- uit een variabelenaam en een closure: dus een variabelenaam (die we moeten
-- "toekennen"), een term (de "body" die we moeten evalueren) en de context van
-- het moment van aanmaken.

data Value = Wrong
           | Num Int
           | Fun Name Closure
           deriving (Eq, Show)

interp :: Term -> Reader Env Value
interp (Con x) = return $ Num x
interp (Add e1 e2) = do v1 <- interp e1
                        v2 <- interp e2
                        add v1 v2
interp (Lam v e) = do env <- ask
                      return $ Fun v (Closure e env)
interp (Var v) = do env <- ask
                    interpClosure (lookup v env)
interp (App e1 e2) = do v1 <- interp e1
                        app v1 e2

-- | Tel twee waarden op - als het getallen zijn.
add :: Value -> Value -> Reader Env Value
add (Num a) (Num b) = return $ Num (a + b)
add _       _       = return Wrong

-- | Bereken de waarde van een closure - als de closure bestaat.
interpClosure :: Maybe Closure -> Reader Env Value
interpClosure (Just (Closure term env)) = local (const env) (interp term)
interpClosure Nothing                   = return Wrong

-- | Pas een waarde toe op een term - als het een lambda is.
app :: Value -> Term -> Reader Env Value
app (Fun var (Closure body fenv)) arg = local (\nenv -> (var, Closure arg nenv):fenv) (interp body)
app _                             _   = return Wrong

runInterpreter :: Term -> Value
runInterpreter e = runReader (interp e) []