diff options
| -rw-r--r-- | Main.hs | 41 |
1 files changed, 27 insertions, 14 deletions
@@ -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 |