trying to extract the first instruction in an Operational program

operational-first-instruction.hs

{-# LANGUAGE GADTs #-}
{-# LANGUAGE StandaloneDeriving #-}

import Control.Monad.Operational
data Intent result where
    Prompt :: String -> Intent String
    Display :: String -> Intent ()
deriving instance Show (Intent result)

type MyEffect a = Program Intent a

prompt p = singleton (Prompt p)
display o = singleton (Display o)

-- |A sample program
greet :: MyEffect String
greet = do
    name <- prompt "Enter your name: "
    let greeting = "Why hello there, " ++ name ++ "."
    display greeting
    friendName <- prompt "And what is your friend's name? "
    display ("It's good to meet you too, " ++ friendName ++ ".")
    return "blacrg"

extractFirst :: MyEffect a -> Intent b
extractFirst prog = case view prog of (intent :>>= cont) -> intent



-- minimal.hs:26:61:
--     Couldn't match type ‘b1’ with ‘b’
--       ‘b1’ is a rigid type variable bound by
--            a pattern with constructor
--              :>>= :: forall (instr :: * -> *) (m :: * -> *) a b.
--                      instr b -> (b -> ProgramT instr m a) -> ProgramViewT instr m a,
--            in a case alternative
--            at minimal.hs:26:40
--       ‘b’ is a rigid type variable bound by
--           the type signature for extractFirst :: MyEffect a -> Intent b
--           at minimal.hs:25:17
--     Expected type: Intent b
--       Actual type: Intent b1
--     Relevant bindings include
--       cont :: b1 -> ProgramT Intent Data.Functor.Identity.Identity a
--         (bound at minimal.hs:26:52)
--       intent :: Intent b1 (bound at minimal.hs:26:40)
--       extractFirst :: MyEffect a -> Intent b (bound at minimal.hs:26:1)
--     In the expression: intent
--     In a case alternative: (intent :>>= cont) -> intent
-- Failed, modules loaded: none.