Example of using Bound with a non-monad

Main.hs

-- A small imperative language with a single anonymous mutable variable.
-- In response to http://www.reddit.com/r/haskell/comments/207mcn/binding_type_variables_using_the_bound_library/
{-# LANGUAGE DeriveFunctor #-}
module Main where

import Control.Monad.Trans.Class
import Control.Monad.Trans.State
import Bound


-- `Get` refers to the value of the anonymous variable.
data Exp a = V a | I Int | Get | Add (Exp a) (Exp a) | Mul (Exp a) (Exp a)
  deriving Functor

-- `Term e` is not a monad, which makes it harder to use with the Bound library.
-- The goal of this program is to demonstrate that custom implementations of
-- `abstract1` and `instantiate1` are required but easy.
data Term e a = Then (Term e a) (Term e a) | Assign (e a) | Let (e a) (Term (Scope () e) a)
  deriving Functor

type ClosedTerm a = Term Exp a

instance Monad Exp where
  return = V
  V a      >>= f = f a
  I i      >>= _ = I i
  Get      >>= _ = Get
  Add x y  >>= f = Add (x >>= f) (y >>= f)
  Mul x y  >>= f = Mul (x >>= f) (y >>= f)


-- e has the form (Scope () (Scope () ... (Scope () Exp))).
-- As we recur under Let binders, extra Scope () are prepended to this list.
-- `eAbstract1` prepends an extra Scope () everywhere, while
-- `eInstantiate1` pops the first Scope () everywhere.

eAbstract1 :: (Monad e, Eq a) => a -> Term e a -> Term (Scope () e) a
eAbstract1 v (Then x y) = Then (eAbstract1 v x) (eAbstract1 v y)
eAbstract1 v (Assign x) = Assign (abstract1 v x)
eAbstract1 v (Let x body) = Let (abstract1 v x) (eAbstract1 v body)

eInstantiate1 :: Monad e => e a -> Term (Scope () e) a -> Term e a
eInstantiate1 e (Then x y) = Then (eInstantiate1 e x) (eInstantiate1 e y)
eInstantiate1 e (Assign x) = Assign (instantiate1 e x)
eInstantiate1 e (Let x body) = Let (instantiate1 e x) (eInstantiate1 (lift e) body)


let' :: Eq a => a -> Exp a -> ClosedTerm a -> ClosedTerm a
let' v e b = Let e (eAbstract1 v b)

evalExpr :: Exp a -> Int -> Int
evalExpr (V _)     _ = error "please only use V with let'"
evalExpr Get       s = s
evalExpr (I i)     _ = i
evalExpr (Add x y) s = evalExpr x s + evalExpr y s
evalExpr (Mul x y) s = evalExpr x s * evalExpr y s

evalTerm :: ClosedTerm a -> State Int ()
evalTerm (Then x y) = evalTerm x >> evalTerm y
evalTerm (Assign x) = modify (evalExpr x)
evalTerm (Let x body) = do
    s <- get
    evalTerm (eInstantiate1 (I $ evalExpr x s) body)


evalIO :: ClosedTerm a -> IO ()
evalIO = print . flip execState 0 . evalTerm

-- $s = 0;
-- let $z = $s in {
--   $s = $z + 1;       -- 1
--   let $two = $s * 2 + $z in {
--     $s = $two + $z;  -- 2
--   }
-- }
-- print $s;            -- 2
main :: IO ()
main = do
    evalIO $ let' "z" Get $
      Assign (V "z" `Add` I 1) `Then`
      let' "two" ((Get `Mul` I 2) `Add` V "z")
        (Assign (V "two" `Add` V "z"))