Context.hs

{-# LANGUAGE OverloadedStrings #-}

module GHCup.Brick.Widgets.Menus.Context (ContextMenu, create, draw, handler) where

import Brick (
  Widget (..), BrickEvent, EventM,
 )
import Data.Function ((&))
import Prelude hiding (appendFile)

import Data.Versions (prettyVer)
import GHCup.Command.List ( ListResult(..) )
import GHCup.Types (Tool (..), ToolDescription(..))

import qualified GHCup.Brick.Common as Common
import qualified GHCup.Brick.Widgets.Menu as Menu
import GHCup.Brick.Common (Name (..))
import GHCup.Brick.Widgets.Menu (Menu, MenuKeyBindings)
import qualified Brick.Widgets.Core as Brick
import qualified Brick.Widgets.Border as Border
import qualified Brick.Focus as F
import Brick.Widgets.Core ((<+>))

import Optics (to, _1, _2)
import Optics.Operators ((.~), (^.))
import Optics.Optic ((%))
import Data.Foldable (foldl')
import qualified Data.Text as T

type ContextMenu = Menu (Tool, (Maybe ToolDescription, ListResult)) Name

create :: (Tool, (Maybe ToolDescription, ListResult)) -> MenuKeyBindings -> ContextMenu
create (tool, (td, lr)) keyBindings = Menu.createMenu Common.ContextBox (tool, (td, lr)) "" validator keyBindings buttons []
 where
  advInstallButton =
    Menu.createButtonField (MenuElement Common.AdvancedInstallButton)
      & Menu.fieldLabelL .~ "Install"
      & Menu.fieldHelpMsgL .~ "Advanced Installation Settings"
  compileGhcButton =
    Menu.createButtonField (MenuElement Common.CompileGHCButton)
      & Menu.fieldLabelL .~ "Compile"
      & Menu.fieldHelpMsgL .~ "Compile GHC from source"
  compileHLSButton =
    Menu.createButtonField (MenuElement Common.CompileHLSButton)
      & Menu.fieldLabelL .~ "Compile"
      & Menu.fieldHelpMsgL .~ "Compile HLS from source"
  buttons =
    case tool of
      Tool "ghc" -> [advInstallButton, compileGhcButton]
      Tool "hls" -> [advInstallButton, compileHLSButton]
      _ -> [advInstallButton]
  validator = const Nothing

draw :: ContextMenu -> Widget Name
draw menu =
  Common.frontwardLayer
    ("Context Menu for " <> tool_str <> " " <> prettyVer (menu ^. Menu.menuStateL % _2 % _2 % to lVer))
    $ Brick.vBox
        [ Brick.vBox buttonWidgets
        , Brick.txt " "
        , Brick.padRight Brick.Max $
            Brick.txt "Press "
            <+> Common.keyToWidget (menu ^. Menu.menuKeyBindingsL % Menu.mKbQuitL)
            <+> Brick.txt " to go back"
        ]
  where
    buttonLabels = [button & Menu.fieldLabel | button <- menu ^. Menu.menuButtonsL]
    maxWidth = foldl' max 5 (fmap Brick.textWidth buttonLabels)

    buttonAmplifiers =
      let buttonAsWidgets = fmap Menu.renderAslabel buttonLabels
       in fmap (\f b -> ((Menu.leftify (maxWidth + 10) . Border.border $ f b) <+>) ) buttonAsWidgets
    drawButtons = fmap Menu.drawField buttonAmplifiers
    buttonWidgets = zipWith (F.withFocusRing (menu ^. Menu.menuFocusRingL)) drawButtons (menu ^. Menu.menuButtonsL)
    tool_str =
      case menu ^. Menu.menuStateL % _1 of
        Tool "ghc" -> "GHC"
        Tool "ghcup" -> "GHCup"
        Tool "cabal" -> "Cabal"
        Tool "hls" -> "HLS"
        Tool "stack" -> "Stack"
        Tool t -> T.pack t

handler :: BrickEvent Name e -> EventM Name ContextMenu ()
handler = Menu.handlerMenu