free monad DSL without a terminal case

freemonaddsl.hs

{-# LANGUAGE DeriveFunctor, FlexibleInstances, ExistentialQuantification, RankNTypes #-}

import Control.Monad.Free

class Monad m => MyEffects m where
    prompt :: String -> m String
    display :: String -> m ()
    -- end :: m ()

data DSL next
    = Prompt String (String -> next)
    | Display String next
    -- | End
    deriving (Show, Functor)

instance MyEffects (Free DSL) where
    prompt p = liftF (Prompt p id)
    display o = liftF (Display o ())
    -- end = end'

runIO :: (Free DSL a) -> IO a
runIO (Free (Prompt p cont)) = do putStr p; line <- getLine; runIO (cont line)
runIO (Free (Display o cont)) = do putStrLn o; runIO cont
runIO (Pure x) = return x

greet :: MyEffects m => m 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"