Example of using a comonadic like structure to build a dialog tool.

DialogComonad.hs

-- class KComonad m w where
--   extractM   :: w a -> m a
--   extendM    :: (w a -> m b) -> w a -> m (w b)
--   duplicateM :: w a -> m (w (w a))

-- A variation on the Moore comonad
-- that allows for a termination condition.
-- Q: What kind of structure is this?
-- I think this is a monadic comonad with additional
-- structure.
data MooreE s e a = 
  MooreE s (e -> Either a (MooreE s e a))

-- Q: Is this a monadic comonad?
data MooreM m e s = 
  MooreM s (e -> m (MooreM m e s))

data DialogViewModel =
    DisplayMessage { 
      message :: String,
      saidBy  :: String 
    }
  | DisplayPrompt { 
      promptMessage :: String,
      promptedBy :: String,
      options :: [String],
      selected :: Int
    }

data DialogEvent =
    MoveCursorUp
  | MoveCursorDown
  | PressEnter

type Dialog = MooreM Maybe DialogEvent DialogViewModel

data Free f a = 
    Free (f (Free f a))
  | Pure a

data DialogF a =
    SayF String String a
  | PromptF String String [(String, DialogMonad ())] a

type DialogMonad a = Free DialogF a

say :: String -> String -> DialogMonad ()
say = undefined

prompt :: String -> String -> [(String, DialogMonad a)] -> DialogMonad a
prompt = undefined

dialog :: Free DialogF () -> Maybe Dialog
dialog (Pure _) = Nothing
dialog st@(Free (SayF player msg rest)) = Just $ 
  MooreM (DisplayMessage msg player) $ \event ->
      case event of
          PressEnter -> dialog rest
          otherwise  -> dialog st
dialog st@(Free (PromptF player msg options rest)) = 
    dialogPrompt player msg options rest 0
  where
    dialogPrompt player msg options rest selected = pure $ 
      MooreM (DisplayPrompt msg player (map fst options) selected) $ \event ->
      case event of
          MoveCursorUp   | selected < length options - 1 ->
              dialogPrompt player msg options rest (selected + 1)
          MoveCursorDown | selected > 0 -> 
              dialogPrompt player msg options rest (selected - 1) 
          PressEnter     -> dialog rest
          otherwise      -> dialogPrompt player msg options rest selected
{-
exampleDialog :: Dialog ()
exampleDialog = dialog $ do
  say "player_1" "hello!"
  prompt "player_1" "What would you like to do?" 
    [
      ("A", do
          say "player_1" "Great!"),
      ("B", do
          say "player_1" "Ok."
          say "player_1" "See you tomorrow.")
    ]
    -}

main = do
  putStrLn "Hello"
  putStrLn "World"