From d81bf549eb17990e785feb1182242fb4a322ad1b Mon Sep 17 00:00:00 2001
From: tv <tv@shackspace.de>
Date: Mon, 28 Jul 2014 02:51:06 +0200
Subject: add (empty) Reader VTConfig; rename monad to VT

---
 Main.hs | 41 +++++++++++++++++++++++++++--------------
 1 file changed, 27 insertions(+), 14 deletions(-)

(limited to 'Main.hs')

diff --git a/Main.hs b/Main.hs
index 4a794a4..395db91 100644
--- a/Main.hs
+++ b/Main.hs
@@ -16,11 +16,15 @@ import System.Locale (defaultTimeLocale, rfc822DateFormat)
 --import System.Posix.Signals
 
 import Control.Monad.Error
-import Control.Monad.Writer
+import Control.Monad.Reader
 import Control.Monad.State
+import Control.Monad.Writer
 
 import Buffer
 
+data VTConfig = VTConfig
+    {
+    }
 
 data VTState = VTState
     { buffer :: Buffer
@@ -67,12 +71,15 @@ uiThread modeRef lock = do
     m <- readIORef modeRef
     c <- getCommand m
     m' <- modifyMVar lock $ \ buf -> do
-        let st = VTState
+        let cf = VTConfig
+                {
+                }
+            st = VTState
                 { mode = m
                 , buffer = buf
                 }
 
-        ((eSt, lines), st') <- runExecCommand st (execCommand c)
+        ((eSt, lines), st') <- runVT cf st (execCommand c)
 
         clearLine
         forM_ lines putStrLn
@@ -156,37 +163,42 @@ prettyError e = rec e
 
 
 
-modifyBuffer :: (Buffer -> Buffer) -> ExecM ()
+modifyBuffer :: (Buffer -> Buffer) -> VT ()
 modifyBuffer f =
     modify $ \st -> st { buffer = f (buffer st) }
 
 
 
-newtype ExecM a = ExecM
-    ( ErrorT ExecError (WriterT [String] (StateT VTState IO)) a
-    )
+newtype VT a = VT
+    (ReaderT VTConfig
+        (ErrorT ExecError
+            (WriterT [String]
+                (StateT VTState IO
+        )))
+        a)
   deriving
     ( Applicative
     , Functor
     , Monad
     , MonadError ExecError
     , MonadIO
+    , MonadReader VTConfig
     , MonadState VTState
     , MonadWriter [String]
     )
 
-runExecCommand ::
-    VTState -> ExecM a -> IO ((Either ExecError a, [String]), VTState)
+runVT ::
+    VTConfig -> VTState -> VT a -> IO ((Either ExecError a, [String]), VTState)
 
-runExecCommand st (ExecM ex) =
-    runStateT (runWriterT (runErrorT ex)) st
+runVT cf st (VT a) =
+    runStateT (runWriterT (runErrorT (runReaderT a cf))) st
 
 
 
 insertString s (ls, rs) = (ls ++ s, rs)
 
 
-execCommand :: Command -> ExecM ()
+execCommand :: Command -> VT ()
 
 execCommand (MotionCommand x) = do
     modifyBuffer (move x)
@@ -239,14 +251,15 @@ execCommand (AlertBadInput s) =
     throwError (UnhandledInputError s)
 
 execCommand (Combine c1 c2) = do
+    cf <- ask
     q0 <- get
 
-    ((eSt1, lines1), q1) <- liftIO $ runExecCommand q0 (execCommand c1)
+    ((eSt1, lines1), q1) <- liftIO $ runVT cf q0 (execCommand c1)
 
     -- TODO "stack trace"
     whenLeft eSt1 throwError
 
-    ((eSt2, lines2), q2) <- liftIO $ runExecCommand q1 (execCommand c2)
+    ((eSt2, lines2), q2) <- liftIO $ runVT cf q1 (execCommand c2)
 
     -- TODO "stack trace"
     whenLeft eSt2 throwError
-- 
cgit v1.2.3