diff --git a/src-tests/TestMain.hs b/src-tests/TestMain.hs index cd2dc18..edf8a35 100644 --- a/src-tests/TestMain.hs +++ b/src-tests/TestMain.hs @@ -121,7 +121,7 @@ simpleRunTest = do describe "completions" $ do it "case 1" $ testCompletion completionTestCmd "" `shouldBe` "" it "case 2" $ testCompletion completionTestCmd "a" `shouldBe` "bc" - it "case 3" $ testCompletion completionTestCmd "abc" `shouldBe` "def" + it "case 3" $ testCompletion completionTestCmd "abc" `shouldBe` "" it "case 4" $ testCompletion completionTestCmd "abc " `shouldBe` "-" it "case 5" $ testCompletion completionTestCmd "abc -" `shouldBe` "" it "case 6" $ testCompletion completionTestCmd "abc --" `shouldBe` "flag" diff --git a/src/UI/Butcher/Monadic/Interactive.hs b/src/UI/Butcher/Monadic/Interactive.hs index 1583d64..77025b5 100644 --- a/src/UI/Butcher/Monadic/Interactive.hs +++ b/src/UI/Butcher/Monadic/Interactive.hs @@ -30,11 +30,18 @@ simpleCompletion -- subcommand. See 'UI.Butcher.Monadic.runCmdParserExt'. -> String -- ^ completion, i.e. a string that might be appended -- to the current prompt when user presses tab. -simpleCompletion line cdesc pcRest = List.drop (List.length lastWord) - $ longestCommonPrefix choices +simpleCompletion line cdesc pcRest = case reverse line of + [] -> compl + ' ' : _ -> compl + _ | null pcRest -> "" -- necessary to prevent subcommand completion + -- appearing before space that is, if you have command + -- "aaa" with subcommand "sss", we want completion + -- "sss" on "aaa " but not on "aaa". + _ -> compl where + compl = List.drop (List.length lastWord) (longestCommonPrefix choices) longestCommonPrefix [] = "" - longestCommonPrefix (c1:cr) = + longestCommonPrefix (c1 : cr) = case find (\s -> List.all (s `isPrefixOf`) cr) $ reverse $ List.inits c1 of Nothing -> "" Just x -> x