wip: switching from ncurses to brick

src/Mtlstats/Prompt.hs

@@ -19,11 +19,8 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 -}
 
-{-# LANGUAGE LambdaCase #-}
-
 module Mtlstats.Prompt (
   -- * Prompt Functions
-  drawPrompt,
   promptHandler,
   promptControllerWith,
   promptController,
@@ -51,14 +48,20 @@ module Mtlstats.Prompt (
   playerToEditPrompt
 ) where
 
+import Brick.Types (BrickEvent (VtyEvent), Location (Location), Widget)
+import Brick.Widgets.Core (hBox, showCursor, str)
 import Control.Monad (when)
 import Control.Monad.Extra (whenJust)
-import Control.Monad.Trans.State (gets, modify)
+import Control.Monad.State.Class (gets, modify)
 import Data.Char (isAlphaNum, isDigit, toUpper)
+import Graphics.Text.Width (safeWcswidth)
+import Graphics.Vty.Input.Events
+  ( Event (EvKey)
+  , Key (KChar, KEnter, KEsc, KFun)
+  )
 import Lens.Micro ((^.), (&), (.~), (?~), (%~))
-import Lens.Micro.Extras (view)
+import Lens.Micro.Mtl ((.=), use)
 import Text.Read (readMaybe)
-import qualified UI.NCurses as C
 
 import Mtlstats.Actions
 import Mtlstats.Config
@@ -66,41 +69,31 @@ import Mtlstats.Helpers.Position
 import Mtlstats.Types
 import Mtlstats.Util
 
--- | Draws the prompt to the screen
-drawPrompt :: Prompt -> ProgState -> C.Update C.CursorMode
-drawPrompt p s = do
-  promptDrawer p s
-  return C.CursorVisible
-
 -- | Event handler for a prompt
-promptHandler :: Prompt -> C.Event -> Action ()
-promptHandler p (C.EventCharacter '\n') = do
-  val <- gets $ view inputBuffer
-  modify $ inputBuffer .~ ""
+promptHandler :: Prompt -> Handler ()
+promptHandler p (VtyEvent (EvKey KEnter [])) = do
+  val <- use inputBuffer
+  inputBuffer .= ""
   promptAction p val
-promptHandler p (C.EventCharacter c) =
+promptHandler p (VtyEvent (EvKey (KChar c) [])) =
   modify $ inputBuffer %~ promptProcessChar p c
-promptHandler _ (C.EventSpecialKey C.KeyBackspace) =
+promptHandler _ (VtyEvent (EvKey KEsc [])) =
   modify removeChar
-promptHandler p (C.EventSpecialKey k) =
-  promptSpecialKey p k
+promptHandler p (VtyEvent (EvKey k m)) =
+  promptSpecialKey p k m
 promptHandler _ _ = return ()
 
 -- | Builds a controller out of a prompt with a header
 promptControllerWith
-  :: (ProgState -> C.Update ())
+  :: (ProgState -> Widget () -> Widget ())
   -- ^ The header
   -> Prompt
   -- ^ The prompt to use
   -> Controller
   -- ^ The resulting controller
 promptControllerWith header prompt = Controller
-  { drawController = \s -> do
-    header s
-    drawPrompt prompt s
-  , handleController = \e -> do
-    promptHandler prompt e
-    return True
+  { drawController   = \s -> header s $ drawPrompt prompt s
+  , handleController = promptHandler prompt
   }
 
 -- | Builds a controller out of a prompt
@@ -109,7 +102,7 @@ promptController
   -- ^ The prompt to use
   -> Controller
   -- ^ The resulting controller
-promptController = promptControllerWith (const $ return ())
+promptController = promptControllerWith $ const id
 
 -- | Builds a string prompt
 strPrompt
@@ -119,10 +112,10 @@ strPrompt
   -- ^ The callback function for the result
   -> Prompt
 strPrompt pStr act = Prompt
-  { promptDrawer      = drawSimplePrompt pStr
+  { drawPrompt        = drawSimplePrompt pStr
   , promptProcessChar = \ch -> (++ [ch])
   , promptAction      = act
-  , promptSpecialKey  = const $ return ()
+  , promptSpecialKey  = \_ _ -> return ()
   }
 
 -- | Creates an upper case string prompt
@@ -179,12 +172,12 @@ numPromptWithFallback
   -- ^ The callback function for the result
   -> Prompt
 numPromptWithFallback pStr fallback act = Prompt
-  { promptDrawer      = drawSimplePrompt pStr
-  , promptProcessChar = \ch str -> if isDigit ch
-    then str ++ [ch]
-    else str
+  { drawPrompt        = drawSimplePrompt pStr
+  , promptProcessChar = \ch existing -> if isDigit ch
+    then existing ++ [ch]
+    else existing
   , promptAction      = maybe fallback act . readMaybe
-  , promptSpecialKey  = const $ return ()
+  , promptSpecialKey  = \_ _ -> return ()
   }
 
 -- | Prompts for a database name
@@ -215,18 +208,21 @@ newSeasonPrompt = dbNamePrompt "Filename for new season: " $ \fn ->
 -- | Builds a selection prompt
 selectPrompt :: SelectParams a -> Prompt
 selectPrompt params = Prompt
-  { promptDrawer = \s -> do
-    let sStr = s^.inputBuffer
-    C.drawString $ spPrompt params ++ sStr
-    (row, col) <- C.cursorPosition
-    C.drawString $ "\n\n" ++ spSearchHeader params ++ "\n"
-    let results = zip [1..maxFunKeys] $ spSearch params sStr (s^.database)
-    C.drawString $ unlines $ map
+  { drawPrompt = \s -> let
+    sStr       = s^.inputBuffer
+    pStr       = spPrompt params ++ sStr
+    pWidth     = safeWcswidth pStr
+    results    = zip [1..maxFunKeys] $ spSearch params sStr (s^.database)
+    fmtRes     = map
       (\(n, (_, x)) -> let
         desc = spElemDesc params x
-        in "F" ++ show n ++ ") " ++ desc)
+        in str $ "F" ++ show n ++ ") " ++ desc)
       results
-    C.moveCursor row col
+    in hBox $
+      [ showCursor () (Location (0, pWidth)) $ str pStr
+      , str ""
+      , str $ spSearchHeader params
+      ] ++ fmtRes
   , promptProcessChar = spProcessChar params
   , promptAction = \sStr -> if null sStr
     then spCallback params Nothing
@@ -235,12 +231,12 @@ selectPrompt params = Prompt
       case spSearchExact params sStr db of
         Nothing -> spNotFound params sStr
         Just n  -> spCallback params $ Just n
-  , promptSpecialKey = \case
-    C.KeyFunction rawK -> do
-      sStr <- gets (^.inputBuffer)
-      db   <- gets (^.database)
+  , promptSpecialKey = \key _ -> case key of
+    KFun rawK -> do
+      sStr <- use inputBuffer
+      db   <- use database
       let
-        n       = pred $ fromInteger rawK
+        n       = pred rawK
         results = spSearch params sStr db
       when (n < maxFunKeys) $
         whenJust (nth n results) $ \(sel, _) -> do
@@ -406,5 +402,8 @@ playerToEditPrompt :: Prompt
 playerToEditPrompt = selectPlayerPrompt "Player to edit: " $
   modify . (progMode.editPlayerStateL.epsSelectedPlayer .~)
 
-drawSimplePrompt :: String -> ProgState -> C.Update ()
-drawSimplePrompt pStr s = C.drawString $ pStr ++ s^.inputBuffer
+drawSimplePrompt :: String -> Renderer
+drawSimplePrompt pStr s = let
+  fullStr  = pStr ++ s^.inputBuffer
+  strWidth = safeWcswidth fullStr
+  in showCursor () (Location (0, strWidth)) $ str fullStr