From f7695d4df8fd0d565d02c0d258090d372eddbfe9 Mon Sep 17 00:00:00 2001
From: tv <tv@shackspace.de>
Date: Mon, 28 Jul 2014 23:27:02 +0200
Subject: integrate Scanner crudely

---
 src/Main.hs | 140 +++++++++++++-----------------------------------------------
 1 file changed, 30 insertions(+), 110 deletions(-)

diff --git a/src/Main.hs b/src/Main.hs
index 43ff393..1a26868 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -23,6 +23,8 @@ import Control.Monad.Writer
 
 import Buffer
 import Process
+import Scanner (scan, runScanner, toChar)
+
 
 data VTConfig = VTConfig
     { withOutput :: IO () -> IO ()
@@ -84,14 +86,34 @@ uiThread :: VTConfig -> (VTState -> IO ()) -> IO VTState -> IO ()
 uiThread cf putState getState = forever $ do
     q0 <- getState
 
-    ((eitCmd, lns), q1) <- runVT cf q0 $ do
-        c <- getCommand (mode q0)
-        execCommand c
-        return c
+
+    _ <- hLookAhead stdin -- wait for input
+    --t0 <- getCurrentTime
+    -- ((res, s), _) <- runScanner scan
+    ((_, s), _) <- runScanner scan
+    --t1 <- getCurrentTime
+    --putStrLn $ "====> \ESC[32;1m" ++ show s ++ "\ESC[m in " ++
+    --            (show $ diffUTCTime t1 t0)
+    --            ++ ": \"\ESC[35m" ++ (concat $ map (colorize . toChar) s)
+    --            ++ "\ESC[m\""
+    --case res of
+    --    Left msg -> putStrLn $ "  error: " ++ msg
+    --    Right _ -> return ()
+
+    -- TODO don't leak C
+    let cmd = getCommand (mode q0) (map toChar s)
+
+    --withOutput cf $ do
+    --    putStrLn $ show cmd
+
+    ((_, lns), q1) <- runVT cf q0 (execCommand cmd)
 
     -- TODO only putState if it has changed (?)
     putState q1
 
+    -- XXX dummy for following legacy code
+    let eitCmd = Right cmd
+
     let mbErr = case eitCmd of
                   Left err -> Just err
                   Right c ->
@@ -438,112 +460,10 @@ instance  Show Mode  where
   show VerbatimMode = "verbatim"
 
 
-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) -> VT Command
-getCommandXXX keymap defCmd = do
-
-    -- wait for the first character
-    _ <- liftIO $ hLookAhead stdin
-
-    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")
-        liftIO $ forkIO $ do
-          rec keymap cmdRef candRef bufRef
-
-    watchDogThreadId <-
-        liftIO $ forkIO $ do
-          --putStrLn "watchdog activated"
-          threadDelay $ 1000 * 50 -- 50ms
-          --putStrLn "watchdog timeout"
-          killThread getCharThreadId
-          --putStrLn "watchdog killed getCharThread"
-          putMVar cmdRef Nothing -- continue main thread
-
-    mbCmd <- liftIO $ takeMVar cmdRef
-
-    liftIO $ killThread watchDogThreadId
-
-    cmd <- case mbCmd of
-        Just cmd -> return cmd
-        Nothing -> do
-            mbCmd2 <- liftIO $ readIORef candRef
-            case mbCmd2 of
-                Just cmd2 -> return cmd2
-                Nothing -> return defCmd
-
-    s <- liftIO $ readIORef bufRef
-
-    --clearLine
-    --putStrLn $ "\x1b[35;1m" ++ (show s) ++ " -> " ++ (show $ cmd s) ++ "\x1b[m"
-    return $ cmd s
-
-  where
-    rec :: Keymap
-        -> MVar (Maybe (String -> Command))
-        -> IORef (Maybe (String -> Command))
-        -> IORef String
-        -> IO ()
-    rec km cmdRef candRef bufRef = do
-        c <- getChar
-        -- TODO s <- atomicModifyIORef bufRef $ \s -> let s' = s++[c] in (s,s)
-        olds <- readIORef bufRef
-        let s = olds ++ [c]
-        writeIORef bufRef s
-
-        let km' = map (\(str,cmd) -> (tail str, cmd))
-                $ filter ((==c) . head . fst) km
-
-            -- direct and indirect candidates
-            (dc, ic) = partition (null . fst) km'
-
-        --clearLine
-        --putStrLn $ " s: " ++ show s
-        --putStrLn $ "ic: " ++ (show $ map snd ic)
-        --putStrLn $ "dc: " ++ (show $ map snd dc)
-
-        -- update candidate
-        if length dc == 1
-          then atomicWriteIORef candRef (Just $ const $ snd $ dc !! 0)
-          else atomicWriteIORef candRef Nothing
-
-        case length km' of
-          0 -> do
-            --return $ defCmd' (s ++ [c])
-            cand <- readIORef candRef
-            putMVar cmdRef cand
-          1 ->
-            let (rest, cmd) = km' !! 0
-            in if null rest
-                then do
-                  --return $ cmd
-                  -- TODO somehow give s?
-                  putMVar cmdRef (Just $ const cmd)
-                else do
-                  --rec (s ++ [c]) ic defCmd'
-                  rec ic cmdRef candRef bufRef
-          _ -> do
-            --rec (s ++ [c]) ic defCmd'
-            rec ic cmdRef candRef bufRef
-
-
-
-verbatimKeymap :: VT Command
-verbatimKeymap = do
-  c <- liftIO getChar
-  return $ InsertString [c] <> ChangeMode InsertMode
+getCommand :: Mode -> String -> Command
+getCommand InsertMode s = maybe (InsertString s) id $ lookup s imap
+getCommand NormalMode s = maybe (AlertBadInput s) id $ lookup s nmap
+getCommand VerbatimMode s = InsertString s <> ChangeMode InsertMode
 
 
 -- TODO Control.Monad.whenLeft
-- 
cgit v1.2.3