Move towards implementing terminal autocomplete

src/Dodge/Update/Scroll.hs

@@ -1,7 +1,10 @@
+{-# LANGUAGE TupleSections #-}
 module Dodge.Update.Scroll (
     updateWheelEvent,
 ) where
 
+import Control.Applicative
+import qualified Data.ListTrie.Patricia.Map.Enum as PTE
 import Dodge.Data.Terminal.Status
 import Dodge.Data.EquipType
 import Padding
@@ -123,16 +126,34 @@ moveCombineSel yi =
         return $ ci & ciSelection %~ scrollSelectionSections yi sss
 
 terminalWheelEvent :: Int -> Int -> World -> World
---terminalWheelEvent yi tmid w
-terminalWheelEvent _ tmid w
+terminalWheelEvent yi tmid w
     | w & has (input . mouseButtons . ix ButtonRight)
       , Just TerminalTextInput{} <- w ^? cWorld . lWorld . terminals . ix tmid . tmStatus =
-        w -- & cWorld . lWorld . terminals . ix tmid %~ updatetermsubsel
+        w & cWorld . lWorld . terminals . ix tmid %~ g
     | Just TerminalTextInput{} <- w ^? cWorld . lWorld . terminals . ix tmid . tmStatus =
-        w -- & cWorld . lWorld . terminals . ix tmid %~ updatetermsel
+        w & cWorld . lWorld . terminals . ix tmid %~ f
     | otherwise = w
   where
---    updatetermsel tm = case tm ^? tmInput . tiSel of
+    dowrap = if yi > 0 then wrapup else wrapdown
+    wrapup s coms = PTE.findSuccessor s coms <|> PTE.findMin coms
+    wrapdown s coms = PTE.findPredecessor s coms <|> PTE.findMax coms
+    f tm = fromMaybe tm $ do
+        let coms = getCommands tm
+        x <- tm ^? tmStatus . tiText 
+        let s = fromMaybe "" $ x ^? to words . ix 0
+        (s',_) <- dowrap s coms
+        return $ tm & tmStatus . tiText .~ s'
+    g tm = fromMaybe tm $ do
+        let coms = getCommands tm
+        x <- tm ^? tmStatus . tiText
+        let s = fromMaybe "" $ x ^? to words . ix 0
+            y = fromMaybe "" $ x ^? to words . ix 1
+--        (s',m) <- fmap (s,) (PTE.lookup s coms) <|> dowrap s coms
+--        (arg,_) <- dowrap y m
+        (s',arg,_) <- if yi > 0 then doubleFindSucc s y coms <|> doubleFindMin coms
+            else doubleFindPred s y coms <|> doubleFindMax coms
+        return $ tm & tmStatus . tiText .~ s' ++ " " ++ arg
+    --case tm ^? tmInput . tiSel of
 --        Nothing -> tm & tmInput . tiSel .~ (0, 0)
 --        Just (i, _) ->
 --            let newi = (i - yi) `mod` length (scrollCommandStrings w tm)
@@ -151,6 +172,47 @@ terminalWheelEvent _ tmid w
 --        tc = scrollCommands tm !! i
 --        arg = getArguments' tc tm w !! j
 
+doubleFindMin :: (Enum a,Enum b) => PTE.TrieMap a (PTE.TrieMap b c) -> Maybe ([a],[b],c)
+doubleFindMin m = do
+    (x,n) <- PTE.findMin m
+    case PTE.findMin n of
+        Just (y,z) -> Just (x,y,z)
+        Nothing -> Nothing
+
+doubleFindSucc :: (Enum a,Enum b) => [a] -> [b] -> PTE.TrieMap a (PTE.TrieMap b c) -> Maybe ([a],[b],c)
+doubleFindSucc xs ys m = case PTE.lookup xs m of
+    Just m' -> case PTE.findSuccessor ys m' of
+        Just (ys',z) -> Just (xs,ys',z)
+        Nothing -> dfs xs m
+    Nothing -> dfs xs m
+  where
+    dfs xs' m' = case PTE.findSuccessor xs' m' of
+        Just (xs'',n) -> case PTE.findMin n of
+            Just (ys',z) -> Just (xs'',ys',z)
+            Nothing -> dfs xs'' m'
+        Nothing -> Nothing
+
+-- there are edge cases where this doesn't behave as might be expected
+doubleFindMax :: (Enum a,Enum b) => PTE.TrieMap a (PTE.TrieMap b c) -> Maybe ([a],[b],c)
+doubleFindMax m = do
+    (x,n) <- PTE.findMax m
+    case PTE.findMax n of
+        Just (y,z) -> Just (x,y,z)
+        Nothing -> Nothing
+
+doubleFindPred :: (Enum a,Enum b) => [a] -> [b] -> PTE.TrieMap a (PTE.TrieMap b c) -> Maybe ([a],[b],c)
+doubleFindPred xs ys m = case PTE.lookup xs m of
+    Just m' -> case PTE.findPredecessor ys m' of
+        Just (ys',z) -> Just (xs,ys',z)
+        Nothing -> dfs xs m
+    Nothing -> dfs xs m
+  where
+    dfs xs' m' = case PTE.findPredecessor xs' m' of
+        Just (xs'',n) -> case PTE.findMax n of
+            Just (ys',z) -> Just (xs'',ys',z)
+            Nothing -> dfs xs'' m'
+        Nothing -> Nothing
+
 scrollRBOption :: Int -> Int -> Int -> Int
 scrollRBOption dy ymax
     | dy < 0 = min (ymax -1) . subtract dy
@@ -177,7 +239,7 @@ scrollRBOption dy ymax
 --        , _tcEffect = TerminalCommandEffectNone -- \_ _ -> NoArguments []
 --        }
 
-getArguments :: TerminalCommand -> Terminal -> World -> [String]
-getArguments tc tm w = case doTerminalCommandEffect (_tcEffect tc) tm w of
-    NoArguments{} -> []
-    OneArgument _ m -> map (' ' :) $ M.keys m
+--getArguments :: TerminalCommand -> Terminal -> World -> [String]
+--getArguments tc tm w = case doTerminalCommandEffect (_tcEffect tc) tm w of
+--    NoArguments{} -> []
+--    OneArgument _ m -> map (' ' :) $ M.keys m