diff options
| author | tv <tv@shackspace.de> | 2014-07-28 02:51:06 +0200 | 
|---|---|---|
| committer | tv <tv@shackspace.de> | 2014-07-28 02:51:06 +0200 | 
| commit | d81bf549eb17990e785feb1182242fb4a322ad1b (patch) | |
| tree | a0494d76c910392a5e2d57f800ddc31a2385d428 | |
| parent | 576d9ae79bd52311d8472c4f21db09386e6f2640 (diff) | |
add (empty) Reader VTConfig; rename monad to VT
| -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 | 
