From 6744136708730e4b094a34a43a79019a017c04fc Mon Sep 17 00:00:00 2001 From: adamrk Date: Sun, 28 May 2017 23:44:26 -0400 Subject: [PATCH 1/4] add printCompletions to print below the input line --- src/BC/Prompt.hs | 18 +++++++++++++++++- 1 file changed, 17 insertions(+), 1 deletion(-) diff --git a/src/BC/Prompt.hs b/src/BC/Prompt.hs index c15b166..54023d9 100644 --- a/src/BC/Prompt.hs +++ b/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,17 @@ printStatus state str = truncLen s = if length s > 20 then take 20 s ++ "..." else s +printCompletions :: State -> String -> IO () +printCompletions state str = + let completions = "" -- TODO: get possible completions + toPrint = "\n\x1b[32m" -- color to green + ++ replicate (length promptStr) ' ' + ++ completions + ++ "\x1b[0m\r\x1b[A" -- color to white, move to prev line + in do putStr toPrint + putStr $ concat $ replicate (length promptStr + length str) "\x1b[C" + + cleanPrompt :: IO () cleanPrompt = putStr "\x1b[2K\r" @@ -135,6 +148,9 @@ readline state = read' "" 0 '\x1b' -> do (pos, nacc, newpstate) <- readSpecialKey pos acc pstate read' nacc (clamp pos 0 (length acc)) newpstate + '\t' -> do + printCompletions state acc + read' acc pos pstate c -> if isPrint c then do From a7a06a7684dc4b0c3a5de0b7f50a9b946f957007 Mon Sep 17 00:00:00 2001 From: adamrk Date: Mon, 29 May 2017 00:20:40 -0400 Subject: [PATCH 2/4] fix bug caused by incomplete pattern in precedence function typing in a string like "4 + sqrt(5)" would cause a crash because in the middle of typing "sqrt" the evaluator would treat 's' as an operator and try to compare it's precedence to the precedence of '+'. The precedence function did not match all patterns and this adds an otherwise case. --- src/BC/Types.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/BC/Types.hs b/src/BC/Types.hs index 9f10a18..1e5197f 100644 --- a/src/BC/Types.hs +++ b/src/BC/Types.hs @@ -103,6 +103,7 @@ precedence "<=" = 2 precedence ">=" = 2 precedence "==" = 2 precedence "!=" = 2 +precedence _ = 6 contains :: Eq a => [a] -> a -> Bool From 5b9f0abeb5f8780f75014e1589c077a3c61e416c Mon Sep 17 00:00:00 2001 From: adamrk Date: Mon, 29 May 2017 00:26:46 -0400 Subject: [PATCH 3/4] add tab completion by displaying functions matching prefix Added a function to State which returns a list of all defined values/functions matching a prefix. Modify the tab printout to display 5 of these results. --- src/BC/Prompt.hs | 8 ++++++-- src/BC/State.hs | 5 +++++ 2 files changed, 11 insertions(+), 2 deletions(-) diff --git a/src/BC/Prompt.hs b/src/BC/Prompt.hs index 54023d9..5b4b1dc 100644 --- a/src/BC/Prompt.hs +++ b/src/BC/Prompt.hs @@ -80,10 +80,14 @@ printStatus state str = printCompletions :: State -> String -> IO () printCompletions state str = - let completions = "" -- TODO: get possible completions + let tokens = words str + completions = if tokens == [] + then [] + else getCompletions (last tokens) state + compString = intercalate " " $ take 5 completions toPrint = "\n\x1b[32m" -- color to green ++ replicate (length promptStr) ' ' - ++ completions + ++ compString ++ "\x1b[0m\r\x1b[A" -- color to white, move to prev line in do putStr toPrint putStr $ concat $ replicate (length promptStr + length str) "\x1b[C" diff --git a/src/BC/State.hs b/src/BC/State.hs index a3e6764..1b31680 100644 --- a/src/BC/State.hs +++ b/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) \ No newline at end of file From be3df4e22a7e6cc16b98e0db0d948ddc73178d3b Mon Sep 17 00:00:00 2001 From: adamrk Date: Mon, 29 May 2017 13:43:57 -0400 Subject: [PATCH 4/4] modify tab to complete word when there is only one completion --- src/BC/Prompt.hs | 34 +++++++++++++++++++++++++--------- 1 file changed, 25 insertions(+), 9 deletions(-) diff --git a/src/BC/Prompt.hs b/src/BC/Prompt.hs index 5b4b1dc..a82336a 100644 --- a/src/BC/Prompt.hs +++ b/src/BC/Prompt.hs @@ -78,19 +78,35 @@ printStatus state str = truncLen s = if length s > 20 then take 20 s ++ "..." else s -printCompletions :: State -> String -> IO () -printCompletions state str = - let tokens = words str +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 - compString = intercalate " " $ take 5 completions - toPrint = "\n\x1b[32m" -- color to green + 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 do putStr toPrint - putStr $ concat $ replicate (length promptStr + length str) "\x1b[C" + in putStr toPrint cleanPrompt :: IO () @@ -153,8 +169,8 @@ readline state = read' "" 0 (pos, nacc, newpstate) <- readSpecialKey pos acc pstate read' nacc (clamp pos 0 (length acc)) newpstate '\t' -> do - printCompletions state acc - read' acc pos pstate + (newAcc, newPos) <- tabComplete acc pos state + read' newAcc newPos pstate c -> if isPrint c then do