ReifyOperational.hs

 
import           Control.Monad.Operational
import           Data.Dynamic
import           Data.Reify
import           Protolude



data Prog i a f = Val a
                | Step f f
                | Inst (i a)


class NewVar a where
  mkVar :: Dynamic -> a

instance ( Typeable i, Typeable b) =>
         MuRef (Program i b) where
  type DeRef (Program i b) = Prog i b

  mapDeRef f (Instr x)  = pure $ Inst x
  mapDeRef _ (Lift m)   = undefined
  mapDeRef f (Bind x k) = Step <$> _f x <*> f (k v)
    where
      v = mkVar (toDyn k)



instance ( Typeable i, Typeable b
         , DeRef (i b) ~ DeRef (ProgramView i b)
         , DeRef (Program i b) ~ DeRef (ProgramView i b)) =>
         MuRef (ProgramView i b) where
  type DeRef (ProgramView i b) = Prog i b

  mapDeRef _ (Return x) = pure $ Val x
  mapDeRef f (x :>>= k) = Step <$> f x <*> f (k v)
    where
      v = mkVar (toDyn k)