mvc with vty

Main.hs

#!/usr/bin/env stack
-- stack --resolver lts-7.14 --install-ghc runghc --package vty --package pipes --package pipes-concurrency
{-# LANGUAGE OverloadedStrings #-}

module Main where

import Graphics.Vty
import Data.Default
import Control.Monad
import System.IO
import Pipes
import Pipes.Concurrent
import GHC.IO.Handle   -- yes, it's GHC-specific


main = do
      -- hDuplicateTo stderr stdout  -- redirect stdout to stderr
      (output, input) <- spawn Unbounded
      forkIO $ do runEffect $ evt  >-> toOutput output
                  performGC
      runEffect $ fromInput input >-> handler


                                                                            
evt :: Producer String IO r
evt = do
      vty <- lift $ mkVty def
      let line0 = string (def `withForeColor` green) "first line >="
          line1 = string (def `withBackColor` blue) "second line >=>"
          img = line0 <-> line1
          pic = picForImage img
      lift $ update vty pic

      forever $ do
        e <- lift $ nextEvent vty
        -- shutdown vty
        -- lift $ print $ "=> Last event was: " ++ show e
	yield $ show e


handler :: Consumer String IO ()
handler = loop
  where
    loop = do
        event <- await
	lift $ hPutStrLn stderr $ "handler: " ++ event
	loop