I've been working on a Gameboy emulator and came up with this trick while trying to make an auto-documenting op table. It's general enough to do Spock-style routing too and doesn't require any language extensions or DataKinds magic.

Applicator.hs

{-# LANGUAGE OverloadedStrings, FlexibleInstances #-}

import Control.Applicative
import Control.Applicative.Free
import Control.Category
import Control.Monad.State
import Control.Monad.State
import Data.Functor.Coyoneda
import Data.Functor.Identity
import Data.List
import Data.String
import Prelude hiding (id, (.))

-- An Applicator. This just encapsulates applying <*>, *> etc to an Applicative.
newtype Appl f x a = Appl (f a -> f x)

-- Applicators compose in reverse order.
instance Category (Appl f) where
  id = Appl id
  Appl f . Appl g = Appl (g . f)

-- Apply an Applicative.
app :: Applicative f => f a -> Appl f x (a -> x)
app f = Appl (<*> f)

-- Apply an Applicative but ignore its result.
app_ :: Applicative f => f a -> Appl f x x
app_ f = Appl (<* f)

-- Pass the results of the Applicator into a function.
-- Equivalent to the f <$> at the start of a usual Applicative chain,
-- but here it happens at the end.
(==>) :: Applicative f => Appl f r t -> t -> f r
(==>) (Appl f) = f . pure
infixr 3 ==>

-- Spock routing example
-- it would also be easy to extend this to produce API documentation for REST
-- interfaces by also including a Monoid that gets appended in the applicative instance
type RouteParser = StateT [ String ] Maybe

consume :: RouteParser String
consume = do
  p : ps <- get
  put ps
  return p

instance IsString (Appl RouteParser x x) where
  fromString s = app_ $ do
    p <- consume
    guard (p == s)

var :: Appl RouteParser x (String -> x)
var = app consume

route :: RouteParser (IO ())
route = var . "foo" . var ==> \x y -> putStrLn (x ++ y)

-- emulator example

-- op arguments which can be extracted from an instruction
data Arg a = Arg
  { argParse :: Int -> a -- parse argument from instruction
  , argName :: String -- name of argument, i.e. IMM
  , argShow :: a -> String -- print an argument, i.e. $2321
  }

-- wrap Arg in Coyoneda to make it a functor, then make a Free applicative
type Args = Ap (Coyoneda Arg)

-- an op has an Args that produces an IO () to execute
data Op = Op String (Args (IO ()))

-- turn an Arg into an Args applicator
arg :: Arg a -> Appl Args x (a -> x)
arg = app . liftAp . liftCoyoneda

-- immediate argument
imm :: Appl Args x (Int -> x)
imm = arg $ Arg { argParse = const 42, argName = "IMM", argShow = show }

data Register = EAX

-- register argument
eax :: Appl Args x (Register -> x)
eax = arg $ Arg { argParse = const EAX, argName = "EAX", argShow = const "EAX" }

-- regular old curried function
writeReg :: Register -> Int -> IO ()
writeReg r i = print "writing register"






-- now we can implement ops really cleanly and get disassembly
-- and documentation for free!
opTable :: [ ( Int, Op ) ]
opTable = [ ( 0x42, Op "LD" $ eax . imm ==> writeReg ) ]
-- Op "CALL" $ imm ==> \addr -> view pc >>= push >> jmp addr
-- Op "RET" $ pure $ pop >>= jmp
-- etc, etc





-- execute an op
execute :: Int -> Op -> IO ()
execute instr (Op _ as)
  = runIdentity $ runAp (\(Coyoneda f a) -> Identity (f $ argParse a instr)) as

-- show an op statically
instance Show Op where
  show (Op mn as) = mn ++ " " ++ intercalate ", " args
    where args = runAp_ (\(Coyoneda _ a) -> [ argName a ]) as

-- disassemble an instruction
disassemble :: Int -> Op -> String
disassemble instr (Op mn as)
  = mn ++ intercalate ", " args
    where args = runAp_ (\(Coyoneda _ a) -> [ argShow a $ argParse a instr ]) as