Tweak terminal tab completion

src/Dodge/Terminal.hs

@@ -1,11 +1,12 @@
 {-# LANGUAGE LambdaCase #-}
+
 module Dodge.Terminal (
---    doTerminalCommandEffect,
+    --    doTerminalCommandEffect,
     makeTermLine,
---    commandFutureLines,
---    quitCommand,
---    helpCommand,
---    commandsCommand,
+    --    commandFutureLines,
+    --    quitCommand,
+    --    helpCommand,
+    --    commandsCommand,
     connectionBlurbLines,
     disconnectTerminal,
     basicTerminal,
@@ -22,14 +23,15 @@ module Dodge.Terminal (
     tabComplete,
 ) where
 
-import qualified Data.ListTrie.Patricia.Map.Enum as PTE
 --import Dodge.Data.WorldEffect
-import Dodge.Data.Terminal.Status
+
 import Color
+import qualified Data.ListTrie.Patricia.Map.Enum as PTE
 --import Control.Monad
 --import Data.Char
 --import qualified Data.Map.Strict as M
 import Data.Maybe
+import Dodge.Data.Terminal.Status
 import Dodge.Data.World
 import Dodge.Default
 import Dodge.SoundLogic
@@ -52,7 +54,8 @@ connectionBlurbLines tls =
     , TLine 0 [TerminalLineConst "LOADING TEXT INTERFACE..." termTextColor] TmWdId
     ]
         ++ tls
-       ++ [ TLine 10 [TerminalLineConst "READY FOR INPUT" termTextColor] (TmTmSetStatus (TerminalTextInput ""))]
+        ++ [TLine 10 [TerminalLineConst "READY FOR INPUT" termTextColor] (TmTmSetStatus (TerminalTextInput ""))]
+
 --        ++ [TerminalLineEffect 0 (TmTmSetStatus (TerminalTextInput "" 0))]
 
 --quitCommand :: TerminalCommand
@@ -121,10 +124,13 @@ helpCommand :: PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine])
 helpCommand = PTE.singleton "HELP" (fmap makeTermPara helpStrings)
 
 helpStrings :: PTE.TrieMap Char String
-helpStrings = PTE.fromList
-    [("", "THIS TERMINAL PROCESSES TEXT INPUT. USE TAB FOR AVAILABLE COMMANDS AND AUTOCOMPLETE.")
-    ,("HELP", "BASIC HELP. ACCEPTS A COMMAND AS AN ARGUMENT.")
-    ]
+helpStrings =
+    PTE.fromList
+        [ ("", "THIS TERMINAL PROCESSES TEXT INPUT. USE TAB FOR AVAILABLE COMMANDS AND AUTOCOMPLETE.")
+        , ("HELP", "BASIC HELP. ACCEPTS A COMMAND AS AN ARGUMENT.")
+        , ("QUIT", "SHUTDOWN TERMINAL.")
+        , ("QTEST", "TEST.")
+        ]
 
 --commandsCommand :: PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine])
 --commandsCommand = PTE.singleton "COMMANDS" (PTE.singleton "" [TLine 0 [] TmDisplayCommands])
@@ -147,13 +153,29 @@ makeColorTermLine col str = TLine 1 [TerminalLineConst str col] TmWdId
 commandColor :: Color
 commandColor = yellow
 
+-- ugly
 tabComplete :: String -> Terminal -> Terminal
-tabComplete s tm = case fmap fst $ PTE.toList $ PTE.lookupPrefix s $ getCommands tm of
-    [] -> tm
-    [x] -> tm & tmStatus .~ TerminalTextInput x
-    xs -> tm & tmFutureLines .~ 
-            makeColorTermPara commandColor 
-                (unwords xs)
+tabComplete s' tm = case PTE.lookup s $ getCommands tm of
+    Just m -> case fmap fst $ PTE.toList $ PTE.lookupPrefix a m of
+        [] -> tm
+        [x] -> tm & tmStatus .~ TerminalTextInput (s ++ " " ++ x)
+        xs ->
+            tm & tmFutureLines
+                .~ makeColorTermPara
+                    commandColor
+                    (unwords xs)
+    Nothing -> case fmap fst $ PTE.toList $ PTE.lookupPrefix s $ getCommands tm of
+        [] -> tm
+        [x] -> tm & tmStatus .~ TerminalTextInput x
+        xs ->
+            tm & tmFutureLines
+                .~ makeColorTermPara
+                    commandColor
+                    (unwords xs)
+  where
+    ss = words s'
+    s = fromMaybe "" $ ss ^? ix 0
+    a = fromMaybe "" $ ss ^? ix 1
 
 --doTerminalCommandEffect :: TerminalCommandEffect -> Terminal -> World -> EffectArguments
 --doTerminalCommandEffect tce = case tce of
@@ -298,20 +320,20 @@ simpleTermMessage strs = defaultTerminal & tmBootLines .~ map makeTermLine strs
 
 terminalReturnEffect :: Int -> World -> World
 terminalReturnEffect tmid w = fromMaybe w $ do
-    tm <- w ^? cWorld . lWorld . terminals. ix tmid
+    tm <- w ^? cWorld . lWorld . terminals . ix tmid
     s <- tm ^? tmStatus . tiText
     return $
         runTerminalInput s tm $
             w
                 & cWorld . lWorld . terminals . ix tmid . tmDisplayedLines
-                    .:~ (getPromptTM ++ s,termTextColor)
+                    .:~ (getPromptTM ++ s, termTextColor)
 
 runTerminalInput :: String -> Terminal -> World -> World
 runTerminalInput s tm w =
     w & cWorld . lWorld . terminals . ix (_tmID tm)
         %~ ( --(tmInput .~ TerminalInput{ _tiSel = (0, 0)})
-                 
-                 (tmFutureLines ++.~ ss)
+
+             (tmFutureLines ++.~ ss)
                 . (tmCommandHistory %~ take 10 . (s :))
                 . (tmStatus .~ TerminalTextInput "")
            )