Merge pull request #1 from adamrk/tab_completion

Tab completion

src/BC/Prompt.hs

@@ -50,11 +50,13 @@ output state out =
     let res = parse out
     in if length res == 1 && isErr (head res)
       then do
+        cleanPrompt
         print (head res)
         return state
       else
         let (ret, newstate) = eval state res
-        in do putStrLn $ returnStr ++ show ret
+        in do cleanPrompt
+              putStrLn $ returnStr ++ show ret
               return newstate
 
 
@@ -76,6 +78,37 @@ printStatus state str =
         truncLen s = if length s > 20 then take 20 s ++ "..." else s
 
 
+tabComplete :: String -> Int -> State -> IO (String, Int)
+tabComplete str pos state = 
+  let tokens = words $ take pos str
+      completions = if tokens == []
+                    then []
+                    else getCompletions (last tokens) state
+  in case completions of
+    cs@(_:_:_) -> do
+      printCompletions cs
+      putStr $ concat $ replicate (length promptStr + pos) "\x1b[C"
+      -- ^ shift cursor right to current position
+      return (str, pos)
+    x:_ -> let diff = drop (length $ last tokens) x
+           in  do
+             putStr diff
+             return (take pos str ++ diff ++ drop pos str, pos + length diff)
+    _ -> return (str, pos)
+
+
+printCompletions :: [String] -> IO ()
+printCompletions cs =
+  let compString = intercalate "  " $ take 5 cs -- only list 5 matches
+      toPrint = "\n"
+              ++ "\x1b[2K\r" -- clear completion line
+              ++ "\x1b[32m" -- color to green
+              ++ replicate (length promptStr) ' '
+              ++ compString
+              ++ "\x1b[0m\r\x1b[A" -- color to white, move to prev line
+  in putStr toPrint
+
+
 cleanPrompt :: IO ()
 cleanPrompt = putStr "\x1b[2K\r"
 
@@ -135,6 +168,9 @@ readline state = read' "" 0
             '\x1b' -> do
               (pos, nacc, newpstate) <- readSpecialKey pos acc pstate
               read' nacc (clamp pos 0 (length acc)) newpstate
+            '\t' -> do
+              (newAcc, newPos) <- tabComplete acc pos state
+              read' newAcc newPos pstate
             c      ->
               if isPrint c
                 then do

src/BC/State.hs

@@ -9,3 +9,8 @@ type State = Map String Value
 
 newState :: State
 newState = fromList primitives
+
+getCompletions :: String -> State -> [String]
+getCompletions s = foldWithKey addKey []
+  where addKey k _ ks = if isPrefix s k then k:ks else ks
+        isPrefix s1 s2 = length s2 >= length s1 && (all id $ zipWith (==) s1 s2) 

src/BC/Types.hs

@@ -103,6 +103,7 @@ precedence "<=" = 2
 precedence ">=" = 2
 precedence "==" = 2
 precedence "!=" = 2
+precedence _ = 6
 
 
 contains :: Eq a => [a] -> a -> Bool