StateStuff.hs

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ConstraintKinds #-}

import Control.Applicative
import Control.Monad.State

data Var = Var
data Tp = Tp

-- Cut 1

class MonadState s m => VarState s m where
  getVar :: m Var
  putVar :: Var -> m ()

instance VarState Var (State Var) where
  getVar = get
  putVar = put

instance VarState (Var, s) (State (Var, s)) where
  getVar = fst `fmap` get
  putVar v = put =<< (v,) . snd <$> get

-- Cut 2

class VarState' s where
  getVar' :: (Functor m, Monad m) => StateT s m Var
  putVar' :: (Functor m, Monad m) => Var -> StateT s m ()

instance VarState' Var where
  getVar' = get
  putVar' = put

instance VarState' (Var, s) where
  getVar' = fst `fmap` get
  putVar' v = put =<< (v,) . snd <$> get

type MonadVarState s m = (VarState' s, Functor m, Monad m)

fresh :: MonadVarState s m => StateT s m Var
fresh = undefined