{-# LANGUAGE CPP               #-}
{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications  #-}
{-# LANGUAGE RankNTypes        #-}
{-# LANGUAGE ViewPatterns      #-}
{-# OPTIONS_GHC -Wno-unused-record-wildcards #-}
{-# OPTIONS_GHC -Wno-unused-matches #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TemplateHaskell   #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE InstanceSigs #-}
{-# OPTIONS_GHC -Wno-incomplete-patterns #-}

module GHCup.Brick.Widgets.Menus.AdvanceInstall (
  InstallOptions (..),
  AdvanceInstallMenu,
  create,
  handler,
  draw,
  instBindistL,
  instSetL,
  instVersionL,
  isolateDirL,
  forceInstallL,
  addConfArgsL,
  installTargetsL,
) where

import GHCup.Types (GHCTargetVersion(..))
import GHCup.Brick.Widgets.Menu (Menu, MenuKeyBindings)
import qualified GHCup.Brick.Widgets.Menu as Menu
import           GHCup.Brick.Common(Name(..))
import Brick
    ( BrickEvent(..),
      EventM,
      Widget(..))
import           Prelude                 hiding ( appendFile )
import           Optics.TH (makeLensesFor)
import qualified GHCup.Brick.Common as Common
import URI.ByteString (URI)
import qualified Data.Text as T
import Data.Bifunctor (Bifunctor(..))
import Data.Function ((&))
import Optics ((.~))
import Data.Char (isSpace)
import qualified GHCup.Utils.Parsers as Utils

data InstallOptions = InstallOptions
  { InstallOptions -> Maybe URI
instBindist  :: Maybe URI
  , InstallOptions -> Bool
instSet      :: Bool
  , InstallOptions -> Maybe GHCTargetVersion
instVersion :: Maybe GHCTargetVersion
  -- ^ User specified version to override default
  , InstallOptions -> Maybe FilePath
isolateDir   :: Maybe FilePath
  , InstallOptions -> Bool
forceInstall :: Bool
  , InstallOptions -> [Text]
addConfArgs  :: [T.Text]
  , InstallOptions -> Text
installTargets :: T.Text
  } deriving (InstallOptions -> InstallOptions -> Bool
(InstallOptions -> InstallOptions -> Bool)
-> (InstallOptions -> InstallOptions -> Bool) -> Eq InstallOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InstallOptions -> InstallOptions -> Bool
== :: InstallOptions -> InstallOptions -> Bool
$c/= :: InstallOptions -> InstallOptions -> Bool
/= :: InstallOptions -> InstallOptions -> Bool
Eq, Int -> InstallOptions -> ShowS
[InstallOptions] -> ShowS
InstallOptions -> FilePath
(Int -> InstallOptions -> ShowS)
-> (InstallOptions -> FilePath)
-> ([InstallOptions] -> ShowS)
-> Show InstallOptions
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InstallOptions -> ShowS
showsPrec :: Int -> InstallOptions -> ShowS
$cshow :: InstallOptions -> FilePath
show :: InstallOptions -> FilePath
$cshowList :: [InstallOptions] -> ShowS
showList :: [InstallOptions] -> ShowS
Show)

makeLensesFor [
   ("instBindist", "instBindistL")
  , ("instSet", "instSetL")
  , ("instVersion", "instVersionL")
  , ("isolateDir", "isolateDirL")
  , ("forceInstall", "forceInstallL")
  , ("addConfArgs", "addConfArgsL")
  , ("installTargets", "installTargetsL")
  ]
  ''InstallOptions

type AdvanceInstallMenu = Menu InstallOptions Name

create :: MenuKeyBindings -> AdvanceInstallMenu
create :: MenuKeyBindings -> AdvanceInstallMenu
create MenuKeyBindings
k = Name
-> InstallOptions
-> Text
-> (InstallOptions -> Maybe Text)
-> MenuKeyBindings
-> [MenuField InstallOptions Name]
-> [MenuField InstallOptions Name]
-> AdvanceInstallMenu
forall n s.
n
-> s
-> Text
-> (s -> Maybe Text)
-> MenuKeyBindings
-> [Button s n]
-> [Button s n]
-> Menu s n
Menu.createMenu Name
AdvanceInstallBox InstallOptions
initialState Text
"Advance Install" InstallOptions -> Maybe Text
forall {a}. IsString a => InstallOptions -> Maybe a
validator MenuKeyBindings
k [MenuField InstallOptions Name
forall {s}. MenuField s Name
ok] [MenuField InstallOptions Name]
fields
  where
    initialInstallTargets :: Text
initialInstallTargets = Text
"install"
    initialState :: InstallOptions
initialState = Maybe URI
-> Bool
-> Maybe GHCTargetVersion
-> Maybe FilePath
-> Bool
-> [Text]
-> Text
-> InstallOptions
InstallOptions Maybe URI
forall a. Maybe a
Nothing Bool
False Maybe GHCTargetVersion
forall a. Maybe a
Nothing Maybe FilePath
forall a. Maybe a
Nothing Bool
False [] Text
initialInstallTargets
    validator :: InstallOptions -> Maybe a
validator InstallOptions {Bool
[Text]
Maybe FilePath
Maybe URI
Maybe GHCTargetVersion
Text
instBindist :: InstallOptions -> Maybe URI
instSet :: InstallOptions -> Bool
instVersion :: InstallOptions -> Maybe GHCTargetVersion
isolateDir :: InstallOptions -> Maybe FilePath
forceInstall :: InstallOptions -> Bool
addConfArgs :: InstallOptions -> [Text]
installTargets :: InstallOptions -> Text
instBindist :: Maybe URI
instSet :: Bool
instVersion :: Maybe GHCTargetVersion
isolateDir :: Maybe FilePath
forceInstall :: Bool
addConfArgs :: [Text]
installTargets :: Text
..} = case (Bool
instSet, Maybe FilePath
isolateDir) of
      (Bool
True, Just FilePath
_) -> a -> Maybe a
forall a. a -> Maybe a
Just a
"Cannot set active when doing an isolated install"
      (Bool, Maybe FilePath)
_ -> Maybe a
forall a. Maybe a
Nothing
    -- Brick's internal editor representation is [mempty].
    emptyEditor :: Text -> Bool
emptyEditor Text
i = Text -> Bool
T.null Text
i Bool -> Bool -> Bool
|| (Text
i Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"\n")

    whenEmpty :: a -> (T.Text -> Either Menu.ErrorMessage a) -> T.Text -> Either Menu.ErrorMessage a
    whenEmpty :: forall a. a -> (Text -> Either Text a) -> Text -> Either Text a
whenEmpty a
emptyval Text -> Either Text a
f Text
i = if Bool -> Bool
not (Text -> Bool
emptyEditor Text
i) then Text -> Either Text a
f Text
i else a -> Either Text a
forall a b. b -> Either a b
Right a
emptyval

    uriValidator :: T.Text -> Either Menu.ErrorMessage (Maybe URI)
    uriValidator :: Text -> Either Text (Maybe URI)
uriValidator = Maybe URI
-> (Text -> Either Text (Maybe URI))
-> Text
-> Either Text (Maybe URI)
forall a. a -> (Text -> Either Text a) -> Text -> Either Text a
whenEmpty Maybe URI
forall a. Maybe a
Nothing ((URI -> Maybe URI) -> Either Text URI -> Either Text (Maybe URI)
forall b c a. (b -> c) -> Either a b -> Either a c
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second URI -> Maybe URI
forall a. a -> Maybe a
Just (Either Text URI -> Either Text (Maybe URI))
-> (Text -> Either Text URI) -> Text -> Either Text (Maybe URI)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text URI
readUri)
      where readUri :: Text -> Either Text URI
readUri = (FilePath -> Text) -> Either FilePath URI -> Either Text URI
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first FilePath -> Text
T.pack (Either FilePath URI -> Either Text URI)
-> (Text -> Either FilePath URI) -> Text -> Either Text URI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Either FilePath URI
Utils.uriParser (FilePath -> Either FilePath URI)
-> (Text -> FilePath) -> Text -> Either FilePath URI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack

    filepathValidator :: T.Text -> Either Menu.ErrorMessage (Maybe FilePath)
    filepathValidator :: Text -> Either Text (Maybe FilePath)
filepathValidator = Maybe FilePath
-> (Text -> Either Text (Maybe FilePath))
-> Text
-> Either Text (Maybe FilePath)
forall a. a -> (Text -> Either Text a) -> Text -> Either Text a
whenEmpty Maybe FilePath
forall a. Maybe a
Nothing ((FilePath -> Text)
-> (FilePath -> Maybe FilePath)
-> Either FilePath FilePath
-> Either Text (Maybe FilePath)
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap FilePath -> Text
T.pack FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (Either FilePath FilePath -> Either Text (Maybe FilePath))
-> (Text -> Either FilePath FilePath)
-> Text
-> Either Text (Maybe FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Either FilePath FilePath
Utils.absolutePathParser (FilePath -> Either FilePath FilePath)
-> (Text -> FilePath) -> Text -> Either FilePath FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack)

    toolVersionValidator :: T.Text -> Either Menu.ErrorMessage (Maybe GHCTargetVersion)
    toolVersionValidator :: Text -> Either Text (Maybe GHCTargetVersion)
toolVersionValidator = Maybe GHCTargetVersion
-> (Text -> Either Text (Maybe GHCTargetVersion))
-> Text
-> Either Text (Maybe GHCTargetVersion)
forall a. a -> (Text -> Either Text a) -> Text -> Either Text a
whenEmpty Maybe GHCTargetVersion
forall a. Maybe a
Nothing ((FilePath -> Text)
-> (GHCTargetVersion -> Maybe GHCTargetVersion)
-> Either FilePath GHCTargetVersion
-> Either Text (Maybe GHCTargetVersion)
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap FilePath -> Text
T.pack GHCTargetVersion -> Maybe GHCTargetVersion
forall a. a -> Maybe a
Just (Either FilePath GHCTargetVersion
 -> Either Text (Maybe GHCTargetVersion))
-> (Text -> Either FilePath GHCTargetVersion)
-> Text
-> Either Text (Maybe GHCTargetVersion)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Either FilePath GHCTargetVersion
Utils.ghcVersionEither (FilePath -> Either FilePath GHCTargetVersion)
-> (Text -> FilePath) -> Text -> Either FilePath GHCTargetVersion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack)

    additionalValidator :: T.Text -> Either Menu.ErrorMessage [T.Text]
    additionalValidator :: Text -> Either Text [Text]
additionalValidator = [Text] -> Either Text [Text]
forall a b. b -> Either a b
Right ([Text] -> Either Text [Text])
-> (Text -> [Text]) -> Text -> Either Text [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> [Text]
T.split Char -> Bool
isSpace

    fields :: [MenuField InstallOptions Name]
fields =
      [ Name
-> (Text -> Either Text (Maybe URI))
-> Lens' InstallOptions (Maybe URI)
-> MenuField InstallOptions Name
forall n a s.
(Eq n, Ord n, Show n) =>
n -> (Text -> Either Text a) -> Lens' s a -> EditableField s n
Menu.createEditableField (ResourceId -> Name
Common.MenuElement ResourceId
Common.UrlEditBox) Text -> Either Text (Maybe URI)
uriValidator Lens' InstallOptions (Maybe URI)
instBindistL
          MenuField InstallOptions Name
-> (MenuField InstallOptions Name -> MenuField InstallOptions Name)
-> MenuField InstallOptions Name
forall a b. a -> (a -> b) -> b
& Lens' (MenuField InstallOptions Name) Text
forall s n. Lens' (MenuField s n) Text
Menu.fieldLabelL Lens' (MenuField InstallOptions Name) Text
-> Text
-> MenuField InstallOptions Name
-> MenuField InstallOptions Name
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Text
"url"
          MenuField InstallOptions Name
-> (MenuField InstallOptions Name -> MenuField InstallOptions Name)
-> MenuField InstallOptions Name
forall a b. a -> (a -> b) -> b
& Lens' (MenuField InstallOptions Name) Text
forall s n. Lens' (MenuField s n) Text
Menu.fieldHelpMsgL Lens' (MenuField InstallOptions Name) Text
-> Text
-> MenuField InstallOptions Name
-> MenuField InstallOptions 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 the specified version from this bindist"
      , Name -> Lens' InstallOptions Bool -> MenuField InstallOptions Name
forall n s. n -> Lens' s Bool -> CheckBoxField s n
Menu.createCheckBoxField (ResourceId -> Name
Common.MenuElement ResourceId
Common.SetCheckBox) Lens' InstallOptions Bool
instSetL
          MenuField InstallOptions Name
-> (MenuField InstallOptions Name -> MenuField InstallOptions Name)
-> MenuField InstallOptions Name
forall a b. a -> (a -> b) -> b
& Lens' (MenuField InstallOptions Name) Text
forall s n. Lens' (MenuField s n) Text
Menu.fieldLabelL Lens' (MenuField InstallOptions Name) Text
-> Text
-> MenuField InstallOptions Name
-> MenuField InstallOptions Name
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Text
"set"
          MenuField InstallOptions Name
-> (MenuField InstallOptions Name -> MenuField InstallOptions Name)
-> MenuField InstallOptions Name
forall a b. a -> (a -> b) -> b
& Lens' (MenuField InstallOptions Name) Text
forall s n. Lens' (MenuField s n) Text
Menu.fieldHelpMsgL Lens' (MenuField InstallOptions Name) Text
-> Text
-> MenuField InstallOptions Name
-> MenuField InstallOptions Name
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Text
"Set as active version after install"
      , Name
-> (Text -> Either Text (Maybe GHCTargetVersion))
-> Lens' InstallOptions (Maybe GHCTargetVersion)
-> MenuField InstallOptions Name
forall n a s.
(Eq n, Ord n, Show n) =>
n -> (Text -> Either Text a) -> Lens' s a -> EditableField s n
Menu.createEditableField (ResourceId -> Name
Common.MenuElement ResourceId
Common.ToolVersionBox) Text -> Either Text (Maybe GHCTargetVersion)
toolVersionValidator Lens' InstallOptions (Maybe GHCTargetVersion)
instVersionL
          MenuField InstallOptions Name
-> (MenuField InstallOptions Name -> MenuField InstallOptions Name)
-> MenuField InstallOptions Name
forall a b. a -> (a -> b) -> b
& Lens' (MenuField InstallOptions Name) Text
forall s n. Lens' (MenuField s n) Text
Menu.fieldLabelL Lens' (MenuField InstallOptions Name) Text
-> Text
-> MenuField InstallOptions Name
-> MenuField InstallOptions Name
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Text
"version"
          MenuField InstallOptions Name
-> (MenuField InstallOptions Name -> MenuField InstallOptions Name)
-> MenuField InstallOptions Name
forall a b. a -> (a -> b) -> b
& Lens' (MenuField InstallOptions Name) Text
forall s n. Lens' (MenuField s n) Text
Menu.fieldHelpMsgL Lens' (MenuField InstallOptions Name) Text
-> Text
-> MenuField InstallOptions Name
-> MenuField InstallOptions Name
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Text
"Specify a custom version"
      , Text
-> Name
-> (Text -> Either Text Text)
-> Lens' InstallOptions Text
-> MenuField InstallOptions Name
forall n a s.
(Eq n, Ord n, Show n) =>
Text
-> n -> (Text -> Either Text a) -> Lens' s a -> EditableField s n
Menu.createEditableField' Text
initialInstallTargets (ResourceId -> Name
Common.MenuElement ResourceId
Common.GHCInstallTargets) Text -> Either Text Text
forall a b. b -> Either a b
Right Lens' InstallOptions Text
installTargetsL
          MenuField InstallOptions Name
-> (MenuField InstallOptions Name -> MenuField InstallOptions Name)
-> MenuField InstallOptions Name
forall a b. a -> (a -> b) -> b
& Lens' (MenuField InstallOptions Name) Text
forall s n. Lens' (MenuField s n) Text
Menu.fieldLabelL Lens' (MenuField InstallOptions Name) Text
-> Text
-> MenuField InstallOptions Name
-> MenuField InstallOptions 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-targets"
          MenuField InstallOptions Name
-> (MenuField InstallOptions Name -> MenuField InstallOptions Name)
-> MenuField InstallOptions Name
forall a b. a -> (a -> b) -> b
& Lens' (MenuField InstallOptions Name) Text
forall s n. Lens' (MenuField s n) Text
Menu.fieldHelpMsgL Lens' (MenuField InstallOptions Name) Text
-> Text
-> MenuField InstallOptions Name
-> MenuField InstallOptions Name
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Text
"Specify space separated list of make install targets"
      , Name
-> (Text -> Either Text (Maybe FilePath))
-> Lens' InstallOptions (Maybe FilePath)
-> MenuField InstallOptions Name
forall n a s.
(Eq n, Ord n, Show n) =>
n -> (Text -> Either Text a) -> Lens' s a -> EditableField s n
Menu.createEditableField (ResourceId -> Name
Common.MenuElement ResourceId
Common.IsolateEditBox) Text -> Either Text (Maybe FilePath)
filepathValidator Lens' InstallOptions (Maybe FilePath)
isolateDirL
          MenuField InstallOptions Name
-> (MenuField InstallOptions Name -> MenuField InstallOptions Name)
-> MenuField InstallOptions Name
forall a b. a -> (a -> b) -> b
& Lens' (MenuField InstallOptions Name) Text
forall s n. Lens' (MenuField s n) Text
Menu.fieldLabelL Lens' (MenuField InstallOptions Name) Text
-> Text
-> MenuField InstallOptions Name
-> MenuField InstallOptions Name
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Text
"isolated"
          MenuField InstallOptions Name
-> (MenuField InstallOptions Name -> MenuField InstallOptions Name)
-> MenuField InstallOptions Name
forall a b. a -> (a -> b) -> b
& Lens' (MenuField InstallOptions Name) Text
forall s n. Lens' (MenuField s n) Text
Menu.fieldHelpMsgL Lens' (MenuField InstallOptions Name) Text
-> Text
-> MenuField InstallOptions Name
-> MenuField InstallOptions 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 in an isolated absolute directory instead of the default one"
      , Name -> Lens' InstallOptions Bool -> MenuField InstallOptions Name
forall n s. n -> Lens' s Bool -> CheckBoxField s n
Menu.createCheckBoxField (ResourceId -> Name
Common.MenuElement ResourceId
Common.ForceCheckBox) Lens' InstallOptions Bool
forceInstallL
          MenuField InstallOptions Name
-> (MenuField InstallOptions Name -> MenuField InstallOptions Name)
-> MenuField InstallOptions Name
forall a b. a -> (a -> b) -> b
& Lens' (MenuField InstallOptions Name) Text
forall s n. Lens' (MenuField s n) Text
Menu.fieldLabelL Lens' (MenuField InstallOptions Name) Text
-> Text
-> MenuField InstallOptions Name
-> MenuField InstallOptions Name
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Text
"force"
          MenuField InstallOptions Name
-> (MenuField InstallOptions Name -> MenuField InstallOptions Name)
-> MenuField InstallOptions Name
forall a b. a -> (a -> b) -> b
& Lens' (MenuField InstallOptions Name) Text
forall s n. Lens' (MenuField s n) Text
Menu.fieldHelpMsgL Lens' (MenuField InstallOptions Name) Text
-> Text
-> MenuField InstallOptions Name
-> MenuField InstallOptions Name
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Text
"Force install (THIS IS UNSAFE, only use it in Dockerfiles or CI)"
      , Name
-> (Text -> Either Text [Text])
-> Lens' InstallOptions [Text]
-> MenuField InstallOptions Name
forall n a s.
(Eq n, Ord n, Show n) =>
n -> (Text -> Either Text a) -> Lens' s a -> EditableField s n
Menu.createEditableField (ResourceId -> Name
Common.MenuElement ResourceId
Common.AdditionalEditBox) Text -> Either Text [Text]
additionalValidator Lens' InstallOptions [Text]
addConfArgsL
          MenuField InstallOptions Name
-> (MenuField InstallOptions Name -> MenuField InstallOptions Name)
-> MenuField InstallOptions Name
forall a b. a -> (a -> b) -> b
& Lens' (MenuField InstallOptions Name) Text
forall s n. Lens' (MenuField s n) Text
Menu.fieldLabelL Lens' (MenuField InstallOptions Name) Text
-> Text
-> MenuField InstallOptions Name
-> MenuField InstallOptions Name
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Text
"CONFIGURE_ARGS"
          MenuField InstallOptions Name
-> (MenuField InstallOptions Name -> MenuField InstallOptions Name)
-> MenuField InstallOptions Name
forall a b. a -> (a -> b) -> b
& Lens' (MenuField InstallOptions Name) Text
forall s n. Lens' (MenuField s n) Text
Menu.fieldHelpMsgL Lens' (MenuField InstallOptions Name) Text
-> Text
-> MenuField InstallOptions Name
-> MenuField InstallOptions Name
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Text
"Additional arguments to bindist configure"
      ]

    ok :: MenuField s Name
ok = Name -> MenuField s Name
forall n s. n -> Button s n
Menu.createButtonField (ResourceId -> Name
Common.MenuElement ResourceId
Common.OkButton)
          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
"Advance 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
"Install with options below"

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


draw :: AdvanceInstallMenu -> [Widget Name]
draw :: AdvanceInstallMenu -> [Widget Name]
draw = AdvanceInstallMenu -> [Widget Name]
forall n s.
(Eq n, Ord n, Show n, Named (MenuField s n) n) =>
Menu s n -> [Widget n]
Menu.drawMenu