{-# 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.List ( ListResult(..) )
import GHCup.Types (Tool (..))

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)
import Optics.Operators ((.~), (^.))
import Optics.Optic ((%))
import Data.Foldable (foldl')

type ContextMenu = Menu ListResult Name

create :: ListResult -> MenuKeyBindings -> ContextMenu
create :: ListResult -> MenuKeyBindings -> ContextMenu
create ListResult
lr MenuKeyBindings
keyBindings = Name
-> ListResult
-> Text
-> (ListResult -> Maybe Text)
-> MenuKeyBindings
-> [Button ListResult Name]
-> [Button ListResult Name]
-> ContextMenu
forall n s.
n
-> s
-> Text
-> (s -> Maybe Text)
-> MenuKeyBindings
-> [Button s n]
-> [Button s n]
-> Menu s n
Menu.createMenu Name
Common.ContextBox ListResult
lr Text
"" ListResult -> Maybe Text
forall {b} {a}. b -> Maybe a
validator MenuKeyBindings
keyBindings [Button ListResult Name]
forall {s}. [MenuField s Name]
buttons []
 where
  advInstallButton :: MenuField s Name
advInstallButton =
    Name -> MenuField s Name
forall n s. n -> Button s n
Menu.createButtonField (ResourceId -> Name
MenuElement ResourceId
Common.AdvanceInstallButton)
      MenuField s Name
-> (MenuField s Name -> MenuField s Name) -> MenuField s Name
forall a b. a -> (a -> b) -> b
& Lens' (MenuField s Name) Text
forall s n. Lens' (MenuField s n) Text
Menu.fieldLabelL Lens' (MenuField s Name) Text
-> Text -> MenuField s Name -> MenuField s Name
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Text
"Install"
      MenuField s Name
-> (MenuField s Name -> MenuField s Name) -> MenuField s Name
forall a b. a -> (a -> b) -> b
& Lens' (MenuField s Name) Text
forall s n. Lens' (MenuField s n) Text
Menu.fieldHelpMsgL Lens' (MenuField s Name) Text
-> Text -> MenuField s Name -> MenuField s Name
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Text
"Advance Installation Settings"
  compileGhcButton :: MenuField s Name
compileGhcButton =
    Name -> MenuField s Name
forall n s. n -> Button s n
Menu.createButtonField (ResourceId -> Name
MenuElement ResourceId
Common.CompileGHCButton)
      MenuField s Name
-> (MenuField s Name -> MenuField s Name) -> MenuField s Name
forall a b. a -> (a -> b) -> b
& Lens' (MenuField s Name) Text
forall s n. Lens' (MenuField s n) Text
Menu.fieldLabelL Lens' (MenuField s Name) Text
-> Text -> MenuField s Name -> MenuField s Name
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Text
"Compile"
      MenuField s Name
-> (MenuField s Name -> MenuField s Name) -> MenuField s Name
forall a b. a -> (a -> b) -> b
& Lens' (MenuField s Name) Text
forall s n. Lens' (MenuField s n) Text
Menu.fieldHelpMsgL Lens' (MenuField s Name) Text
-> Text -> MenuField s Name -> MenuField s Name
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Text
"Compile GHC from source"
  compileHLSButton :: MenuField s Name
compileHLSButton =
    Name -> MenuField s Name
forall n s. n -> Button s n
Menu.createButtonField (ResourceId -> Name
MenuElement ResourceId
Common.CompileHLSButton)
      MenuField s Name
-> (MenuField s Name -> MenuField s Name) -> MenuField s Name
forall a b. a -> (a -> b) -> b
& Lens' (MenuField s Name) Text
forall s n. Lens' (MenuField s n) Text
Menu.fieldLabelL Lens' (MenuField s Name) Text
-> Text -> MenuField s Name -> MenuField s Name
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Text
"Compile"
      MenuField s Name
-> (MenuField s Name -> MenuField s Name) -> MenuField s Name
forall a b. a -> (a -> b) -> b
& Lens' (MenuField s Name) Text
forall s n. Lens' (MenuField s n) Text
Menu.fieldHelpMsgL Lens' (MenuField s Name) Text
-> Text -> MenuField s Name -> MenuField s Name
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Text
"Compile HLS from source"
  buttons :: [MenuField s Name]
buttons =
    case ListResult -> Tool
lTool ListResult
lr of
      Tool
GHC -> [MenuField s Name
forall {s}. MenuField s Name
advInstallButton, MenuField s Name
forall {s}. MenuField s Name
compileGhcButton]
      Tool
HLS -> [MenuField s Name
forall {s}. MenuField s Name
advInstallButton, MenuField s Name
forall {s}. MenuField s Name
compileHLSButton]
      Tool
_ -> [MenuField s Name
forall {s}. MenuField s Name
advInstallButton]
  validator :: b -> Maybe a
validator = Maybe a -> b -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing

draw :: ContextMenu -> Widget Name
draw :: ContextMenu -> Widget Name
draw ContextMenu
menu =
  Text -> Widget Name -> Widget Name
forall n. Text -> Widget n -> Widget n
Common.frontwardLayer
    (Text
"Context Menu for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tool_str Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Version -> Text
prettyVer (ListResult -> Version
lVer (ListResult -> Version) -> ListResult -> Version
forall a b. (a -> b) -> a -> b
$ ContextMenu
menu ContextMenu
-> Optic' A_Lens NoIx ContextMenu ListResult -> ListResult
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx ContextMenu ListResult
forall s n. Lens' (Menu s n) s
Menu.menuStateL))
    (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
Brick.vBox
        [ [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
Brick.vBox [Widget Name]
buttonWidgets
        , Text -> Widget Name
forall n. Text -> Widget n
Brick.txt Text
" "
        , Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
Brick.padRight Padding
Brick.Max (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
            Text -> Widget Name
forall n. Text -> Widget n
Brick.txt Text
"Press "
            Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> KeyCombination -> Widget Name
forall n. KeyCombination -> Widget n
Common.keyToWidget (ContextMenu
menu ContextMenu
-> Optic' A_Lens NoIx ContextMenu KeyCombination -> KeyCombination
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Lens' ContextMenu MenuKeyBindings
forall s n. Lens' (Menu s n) MenuKeyBindings
Menu.menuKeyBindingsL Lens' ContextMenu MenuKeyBindings
-> Optic
     A_Lens
     NoIx
     MenuKeyBindings
     MenuKeyBindings
     KeyCombination
     KeyCombination
-> Optic' A_Lens NoIx ContextMenu KeyCombination
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  MenuKeyBindings
  MenuKeyBindings
  KeyCombination
  KeyCombination
Menu.mKbQuitL)
            Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> Text -> Widget Name
forall n. Text -> Widget n
Brick.txt Text
" to go back"
        ]
  where
    buttonLabels :: [Text]
buttonLabels = [Button ListResult Name
button Button ListResult Name -> (Button ListResult Name -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Button ListResult Name -> Text
forall s n. MenuField s n -> Text
Menu.fieldLabel | Button ListResult Name
button <- ContextMenu
menu ContextMenu
-> Optic' A_Lens NoIx ContextMenu [Button ListResult Name]
-> [Button ListResult Name]
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx ContextMenu [Button ListResult Name]
forall s n. Lens' (Menu s n) [Button s n]
Menu.menuButtonsL]
    maxWidth :: Int
maxWidth = (Int -> Int -> Int) -> Int -> [Int] -> Int
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
5 ((Text -> Int) -> [Text] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Int
forall a. TextWidth a => a -> Int
Brick.textWidth [Text]
buttonLabels)

    buttonAmplifiers :: [Bool -> Widget n -> Widget n]
buttonAmplifiers =
      let buttonAsWidgets :: [Bool -> Widget n]
buttonAsWidgets = (Text -> Bool -> Widget n) -> [Text] -> [Bool -> Widget n]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Bool -> Widget n
forall n. Text -> Bool -> Widget n
Menu.renderAslabel [Text]
buttonLabels
       in ((Bool -> Widget n) -> Bool -> Widget n -> Widget n)
-> [Bool -> Widget n] -> [Bool -> Widget n -> Widget n]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Bool -> Widget n
f Bool
b -> ((Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
Menu.leftify (Int
maxWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
10) (Widget n -> Widget n)
-> (Widget n -> Widget n) -> Widget n -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Widget n -> Widget n
forall n. Widget n -> Widget n
Border.border (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Bool -> Widget n
f Bool
b) Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+>) ) [Bool -> Widget n]
forall {n}. [Bool -> Widget n]
buttonAsWidgets
    drawButtons :: [Bool -> MenuField s n -> Widget n]
drawButtons = (Formatter n -> Bool -> MenuField s n -> Widget n)
-> [Formatter n] -> [Bool -> MenuField s n -> Widget n]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Formatter n -> Bool -> MenuField s n -> Widget n
forall n s. Formatter n -> Bool -> MenuField s n -> Widget n
Menu.drawField [Formatter n]
forall {n}. [Bool -> Widget n -> Widget n]
buttonAmplifiers
    buttonWidgets :: [Widget Name]
buttonWidgets = ((Bool -> Button ListResult Name -> Widget Name)
 -> Button ListResult Name -> Widget Name)
-> [Bool -> Button ListResult Name -> Widget Name]
-> [Button ListResult Name]
-> [Widget Name]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (FocusRing Name
-> (Bool -> Button ListResult Name -> Widget Name)
-> Button ListResult Name
-> Widget Name
forall n a b.
(Eq n, Named a n) =>
FocusRing n -> (Bool -> a -> b) -> a -> b
F.withFocusRing (ContextMenu
menu ContextMenu
-> Optic' A_Lens NoIx ContextMenu (FocusRing Name)
-> FocusRing Name
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx ContextMenu (FocusRing Name)
forall s n. Lens' (Menu s n) (FocusRing n)
Menu.menuFocusRingL)) [Bool -> Button ListResult Name -> Widget Name]
forall {s} {n}. [Bool -> MenuField s n -> Widget n]
drawButtons (ContextMenu
menu ContextMenu
-> Optic' A_Lens NoIx ContextMenu [Button ListResult Name]
-> [Button ListResult Name]
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx ContextMenu [Button ListResult Name]
forall s n. Lens' (Menu s n) [Button s n]
Menu.menuButtonsL)
    tool_str :: Text
tool_str =
      case ContextMenu
menu ContextMenu -> Optic' A_Getter NoIx ContextMenu Tool -> Tool
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx ContextMenu ListResult
forall s n. Lens' (Menu s n) s
Menu.menuStateL Optic' A_Lens NoIx ContextMenu ListResult
-> Optic A_Getter NoIx ListResult ListResult Tool Tool
-> Optic' A_Getter NoIx ContextMenu Tool
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% (ListResult -> Tool)
-> Optic A_Getter NoIx ListResult ListResult Tool Tool
forall s a. (s -> a) -> Getter s a
to ListResult -> Tool
lTool of
        Tool
GHC -> Text
"GHC"
        Tool
GHCup -> Text
"GHCup"
        Tool
Cabal -> Text
"Cabal"
        Tool
HLS -> Text
"HLS"
        Tool
Stack -> Text
"Stack"

handler :: BrickEvent Name e -> EventM Name ContextMenu ()
handler :: forall e. BrickEvent Name e -> EventM Name ContextMenu ()
handler = BrickEvent Name e -> EventM Name ContextMenu ()
forall n e s. Eq n => BrickEvent n e -> EventM n (Menu s n) ()
Menu.handlerMenu