getCommand: use VT instead of IO monad

1 files changed, 29 insertions, 15 deletions

diff --git a/Main.hs b/Main.hs
index 275513c..ed4c6b3 100644
--- a/Main.hs
+++ b/Main.hs
@@ -70,9 +70,23 @@ dateThread delay modeRef lock = forever $ do
     threadDelay delay
 
 
+uiThread :: IORef Mode -> MVar Buffer -> IO ()
 uiThread modeRef lock = do
     m <- readIORef modeRef
-    c <- getCommand m
+    b <- readMVar lock
+    let cf = VTConfig
+            {
+            }
+        st = VTState
+            { mode = m
+            , buffer = b
+            }
+    ((eCmd, _), _) <- runVT cf st (getCommand m)
+
+    let c = case eCmd of
+              Left _ -> undefined
+              Right cmd -> cmd
+
     m' <- modifyMVar lock $ \ buf -> do
         let cf = VTConfig
                 {
@@ -393,33 +407,33 @@ instance  Show Mode  where
   show VerbatimMode = "verbatim"
 
 
-getCommand :: Mode -> IO Command
+getCommand :: Mode -> VT Command
 getCommand InsertMode = getCommandXXX imap InsertString
 getCommand NormalMode = getCommandXXX nmap AlertBadInput
 getCommand VerbatimMode = verbatimKeymap
 
 
 -- TODO refactor me please^_^
-getCommandXXX :: Keymap -> (String -> Command) -> IO Command
+getCommandXXX :: Keymap -> (String -> Command) -> VT Command
 getCommandXXX keymap defCmd = do
 
     -- wait for the first character
-    c <- hLookAhead stdin
+    c <- liftIO $ hLookAhead stdin
 
-    bufRef <- newIORef ""
-    candRef <- newIORef Nothing
-    cmdRef <- newEmptyMVar -- :: MVar (Maybe (String -> Command))
+    bufRef <- liftIO $ newIORef ""
+    candRef <- liftIO $ newIORef Nothing
+    cmdRef <- liftIO $ newEmptyMVar -- :: MVar (Maybe (String -> Command))
 
     -- TODO ensure that this thread dies eventually
     --forkIO $ rec "" keymap cmdRef candRef
     getCharThreadId <-
         --forkFinally (rec keymap cmdRef candRef bufRef)
         --            (\_ -> putStrLn "input terminated")
-        forkIO $ do
+        liftIO $ forkIO $ do
           rec keymap cmdRef candRef bufRef
 
     watchDogThreadId <-
-        forkIO $ do
+        liftIO $ forkIO $ do
           --putStrLn "watchdog activated"
           threadDelay $ 1000 * 50 -- 50ms
           --putStrLn "watchdog timeout"
@@ -427,19 +441,19 @@ getCommandXXX keymap defCmd = do
           --putStrLn "watchdog killed getCharThread"
           putMVar cmdRef Nothing -- continue main thread
 
-    mbCmd <- takeMVar cmdRef
+    mbCmd <- liftIO $ takeMVar cmdRef
 
-    killThread watchDogThreadId
+    liftIO $ killThread watchDogThreadId
 
     cmd <- case mbCmd of
         Just cmd -> return cmd
         Nothing -> do
-            mbCmd2 <- readIORef candRef
+            mbCmd2 <- liftIO $ readIORef candRef
             case mbCmd2 of
                 Just cmd2 -> return cmd2
                 Nothing -> return defCmd
 
-    s <- readIORef bufRef
+    s <- liftIO $ readIORef bufRef
 
     --clearLine
     --putStrLn $ "\x1b[35;1m" ++ (show s) ++ " -> " ++ (show $ cmd s) ++ "\x1b[m"
@@ -495,9 +509,9 @@ getCommandXXX keymap defCmd = do
 
 
 
-verbatimKeymap :: IO Command
+verbatimKeymap :: VT Command
 verbatimKeymap = do
-  c <- getChar
+  c <- liftIO getChar
   return $ InsertString [c] <> ChangeMode InsertMode