From 0313b0d68d364dc32bbe86446de50cf5d9175ab6 Mon Sep 17 00:00:00 2001
From: Lennart Spitzner <hexagoxel@hexagoxel.de>
Date: Mon, 12 Feb 2018 15:47:27 +0100
Subject: [PATCH] Improve completion behaviour

---
 src/UI/Butcher/Monadic/Interactive.hs | 41 +++++++++++++++------------
 1 file changed, 23 insertions(+), 18 deletions(-)

diff --git a/src/UI/Butcher/Monadic/Interactive.hs b/src/UI/Butcher/Monadic/Interactive.hs
index b2b9c7a..1583d64 100644
--- a/src/UI/Butcher/Monadic/Interactive.hs
+++ b/src/UI/Butcher/Monadic/Interactive.hs
@@ -30,30 +30,32 @@ 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) $ case choices of
-    [] -> ""
-    (c1:cr) ->
-      case
-          filter (\s -> List.all (s`isPrefixOf`) cr) $ reverse $ List.inits c1
-        of
-          []    -> ""
-          (x:_) -> x
+simpleCompletion line cdesc pcRest = List.drop (List.length lastWord)
+  $ longestCommonPrefix choices
  where
+  longestCommonPrefix [] = ""
+  longestCommonPrefix (c1:cr) =
+    case find (\s -> List.all (s `isPrefixOf`) cr) $ reverse $ List.inits c1 of
+      Nothing -> ""
+      Just x  -> x
   nameDesc = case _cmd_mParent cdesc of
-    Nothing                        -> cdesc
-    Just (_, parent) | null pcRest -> parent
-    Just{}                         -> cdesc
+    Nothing -> cdesc
+    Just (_, parent) | null pcRest && not (null lastWord) -> parent
+        -- not finished writing a command. if we have commands abc and abcdef,
+        -- we may want "def" as a completion after "abc".
+    Just{}  -> cdesc
   lastWord = reverse $ takeWhile (not . Char.isSpace) $ reverse $ line
   choices :: [String]
   choices = join
     [ [ r
       | (Just r, _) <- Data.Foldable.toList (_cmd_children nameDesc)
       , lastWord `isPrefixOf` r
+      , lastWord /= r
       ]
     , [ s
       | s <- partDescStrings =<< _cmd_parts nameDesc
       , lastWord `isPrefixOf` s
+      , lastWord /= s
       ]
     ]
 
@@ -71,21 +73,24 @@ shellCompletionWords
   -> [CompletionItem]
 shellCompletionWords line cdesc pcRest = choices
  where
-  _nameDesc = case _cmd_mParent cdesc of
-    Nothing                        -> cdesc
-    Just (_, parent) | null pcRest -> parent
-    Just{}                         -> cdesc
+  nameDesc = case _cmd_mParent cdesc of
+    Nothing -> cdesc
+    Just (_, parent) | null pcRest && not (null lastWord) -> parent
+        -- not finished writing a command. if we have commands abc and abcdef,
+        -- we may want "def" as a completion after "abc".
+    Just{}  -> cdesc
   lastWord = reverse $ takeWhile (not . Char.isSpace) $ reverse $ line
   choices :: [CompletionItem]
   choices = join
     [ [ CompletionString r
-      | (Just r, _) <- Data.Foldable.toList (_cmd_children cdesc)
+      | (Just r, _) <- Data.Foldable.toList (_cmd_children nameDesc)
       , lastWord `isPrefixOf` r
+      , lastWord /= r
       ]
     , [ c
       | c <- partDescCompletions =<< _cmd_parts cdesc
       , case c of
-        CompletionString s -> lastWord `isPrefixOf` s
+        CompletionString s -> lastWord `isPrefixOf` s && lastWord /= s
         _                  -> True
       ]
     ]