Skip to content

Instantly share code, notes, and snippets.

@clojj
Created Jan 21, 2017
Embed
What would you like to do?
mvc with vty
#!/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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment