summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--Main.hs41
1 files changed, 27 insertions, 14 deletions
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