From 59f1f083500dee3eeba465ac8aecdcc9986d5a2b Mon Sep 17 00:00:00 2001
From: tv <tv@shackspace.de>
Date: Mon, 28 Jul 2014 00:32:00 +0200
Subject: s/getMappedCommand/getCommandXXX/ ^_^

---
 Main.hs | 117 ++++++++++++++++++++++++++++++++++++++++++++++++++++------------
 1 file changed, 95 insertions(+), 22 deletions(-)

(limited to 'Main.hs')

diff --git a/Main.hs b/Main.hs
index 75af792..4a794a4 100644
--- a/Main.hs
+++ b/Main.hs
@@ -392,32 +392,105 @@ instance  Show Mode  where
 
 
 getCommand :: Mode -> IO Command
-getCommand InsertMode = getMappedCommand imap (InsertString . (:[]))
-getCommand NormalMode = getMappedCommand nmap (AlertBadInput . (:[]))
+getCommand InsertMode = getCommandXXX imap InsertString
+getCommand NormalMode = getCommandXXX nmap AlertBadInput
 getCommand VerbatimMode = verbatimKeymap
 
 
-getMappedCommand :: Keymap -> (Char -> Command) -> IO Command
-getMappedCommand xs defCmd = do
-    c <- getChar
-    if any (isPrefixOf [c] . fst) xs
-      then rec [c]
-      else
-        if isPrint c
-          then return $ defCmd c
-          else return $ AlertBadInput [c]
+-- TODO refactor me please^_^
+getCommandXXX :: Keymap -> (String -> Command) -> IO Command
+getCommandXXX keymap defCmd = do
+
+    -- wait for the first character
+    c <- hLookAhead stdin
+
+    bufRef <- newIORef ""
+    candRef <- newIORef Nothing
+    cmdRef <- 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
+          rec keymap cmdRef candRef bufRef
+
+    watchDogThreadId <-
+        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 <- takeMVar cmdRef
+
+    killThread watchDogThreadId
+
+    cmd <- case mbCmd of
+        Just cmd -> return cmd
+        Nothing -> do
+            mbCmd2 <- readIORef candRef
+            case mbCmd2 of
+                Just cmd2 -> return cmd2
+                Nothing -> return defCmd
+
+    s <- readIORef bufRef
+
+    --clearLine
+    --putStrLn $ "\x1b[35;1m" ++ (show s) ++ " -> " ++ (show $ cmd s) ++ "\x1b[m"
+    return $ cmd s
+
   where
-    rec :: String -> IO Command
-    rec s =
-      case lookup s xs of
-        Just c -> return c
-        _ ->
-          if any (isPrefixOf s . fst) xs
-            then do
-              c <- getChar
-              rec $ s ++ [c]
-            else
-              return $ AlertBadInput s
+    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 :: IO Command
-- 
cgit v1.2.3