{-# 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.CompileGHC (
  CompileGHCOptions,
  CompileGHCMenu,
  create,
  handler,
  draw,
  bootstrapGhc,
  hadrianGhc,
  jobs,
  buildConfig,
  patches,
  crossTarget,
  addConfArgs,
  setCompile,
  overwriteVer,
  buildFlavour,
  buildSystem,
  isolateDir,
  gitRef,
  installTargets,
) where

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 (makeLenses)
import qualified GHCup.Brick.Common as Common
import GHCup.Types
    ( BuildSystem(..), VersionPattern )
import URI.ByteString (URI)
import Control.Monad (join)
import qualified Data.Text as T
import Data.Bifunctor (Bifunctor(..))
import Data.Function ((&))
import Optics ((.~), iso, (%))
import Data.Char (isSpace)
import Data.List.NonEmpty             ( NonEmpty (..) )
import qualified Data.List.NonEmpty            as NE
import Data.Versions (Version, version)
import System.FilePath (isPathSeparator)
import Control.Applicative (Alternative((<|>)))
import Text.Read (readEither)
import qualified GHCup.Utils.Parsers as Utils
import           Text.PrettyPrint.HughesPJClass ( prettyShow )

data CompileGHCOptions = CompileGHCOptions
  { CompileGHCOptions -> Either Version FilePath
_bootstrapGhc :: Either Version FilePath
  , CompileGHCOptions -> Maybe (Either Version FilePath)
_hadrianGhc   :: Maybe (Either Version FilePath)
  , CompileGHCOptions -> Maybe Int
_jobs         :: Maybe Int
  , CompileGHCOptions -> Maybe FilePath
_buildConfig  :: Maybe FilePath
  , CompileGHCOptions -> Maybe (Either FilePath [URI])
_patches      :: Maybe (Either FilePath [URI])
  , CompileGHCOptions -> Maybe Text
_crossTarget  :: Maybe T.Text
  , CompileGHCOptions -> [Text]
_addConfArgs  :: [T.Text]
  , CompileGHCOptions -> Bool
_setCompile   :: Bool
  , CompileGHCOptions -> Maybe [VersionPattern]
_overwriteVer :: Maybe [VersionPattern]
  , CompileGHCOptions -> Maybe FilePath
_buildFlavour :: Maybe String
  , CompileGHCOptions -> Maybe BuildSystem
_buildSystem  :: Maybe BuildSystem
  , CompileGHCOptions -> Maybe FilePath
_isolateDir   :: Maybe FilePath
  , CompileGHCOptions -> Maybe FilePath
_gitRef       :: Maybe String
  , CompileGHCOptions -> Text
_installTargets :: T.Text
  } deriving (CompileGHCOptions -> CompileGHCOptions -> Bool
(CompileGHCOptions -> CompileGHCOptions -> Bool)
-> (CompileGHCOptions -> CompileGHCOptions -> Bool)
-> Eq CompileGHCOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CompileGHCOptions -> CompileGHCOptions -> Bool
== :: CompileGHCOptions -> CompileGHCOptions -> Bool
$c/= :: CompileGHCOptions -> CompileGHCOptions -> Bool
/= :: CompileGHCOptions -> CompileGHCOptions -> Bool
Eq, Int -> CompileGHCOptions -> ShowS
[CompileGHCOptions] -> ShowS
CompileGHCOptions -> FilePath
(Int -> CompileGHCOptions -> ShowS)
-> (CompileGHCOptions -> FilePath)
-> ([CompileGHCOptions] -> ShowS)
-> Show CompileGHCOptions
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CompileGHCOptions -> ShowS
showsPrec :: Int -> CompileGHCOptions -> ShowS
$cshow :: CompileGHCOptions -> FilePath
show :: CompileGHCOptions -> FilePath
$cshowList :: [CompileGHCOptions] -> ShowS
showList :: [CompileGHCOptions] -> ShowS
Show)

makeLenses ''CompileGHCOptions

type CompileGHCMenu = Menu CompileGHCOptions Name

create :: MenuKeyBindings -> [Version] -> CompileGHCMenu
create :: MenuKeyBindings -> [Version] -> CompileGHCMenu
create MenuKeyBindings
k [Version]
availableGHCs = Name
-> CompileGHCOptions
-> Text
-> (CompileGHCOptions -> Maybe Text)
-> MenuKeyBindings
-> [MenuField CompileGHCOptions Name]
-> [MenuField CompileGHCOptions Name]
-> CompileGHCMenu
forall n s.
n
-> s
-> Text
-> (s -> Maybe Text)
-> MenuKeyBindings
-> [Button s n]
-> [Button s n]
-> Menu s n
Menu.createMenu Name
CompileGHCBox CompileGHCOptions
initialState Text
"Compile GHC" CompileGHCOptions -> Maybe Text
forall {a}. IsString a => CompileGHCOptions -> Maybe a
validator MenuKeyBindings
k [MenuField CompileGHCOptions Name]
forall {s}. [MenuField s Name]
buttons [MenuField CompileGHCOptions Name]
fields
  where
    initialInstallTargets :: Text
initialInstallTargets = Text
"install"
    initialState :: CompileGHCOptions
initialState =
      Either Version FilePath
-> Maybe (Either Version FilePath)
-> Maybe Int
-> Maybe FilePath
-> Maybe (Either FilePath [URI])
-> Maybe Text
-> [Text]
-> Bool
-> Maybe [VersionPattern]
-> Maybe FilePath
-> Maybe BuildSystem
-> Maybe FilePath
-> Maybe FilePath
-> Text
-> CompileGHCOptions
CompileGHCOptions
        (FilePath -> Either Version FilePath
forall a b. b -> Either a b
Right FilePath
"")
        Maybe (Either Version FilePath)
forall a. Maybe a
Nothing
        Maybe Int
forall a. Maybe a
Nothing
        Maybe FilePath
forall a. Maybe a
Nothing
        Maybe (Either FilePath [URI])
forall a. Maybe a
Nothing
        Maybe Text
forall a. Maybe a
Nothing
        []
        Bool
False
        Maybe [VersionPattern]
forall a. Maybe a
Nothing
        Maybe FilePath
forall a. Maybe a
Nothing
        Maybe BuildSystem
forall a. Maybe a
Nothing
        Maybe FilePath
forall a. Maybe a
Nothing
        Maybe FilePath
forall a. Maybe a
Nothing
        Text
initialInstallTargets
    validator :: CompileGHCOptions -> Maybe a
validator CompileGHCOptions {Bool
[Text]
Maybe Int
Maybe FilePath
Maybe [VersionPattern]
Maybe (Either FilePath [URI])
Maybe (Either Version FilePath)
Maybe Text
Maybe BuildSystem
Either Version FilePath
Text
_bootstrapGhc :: CompileGHCOptions -> Either Version FilePath
_hadrianGhc :: CompileGHCOptions -> Maybe (Either Version FilePath)
_jobs :: CompileGHCOptions -> Maybe Int
_buildConfig :: CompileGHCOptions -> Maybe FilePath
_patches :: CompileGHCOptions -> Maybe (Either FilePath [URI])
_crossTarget :: CompileGHCOptions -> Maybe Text
_addConfArgs :: CompileGHCOptions -> [Text]
_setCompile :: CompileGHCOptions -> Bool
_overwriteVer :: CompileGHCOptions -> Maybe [VersionPattern]
_buildFlavour :: CompileGHCOptions -> Maybe FilePath
_buildSystem :: CompileGHCOptions -> Maybe BuildSystem
_isolateDir :: CompileGHCOptions -> Maybe FilePath
_gitRef :: CompileGHCOptions -> Maybe FilePath
_installTargets :: CompileGHCOptions -> Text
_bootstrapGhc :: Either Version FilePath
_hadrianGhc :: Maybe (Either Version FilePath)
_jobs :: Maybe Int
_buildConfig :: Maybe FilePath
_patches :: Maybe (Either FilePath [URI])
_crossTarget :: Maybe Text
_addConfArgs :: [Text]
_setCompile :: Bool
_overwriteVer :: Maybe [VersionPattern]
_buildFlavour :: Maybe FilePath
_buildSystem :: Maybe BuildSystem
_isolateDir :: Maybe FilePath
_gitRef :: Maybe FilePath
_installTargets :: Text
..} = case (Bool
_setCompile, 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)
_ -> case (Maybe FilePath
_buildConfig, Maybe BuildSystem
_buildSystem) of
        (Just FilePath
_, Just BuildSystem
Hadrian) -> a -> Maybe a
forall a. a -> Maybe a
Just a
"Build config can be specified only for make build system"
        (Maybe FilePath, Maybe BuildSystem)
_ -> 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

    bootstrapV :: T.Text -> Either Menu.ErrorMessage (Either Version FilePath)
    bootstrapV :: Text -> Either Text (Either Version FilePath)
bootstrapV Text
i =
      case Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Bool
emptyEditor Text
i of
        Bool
True  ->
          let readVersion :: Either Text (Either Version b)
readVersion = (ParsingError -> Text)
-> (Version -> Either Version b)
-> Either ParsingError Version
-> Either Text (Either Version b)
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 (Text -> ParsingError -> Text
forall a b. a -> b -> a
const Text
"Not a valid version") Version -> Either Version b
forall a b. a -> Either a b
Left (Text -> Either ParsingError Version
version Text
i)
              readPath :: Either Text (Either a FilePath)
readPath = do
                Maybe FilePath
mfilepath <- Text -> Either Text (Maybe FilePath)
filepathV Text
i
                case Maybe FilePath
mfilepath of
                  Maybe FilePath
Nothing -> Text -> Either Text (Either a FilePath)
forall a b. a -> Either a b
Left Text
"Invalid path"
                  Just FilePath
f  -> Either a FilePath -> Either Text (Either a FilePath)
forall a b. b -> Either a b
Right (FilePath -> Either a FilePath
forall a b. b -> Either a b
Right FilePath
f)
           in if (Char -> Bool) -> Text -> Bool
T.any Char -> Bool
isPathSeparator Text
i
                then Either Text (Either Version FilePath)
forall {a}. Either Text (Either a FilePath)
readPath
                else Either Text (Either Version FilePath)
forall {b}. Either Text (Either Version b)
readVersion
        Bool
False -> Text -> Either Text (Either Version FilePath)
forall a b. a -> Either a b
Left Text
"No version selected / no path specified"

    hadrianstrapV :: T.Text -> Either Menu.ErrorMessage (Maybe (Either Version FilePath))
    hadrianstrapV :: Text -> Either Text (Maybe (Either Version FilePath))
hadrianstrapV Text
i' =
        let readVersion :: Text -> Either Text (Maybe (Either Version b))
readVersion = (ParsingError -> Text)
-> (Version -> Maybe (Either Version b))
-> Either ParsingError Version
-> Either Text (Maybe (Either Version b))
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 (Text -> ParsingError -> Text
forall a b. a -> b -> a
const Text
"Not a valid version") (Either Version b -> Maybe (Either Version b)
forall a. a -> Maybe a
Just (Either Version b -> Maybe (Either Version b))
-> (Version -> Either Version b)
-> Version
-> Maybe (Either Version b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> Either Version b
forall a b. a -> Either a b
Left) (Either ParsingError Version
 -> Either Text (Maybe (Either Version b)))
-> (Text -> Either ParsingError Version)
-> Text
-> Either Text (Maybe (Either Version b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either ParsingError Version
version
            readPath :: Text -> Either Text (Maybe (Either a FilePath))
readPath = (FilePath -> Text)
-> (FilePath -> Maybe (Either a FilePath))
-> Either FilePath FilePath
-> Either Text (Maybe (Either a 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 (Either a FilePath -> Maybe (Either a FilePath)
forall a. a -> Maybe a
Just (Either a FilePath -> Maybe (Either a FilePath))
-> (FilePath -> Either a FilePath)
-> FilePath
-> Maybe (Either a FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Either a FilePath
forall a b. b -> Either a b
Right) (Either FilePath FilePath
 -> Either Text (Maybe (Either a FilePath)))
-> (Text -> Either FilePath FilePath)
-> Text
-> Either Text (Maybe (Either a 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
         in if (Char -> Bool) -> Text -> Bool
T.any Char -> Bool
isPathSeparator Text
i'
              then Maybe (Either Version FilePath)
-> (Text -> Either Text (Maybe (Either Version FilePath)))
-> Text
-> Either Text (Maybe (Either Version FilePath))
forall a. a -> (Text -> Either Text a) -> Text -> Either Text a
whenEmpty Maybe (Either Version FilePath)
forall a. Maybe a
Nothing Text -> Either Text (Maybe (Either Version FilePath))
forall {a}. Text -> Either Text (Maybe (Either a FilePath))
readPath Text
i'
              else Maybe (Either Version FilePath)
-> (Text -> Either Text (Maybe (Either Version FilePath)))
-> Text
-> Either Text (Maybe (Either Version FilePath))
forall a. a -> (Text -> Either Text a) -> Text -> Either Text a
whenEmpty Maybe (Either Version FilePath)
forall a. Maybe a
Nothing Text -> Either Text (Maybe (Either Version FilePath))
forall {b}. Text -> Either Text (Maybe (Either Version b))
readVersion Text
i'

    versionV :: T.Text -> Either Menu.ErrorMessage (Maybe [VersionPattern])
    versionV :: Text -> Either Text (Maybe [VersionPattern])
versionV = Maybe [VersionPattern]
-> (Text -> Either Text (Maybe [VersionPattern]))
-> Text
-> Either Text (Maybe [VersionPattern])
forall a. a -> (Text -> Either Text a) -> Text -> Either Text a
whenEmpty Maybe [VersionPattern]
forall a. Maybe a
Nothing ((FilePath -> Text)
-> ([VersionPattern] -> Maybe [VersionPattern])
-> Either FilePath [VersionPattern]
-> Either Text (Maybe [VersionPattern])
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 [VersionPattern] -> Maybe [VersionPattern]
forall a. a -> Maybe a
Just (Either FilePath [VersionPattern]
 -> Either Text (Maybe [VersionPattern]))
-> (Text -> Either FilePath [VersionPattern])
-> Text
-> Either Text (Maybe [VersionPattern])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Either FilePath [VersionPattern]
Utils.overWriteVersionParser (FilePath -> Either FilePath [VersionPattern])
-> (Text -> FilePath) -> Text -> Either FilePath [VersionPattern]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack)

    jobsV :: T.Text -> Either Menu.ErrorMessage (Maybe Int)
    jobsV :: Text -> Either Text (Maybe Int)
jobsV =
      let parseInt :: Text -> Either Text (Maybe Int)
parseInt = (FilePath -> Text)
-> (Int -> Maybe Int)
-> Either FilePath Int
-> Either Text (Maybe Int)
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 (Text -> FilePath -> Text
forall a b. a -> b -> a
const Text
"Invalid value. Must be an integer") Int -> Maybe Int
forall a. a -> Maybe a
Just (Either FilePath Int -> Either Text (Maybe Int))
-> (Text -> Either FilePath Int) -> Text -> Either Text (Maybe Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => FilePath -> Either FilePath a
readEither @Int (FilePath -> Either FilePath Int)
-> (Text -> FilePath) -> Text -> Either FilePath Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack
       in Maybe Int
-> (Text -> Either Text (Maybe Int))
-> Text
-> Either Text (Maybe Int)
forall a. a -> (Text -> Either Text a) -> Text -> Either Text a
whenEmpty Maybe Int
forall a. Maybe a
Nothing Text -> Either Text (Maybe Int)
parseInt

    patchesV :: T.Text -> Either Menu.ErrorMessage (Maybe (Either FilePath [URI]))
    patchesV :: Text -> Either Text (Maybe (Either FilePath [URI]))
patchesV = Maybe (Either FilePath [URI])
-> (Text -> Either Text (Maybe (Either FilePath [URI])))
-> Text
-> Either Text (Maybe (Either FilePath [URI]))
forall a. a -> (Text -> Either Text a) -> Text -> Either Text a
whenEmpty Maybe (Either FilePath [URI])
forall a. Maybe a
Nothing Text -> Either Text (Maybe (Either FilePath [URI]))
readPatches
      where
        readPatches :: Text -> Either Text (Maybe (Either FilePath [URI]))
readPatches Text
j =
          let
            x :: Either FilePath (Maybe (Either FilePath b))
x = (FilePath -> Maybe (Either FilePath b))
-> Either FilePath FilePath
-> Either FilePath (Maybe (Either FilePath b))
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 (Either FilePath b -> Maybe (Either FilePath b)
forall a. a -> Maybe a
Just (Either FilePath b -> Maybe (Either FilePath b))
-> (FilePath -> Either FilePath b)
-> FilePath
-> Maybe (Either FilePath b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Either FilePath b
forall a b. a -> Either a b
Left) (Either FilePath FilePath
 -> Either FilePath (Maybe (Either FilePath b)))
-> Either FilePath FilePath
-> Either FilePath (Maybe (Either FilePath b))
forall a b. (a -> b) -> a -> b
$ FilePath -> Either FilePath FilePath
Utils.absolutePathParser (Text -> FilePath
T.unpack Text
j)
            y :: Either FilePath (Maybe (Either a [URI]))
y = ([URI] -> Maybe (Either a [URI]))
-> Either FilePath [URI]
-> Either FilePath (Maybe (Either a [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 (Either a [URI] -> Maybe (Either a [URI])
forall a. a -> Maybe a
Just (Either a [URI] -> Maybe (Either a [URI]))
-> ([URI] -> Either a [URI]) -> [URI] -> Maybe (Either a [URI])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [URI] -> Either a [URI]
forall a b. b -> Either a b
Right) (Either FilePath [URI] -> Either FilePath (Maybe (Either a [URI])))
-> Either FilePath [URI]
-> Either FilePath (Maybe (Either a [URI]))
forall a b. (a -> b) -> a -> b
$ (Text -> Either FilePath URI) -> [Text] -> Either FilePath [URI]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (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) ((Char -> Bool) -> Text -> [Text]
T.split Char -> Bool
isSpace Text
j)
          in (FilePath -> Text)
-> Either FilePath (Maybe (Either FilePath [URI]))
-> Either Text (Maybe (Either FilePath [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 (Maybe (Either FilePath [URI]))
 -> Either Text (Maybe (Either FilePath [URI])))
-> Either FilePath (Maybe (Either FilePath [URI]))
-> Either Text (Maybe (Either FilePath [URI]))
forall a b. (a -> b) -> a -> b
$ Either FilePath (Maybe (Either FilePath [URI]))
forall {b}. Either FilePath (Maybe (Either FilePath b))
x Either FilePath (Maybe (Either FilePath [URI]))
-> Either FilePath (Maybe (Either FilePath [URI]))
-> Either FilePath (Maybe (Either FilePath [URI]))
forall a.
Either FilePath a -> Either FilePath a -> Either FilePath a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Either FilePath (Maybe (Either FilePath [URI]))
forall {a}. Either FilePath (Maybe (Either a [URI]))
y

    filepathV :: T.Text -> Either Menu.ErrorMessage (Maybe FilePath)
    filepathV :: Text -> Either Text (Maybe FilePath)
filepathV = 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)

    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

    showMaybeBuildSystem :: Maybe BuildSystem -> T.Text
    showMaybeBuildSystem :: Maybe BuildSystem -> Text
showMaybeBuildSystem  = \case
      Maybe BuildSystem
Nothing -> Text
"Auto select (prefer hadrian if available, and build config is not specified)"
      Just BuildSystem
Hadrian -> Text
"hadrian"
      Just BuildSystem
Make -> Text
"make"

    bootstrapGHCFields :: [MenuField CompileGHCOptions Name]
bootstrapGHCFields = case [Version] -> Maybe (NonEmpty Version)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [Version]
availableGHCs of
        Just NonEmpty Version
ne ->
          let bootstrapGhc' :: Optic
  A_Lens
  '[]
  CompileGHCOptions
  CompileGHCOptions
  (Either (Either Version FilePath) b)
  (Either (Either Version FilePath) Version)
bootstrapGhc' = Lens' CompileGHCOptions (Either Version FilePath)
bootstrapGhc Lens' CompileGHCOptions (Either Version FilePath)
-> Optic
     An_Iso
     '[]
     (Either Version FilePath)
     (Either Version FilePath)
     (Either (Either Version FilePath) b)
     (Either (Either Version FilePath) Version)
-> Optic
     A_Lens
     '[]
     CompileGHCOptions
     CompileGHCOptions
     (Either (Either Version FilePath) b)
     (Either (Either Version FilePath) Version)
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
% ((Either Version FilePath -> Either (Either Version FilePath) b)
-> (Either (Either Version FilePath) Version
    -> Either Version FilePath)
-> Optic
     An_Iso
     '[]
     (Either Version FilePath)
     (Either Version FilePath)
     (Either (Either Version FilePath) b)
     (Either (Either Version FilePath) Version)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso ((Version -> Either (Either Version FilePath) b)
-> (FilePath -> Either (Either Version FilePath) b)
-> Either Version FilePath
-> Either (Either Version FilePath) b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either Version FilePath -> Either (Either Version FilePath) b
forall a b. a -> Either a b
Left (Either Version FilePath -> Either (Either Version FilePath) b)
-> (Version -> Either Version FilePath)
-> Version
-> Either (Either Version FilePath) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> Either Version FilePath
forall a b. a -> Either a b
Left) (Either Version FilePath -> Either (Either Version FilePath) b
forall a b. a -> Either a b
Left (Either Version FilePath -> Either (Either Version FilePath) b)
-> (FilePath -> Either Version FilePath)
-> FilePath
-> Either (Either Version FilePath) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Either Version FilePath
forall a b. b -> Either a b
Right)) ((Either Version FilePath -> Either Version FilePath)
-> (Version -> Either Version FilePath)
-> Either (Either Version FilePath) Version
-> Either Version FilePath
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Either Version FilePath -> Either Version FilePath
forall a. a -> a
id Version -> Either Version FilePath
forall a b. a -> Either a b
Left))
          in [ Name
-> Name
-> Lens'
     CompileGHCOptions (Either (Either Version FilePath) Version)
-> (Text -> Either Text (Either Version FilePath))
-> NonEmpty Version
-> (Version -> Text)
-> MenuKeyBindings
-> MenuField CompileGHCOptions Name
forall n s a i.
(Ord n, Show n) =>
n
-> n
-> Lens' s (Either a i)
-> (Text -> Either Text a)
-> NonEmpty i
-> (i -> Text)
-> MenuKeyBindings
-> SelectField s n
Menu.createSelectFieldWithEditable (ResourceId -> Name
Common.MenuElement ResourceId
Common.BootstrapGhcSelectBox) (ResourceId -> Name
Common.MenuElement ResourceId
Common.BootstrapGhcEditBox) Lens' CompileGHCOptions (Either (Either Version FilePath) Version)
forall {b}.
Optic
  A_Lens
  '[]
  CompileGHCOptions
  CompileGHCOptions
  (Either (Either Version FilePath) b)
  (Either (Either Version FilePath) Version)
bootstrapGhc' Text -> Either Text (Either Version FilePath)
bootstrapV NonEmpty Version
ne (FilePath -> Text
T.pack (FilePath -> Text) -> (Version -> FilePath) -> Version -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow) MenuKeyBindings
k
               MenuField CompileGHCOptions Name
-> (MenuField CompileGHCOptions Name
    -> MenuField CompileGHCOptions Name)
-> MenuField CompileGHCOptions Name
forall a b. a -> (a -> b) -> b
& Lens' (MenuField CompileGHCOptions Name) Text
forall s n. Lens' (MenuField s n) Text
Menu.fieldLabelL Lens' (MenuField CompileGHCOptions Name) Text
-> Text
-> MenuField CompileGHCOptions Name
-> MenuField CompileGHCOptions Name
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Text
"bootstrap-ghc"
               MenuField CompileGHCOptions Name
-> (MenuField CompileGHCOptions Name
    -> MenuField CompileGHCOptions Name)
-> MenuField CompileGHCOptions Name
forall a b. a -> (a -> b) -> b
& Lens' (MenuField CompileGHCOptions Name) Text
forall s n. Lens' (MenuField s n) Text
Menu.fieldHelpMsgL Lens' (MenuField CompileGHCOptions Name) Text
-> Text
-> MenuField CompileGHCOptions Name
-> MenuField CompileGHCOptions Name
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Text
"The GHC version (or full path) to bootstrap with (must be installed)"
               MenuField CompileGHCOptions Name
-> (MenuField CompileGHCOptions Name
    -> MenuField CompileGHCOptions Name)
-> MenuField CompileGHCOptions Name
forall a b. a -> (a -> b) -> b
& Lens' (MenuField CompileGHCOptions Name) ErrorStatus
forall s n. Lens' (MenuField s n) ErrorStatus
Menu.fieldStatusL Lens' (MenuField CompileGHCOptions Name) ErrorStatus
-> ErrorStatus
-> MenuField CompileGHCOptions Name
-> MenuField CompileGHCOptions Name
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Text -> ErrorStatus
Menu.Invalid Text
"No version selected / no path specified"
             ]
        Maybe (NonEmpty Version)
_ -> [ Name
-> (Text -> Either Text (Either Version FilePath))
-> Lens' CompileGHCOptions (Either Version FilePath)
-> MenuField CompileGHCOptions 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.BootstrapGhcEditBox) Text -> Either Text (Either Version FilePath)
bootstrapV Lens' CompileGHCOptions (Either Version FilePath)
bootstrapGhc
               MenuField CompileGHCOptions Name
-> (MenuField CompileGHCOptions Name
    -> MenuField CompileGHCOptions Name)
-> MenuField CompileGHCOptions Name
forall a b. a -> (a -> b) -> b
& Lens' (MenuField CompileGHCOptions Name) Text
forall s n. Lens' (MenuField s n) Text
Menu.fieldLabelL Lens' (MenuField CompileGHCOptions Name) Text
-> Text
-> MenuField CompileGHCOptions Name
-> MenuField CompileGHCOptions Name
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Text
"bootstrap-ghc"
               MenuField CompileGHCOptions Name
-> (MenuField CompileGHCOptions Name
    -> MenuField CompileGHCOptions Name)
-> MenuField CompileGHCOptions Name
forall a b. a -> (a -> b) -> b
& Lens' (MenuField CompileGHCOptions Name) Text
forall s n. Lens' (MenuField s n) Text
Menu.fieldHelpMsgL Lens' (MenuField CompileGHCOptions Name) Text
-> Text
-> MenuField CompileGHCOptions Name
-> MenuField CompileGHCOptions Name
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Text
"The GHC version (or full path) to bootstrap with (must be installed)"
               MenuField CompileGHCOptions Name
-> (MenuField CompileGHCOptions Name
    -> MenuField CompileGHCOptions Name)
-> MenuField CompileGHCOptions Name
forall a b. a -> (a -> b) -> b
& Lens' (MenuField CompileGHCOptions Name) ErrorStatus
forall s n. Lens' (MenuField s n) ErrorStatus
Menu.fieldStatusL Lens' (MenuField CompileGHCOptions Name) ErrorStatus
-> ErrorStatus
-> MenuField CompileGHCOptions Name
-> MenuField CompileGHCOptions Name
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Text -> ErrorStatus
Menu.Invalid Text
"Invalid empty value"
             ]

    hadrianGHCFields :: [MenuField CompileGHCOptions Name]
hadrianGHCFields = case [Version] -> Maybe (NonEmpty Version)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [Version]
availableGHCs of
        Just NonEmpty Version
ne ->
          let hadrianGhc' :: Optic
  A_Lens
  '[]
  CompileGHCOptions
  CompileGHCOptions
  (Either (Maybe (Either Version FilePath)) b)
  (Either (Maybe (Either Version FilePath)) Version)
hadrianGhc' = Lens' CompileGHCOptions (Maybe (Either Version FilePath))
hadrianGhc Lens' CompileGHCOptions (Maybe (Either Version FilePath))
-> Optic
     An_Iso
     '[]
     (Maybe (Either Version FilePath))
     (Maybe (Either Version FilePath))
     (Either (Maybe (Either Version FilePath)) b)
     (Either (Maybe (Either Version FilePath)) Version)
-> Optic
     A_Lens
     '[]
     CompileGHCOptions
     CompileGHCOptions
     (Either (Maybe (Either Version FilePath)) b)
     (Either (Maybe (Either Version FilePath)) Version)
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
% ((Maybe (Either Version FilePath)
 -> Either (Maybe (Either Version FilePath)) b)
-> (Either (Maybe (Either Version FilePath)) Version
    -> Maybe (Either Version FilePath))
-> Optic
     An_Iso
     '[]
     (Maybe (Either Version FilePath))
     (Maybe (Either Version FilePath))
     (Either (Maybe (Either Version FilePath)) b)
     (Either (Maybe (Either Version FilePath)) Version)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Maybe (Either Version FilePath)
-> Either (Maybe (Either Version FilePath)) b
forall a b. a -> Either a b
Left ((Maybe (Either Version FilePath)
 -> Maybe (Either Version FilePath))
-> (Version -> Maybe (Either Version FilePath))
-> Either (Maybe (Either Version FilePath)) Version
-> Maybe (Either Version FilePath)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Maybe (Either Version FilePath) -> Maybe (Either Version FilePath)
forall a. a -> a
id (Either Version FilePath -> Maybe (Either Version FilePath)
forall a. a -> Maybe a
Just (Either Version FilePath -> Maybe (Either Version FilePath))
-> (Version -> Either Version FilePath)
-> Version
-> Maybe (Either Version FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> Either Version FilePath
forall a b. a -> Either a b
Left)))
          in [ Name
-> Name
-> Lens'
     CompileGHCOptions
     (Either (Maybe (Either Version FilePath)) Version)
-> (Text -> Either Text (Maybe (Either Version FilePath)))
-> NonEmpty Version
-> (Version -> Text)
-> MenuKeyBindings
-> MenuField CompileGHCOptions Name
forall n s a i.
(Ord n, Show n) =>
n
-> n
-> Lens' s (Either a i)
-> (Text -> Either Text a)
-> NonEmpty i
-> (i -> Text)
-> MenuKeyBindings
-> SelectField s n
Menu.createSelectFieldWithEditable (ResourceId -> Name
Common.MenuElement ResourceId
Common.HadrianGhcSelectBox) (ResourceId -> Name
Common.MenuElement ResourceId
Common.HadrianGhcEditBox) Lens'
  CompileGHCOptions
  (Either (Maybe (Either Version FilePath)) Version)
forall {b}.
Optic
  A_Lens
  '[]
  CompileGHCOptions
  CompileGHCOptions
  (Either (Maybe (Either Version FilePath)) b)
  (Either (Maybe (Either Version FilePath)) Version)
hadrianGhc' Text -> Either Text (Maybe (Either Version FilePath))
hadrianstrapV NonEmpty Version
ne (FilePath -> Text
T.pack (FilePath -> Text) -> (Version -> FilePath) -> Version -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow) MenuKeyBindings
k
               MenuField CompileGHCOptions Name
-> (MenuField CompileGHCOptions Name
    -> MenuField CompileGHCOptions Name)
-> MenuField CompileGHCOptions Name
forall a b. a -> (a -> b) -> b
& Lens' (MenuField CompileGHCOptions Name) Text
forall s n. Lens' (MenuField s n) Text
Menu.fieldLabelL Lens' (MenuField CompileGHCOptions Name) Text
-> Text
-> MenuField CompileGHCOptions Name
-> MenuField CompileGHCOptions Name
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Text
"hadrian-ghc"
               MenuField CompileGHCOptions Name
-> (MenuField CompileGHCOptions Name
    -> MenuField CompileGHCOptions Name)
-> MenuField CompileGHCOptions Name
forall a b. a -> (a -> b) -> b
& Lens' (MenuField CompileGHCOptions Name) Text
forall s n. Lens' (MenuField s n) Text
Menu.fieldHelpMsgL Lens' (MenuField CompileGHCOptions Name) Text
-> Text
-> MenuField CompileGHCOptions Name
-> MenuField CompileGHCOptions Name
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Text
"The GHC version (or full path) that will be used to compile hadrian (must be installed)"
             ]
        Maybe (NonEmpty Version)
_ -> [ Name
-> (Text -> Either Text (Maybe (Either Version FilePath)))
-> Lens' CompileGHCOptions (Maybe (Either Version FilePath))
-> MenuField CompileGHCOptions 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.HadrianGhcEditBox) Text -> Either Text (Maybe (Either Version FilePath))
hadrianstrapV Lens' CompileGHCOptions (Maybe (Either Version FilePath))
hadrianGhc
               MenuField CompileGHCOptions Name
-> (MenuField CompileGHCOptions Name
    -> MenuField CompileGHCOptions Name)
-> MenuField CompileGHCOptions Name
forall a b. a -> (a -> b) -> b
& Lens' (MenuField CompileGHCOptions Name) Text
forall s n. Lens' (MenuField s n) Text
Menu.fieldLabelL Lens' (MenuField CompileGHCOptions Name) Text
-> Text
-> MenuField CompileGHCOptions Name
-> MenuField CompileGHCOptions Name
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Text
"hadrian-ghc"
               MenuField CompileGHCOptions Name
-> (MenuField CompileGHCOptions Name
    -> MenuField CompileGHCOptions Name)
-> MenuField CompileGHCOptions Name
forall a b. a -> (a -> b) -> b
& Lens' (MenuField CompileGHCOptions Name) Text
forall s n. Lens' (MenuField s n) Text
Menu.fieldHelpMsgL Lens' (MenuField CompileGHCOptions Name) Text
-> Text
-> MenuField CompileGHCOptions Name
-> MenuField CompileGHCOptions Name
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Text
"The GHC version (or full path) that will be used to compile hadrian (must be installed)"
             ]

    fields :: [MenuField CompileGHCOptions Name]
fields = [MenuField CompileGHCOptions Name]
bootstrapGHCFields [MenuField CompileGHCOptions Name]
-> [MenuField CompileGHCOptions Name]
-> [MenuField CompileGHCOptions Name]
forall a. [a] -> [a] -> [a]
++ [MenuField CompileGHCOptions Name]
hadrianGHCFields [MenuField CompileGHCOptions Name]
-> [MenuField CompileGHCOptions Name]
-> [MenuField CompileGHCOptions Name]
forall a. [a] -> [a] -> [a]
++
      [ Name
-> (Text -> Either Text (Maybe Int))
-> Lens' CompileGHCOptions (Maybe Int)
-> MenuField CompileGHCOptions 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.JobsEditBox) Text -> Either Text (Maybe Int)
jobsV Lens' CompileGHCOptions (Maybe Int)
jobs
          MenuField CompileGHCOptions Name
-> (MenuField CompileGHCOptions Name
    -> MenuField CompileGHCOptions Name)
-> MenuField CompileGHCOptions Name
forall a b. a -> (a -> b) -> b
& Lens' (MenuField CompileGHCOptions Name) Text
forall s n. Lens' (MenuField s n) Text
Menu.fieldLabelL Lens' (MenuField CompileGHCOptions Name) Text
-> Text
-> MenuField CompileGHCOptions Name
-> MenuField CompileGHCOptions Name
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Text
"jobs"
          MenuField CompileGHCOptions Name
-> (MenuField CompileGHCOptions Name
    -> MenuField CompileGHCOptions Name)
-> MenuField CompileGHCOptions Name
forall a b. a -> (a -> b) -> b
& Lens' (MenuField CompileGHCOptions Name) Text
forall s n. Lens' (MenuField s n) Text
Menu.fieldHelpMsgL Lens' (MenuField CompileGHCOptions Name) Text
-> Text
-> MenuField CompileGHCOptions Name
-> MenuField CompileGHCOptions Name
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Text
"How many jobs to use for make"
      , Name
-> Lens' CompileGHCOptions Bool -> MenuField CompileGHCOptions Name
forall n s. n -> Lens' s Bool -> CheckBoxField s n
Menu.createCheckBoxField (ResourceId -> Name
Common.MenuElement ResourceId
Common.SetCheckBox) Lens' CompileGHCOptions Bool
setCompile
          MenuField CompileGHCOptions Name
-> (MenuField CompileGHCOptions Name
    -> MenuField CompileGHCOptions Name)
-> MenuField CompileGHCOptions Name
forall a b. a -> (a -> b) -> b
& Lens' (MenuField CompileGHCOptions Name) Text
forall s n. Lens' (MenuField s n) Text
Menu.fieldLabelL Lens' (MenuField CompileGHCOptions Name) Text
-> Text
-> MenuField CompileGHCOptions Name
-> MenuField CompileGHCOptions 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 CompileGHCOptions Name
-> (MenuField CompileGHCOptions Name
    -> MenuField CompileGHCOptions Name)
-> MenuField CompileGHCOptions Name
forall a b. a -> (a -> b) -> b
& Lens' (MenuField CompileGHCOptions Name) Text
forall s n. Lens' (MenuField s n) Text
Menu.fieldHelpMsgL Lens' (MenuField CompileGHCOptions Name) Text
-> Text
-> MenuField CompileGHCOptions Name
-> MenuField CompileGHCOptions 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 FilePath))
-> Lens' CompileGHCOptions (Maybe FilePath)
-> MenuField CompileGHCOptions 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.BuildFlavourEditBox) (Maybe FilePath -> Either Text (Maybe FilePath)
forall a b. b -> Either a b
Right (Maybe FilePath -> Either Text (Maybe FilePath))
-> (Text -> Maybe FilePath) -> Text -> Either Text (Maybe FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath)
-> (Text -> FilePath) -> Text -> Maybe FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack) Lens' CompileGHCOptions (Maybe FilePath)
buildFlavour
          MenuField CompileGHCOptions Name
-> (MenuField CompileGHCOptions Name
    -> MenuField CompileGHCOptions Name)
-> MenuField CompileGHCOptions Name
forall a b. a -> (a -> b) -> b
& Lens' (MenuField CompileGHCOptions Name) Text
forall s n. Lens' (MenuField s n) Text
Menu.fieldLabelL Lens' (MenuField CompileGHCOptions Name) Text
-> Text
-> MenuField CompileGHCOptions Name
-> MenuField CompileGHCOptions Name
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Text
"flavour"
          MenuField CompileGHCOptions Name
-> (MenuField CompileGHCOptions Name
    -> MenuField CompileGHCOptions Name)
-> MenuField CompileGHCOptions Name
forall a b. a -> (a -> b) -> b
& Lens' (MenuField CompileGHCOptions Name) Text
forall s n. Lens' (MenuField s n) Text
Menu.fieldHelpMsgL Lens' (MenuField CompileGHCOptions Name) Text
-> Text
-> MenuField CompileGHCOptions Name
-> MenuField CompileGHCOptions 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 the compile build flavour (this value depends on the build system type: 'make' vs 'hadrian')"
      , Name
-> (Text -> Either Text [Text])
-> Lens' CompileGHCOptions [Text]
-> MenuField CompileGHCOptions 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' CompileGHCOptions [Text]
addConfArgs
          MenuField CompileGHCOptions Name
-> (MenuField CompileGHCOptions Name
    -> MenuField CompileGHCOptions Name)
-> MenuField CompileGHCOptions Name
forall a b. a -> (a -> b) -> b
& Lens' (MenuField CompileGHCOptions Name) Text
forall s n. Lens' (MenuField s n) Text
Menu.fieldLabelL Lens' (MenuField CompileGHCOptions Name) Text
-> Text
-> MenuField CompileGHCOptions Name
-> MenuField CompileGHCOptions 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 CompileGHCOptions Name
-> (MenuField CompileGHCOptions Name
    -> MenuField CompileGHCOptions Name)
-> MenuField CompileGHCOptions Name
forall a b. a -> (a -> b) -> b
& Lens' (MenuField CompileGHCOptions Name) Text
forall s n. Lens' (MenuField s n) Text
Menu.fieldHelpMsgL Lens' (MenuField CompileGHCOptions Name) Text
-> Text
-> MenuField CompileGHCOptions Name
-> MenuField CompileGHCOptions 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 compile configure"
      , Name
-> (Text -> Either Text (Maybe FilePath))
-> Lens' CompileGHCOptions (Maybe FilePath)
-> MenuField CompileGHCOptions 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.BuildConfigEditBox) Text -> Either Text (Maybe FilePath)
filepathV Lens' CompileGHCOptions (Maybe FilePath)
buildConfig
          MenuField CompileGHCOptions Name
-> (MenuField CompileGHCOptions Name
    -> MenuField CompileGHCOptions Name)
-> MenuField CompileGHCOptions Name
forall a b. a -> (a -> b) -> b
& Lens' (MenuField CompileGHCOptions Name) Text
forall s n. Lens' (MenuField s n) Text
Menu.fieldLabelL Lens' (MenuField CompileGHCOptions Name) Text
-> Text
-> MenuField CompileGHCOptions Name
-> MenuField CompileGHCOptions Name
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Text
"build config"
          MenuField CompileGHCOptions Name
-> (MenuField CompileGHCOptions Name
    -> MenuField CompileGHCOptions Name)
-> MenuField CompileGHCOptions Name
forall a b. a -> (a -> b) -> b
& Lens' (MenuField CompileGHCOptions Name) Text
forall s n. Lens' (MenuField s n) Text
Menu.fieldHelpMsgL Lens' (MenuField CompileGHCOptions Name) Text
-> Text
-> MenuField CompileGHCOptions Name
-> MenuField CompileGHCOptions Name
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Text
"Absolute path to build config file (make build system only)"
      , Name
-> (Text -> Either Text (Maybe (Either FilePath [URI])))
-> Lens' CompileGHCOptions (Maybe (Either FilePath [URI]))
-> MenuField CompileGHCOptions 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.PatchesEditBox) Text -> Either Text (Maybe (Either FilePath [URI]))
patchesV Lens' CompileGHCOptions (Maybe (Either FilePath [URI]))
patches
          MenuField CompileGHCOptions Name
-> (MenuField CompileGHCOptions Name
    -> MenuField CompileGHCOptions Name)
-> MenuField CompileGHCOptions Name
forall a b. a -> (a -> b) -> b
& Lens' (MenuField CompileGHCOptions Name) Text
forall s n. Lens' (MenuField s n) Text
Menu.fieldLabelL Lens' (MenuField CompileGHCOptions Name) Text
-> Text
-> MenuField CompileGHCOptions Name
-> MenuField CompileGHCOptions Name
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Text
"patches"
          MenuField CompileGHCOptions Name
-> (MenuField CompileGHCOptions Name
    -> MenuField CompileGHCOptions Name)
-> MenuField CompileGHCOptions Name
forall a b. a -> (a -> b) -> b
& Lens' (MenuField CompileGHCOptions Name) Text
forall s n. Lens' (MenuField s n) Text
Menu.fieldHelpMsgL Lens' (MenuField CompileGHCOptions Name) Text
-> Text
-> MenuField CompileGHCOptions Name
-> MenuField CompileGHCOptions Name
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Text
"Either a URI to a patch (https/http/file) or Absolute path to patch directory"
      , Name
-> (Text -> Either Text (Maybe Text))
-> Lens' CompileGHCOptions (Maybe Text)
-> MenuField CompileGHCOptions 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.CrossTargetEditBox) (Maybe Text -> Either Text (Maybe Text)
forall a b. b -> Either a b
Right (Maybe Text -> Either Text (Maybe Text))
-> (Text -> Maybe Text) -> Text -> Either Text (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text
forall a. a -> Maybe a
Just) Lens' CompileGHCOptions (Maybe Text)
crossTarget
          MenuField CompileGHCOptions Name
-> (MenuField CompileGHCOptions Name
    -> MenuField CompileGHCOptions Name)
-> MenuField CompileGHCOptions Name
forall a b. a -> (a -> b) -> b
& Lens' (MenuField CompileGHCOptions Name) Text
forall s n. Lens' (MenuField s n) Text
Menu.fieldLabelL Lens' (MenuField CompileGHCOptions Name) Text
-> Text
-> MenuField CompileGHCOptions Name
-> MenuField CompileGHCOptions Name
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Text
"cross target"
          MenuField CompileGHCOptions Name
-> (MenuField CompileGHCOptions Name
    -> MenuField CompileGHCOptions Name)
-> MenuField CompileGHCOptions Name
forall a b. a -> (a -> b) -> b
& Lens' (MenuField CompileGHCOptions Name) Text
forall s n. Lens' (MenuField s n) Text
Menu.fieldHelpMsgL Lens' (MenuField CompileGHCOptions Name) Text
-> Text
-> MenuField CompileGHCOptions Name
-> MenuField CompileGHCOptions Name
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Text
"Build cross-compiler for this platform"
      , Name
-> Lens' CompileGHCOptions (Maybe (Maybe BuildSystem))
-> NonEmpty (Maybe BuildSystem)
-> (Maybe BuildSystem -> Text)
-> MenuKeyBindings
-> MenuField CompileGHCOptions Name
forall n s i.
(Ord n, Show n) =>
n
-> Lens' s (Maybe i)
-> NonEmpty i
-> (i -> Text)
-> MenuKeyBindings
-> SelectField s n
Menu.createSelectField (ResourceId -> Name
Common.MenuElement ResourceId
Common.BuildSystemEditBox) (Lens' CompileGHCOptions (Maybe BuildSystem)
buildSystem Lens' CompileGHCOptions (Maybe BuildSystem)
-> Optic
     An_Iso
     '[]
     (Maybe BuildSystem)
     (Maybe BuildSystem)
     (Maybe (Maybe BuildSystem))
     (Maybe (Maybe BuildSystem))
-> Lens' CompileGHCOptions (Maybe (Maybe BuildSystem))
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
% ((Maybe BuildSystem -> Maybe (Maybe BuildSystem))
-> (Maybe (Maybe BuildSystem) -> Maybe BuildSystem)
-> Optic
     An_Iso
     '[]
     (Maybe BuildSystem)
     (Maybe BuildSystem)
     (Maybe (Maybe BuildSystem))
     (Maybe (Maybe BuildSystem))
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Maybe BuildSystem -> Maybe (Maybe BuildSystem)
forall a. a -> Maybe a
Just Maybe (Maybe BuildSystem) -> Maybe BuildSystem
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join)) (Maybe BuildSystem
forall a. Maybe a
Nothing Maybe BuildSystem
-> [Maybe BuildSystem] -> NonEmpty (Maybe BuildSystem)
forall a. a -> [a] -> NonEmpty a
:| [BuildSystem -> Maybe BuildSystem
forall a. a -> Maybe a
Just BuildSystem
Hadrian, BuildSystem -> Maybe BuildSystem
forall a. a -> Maybe a
Just BuildSystem
Make]) Maybe BuildSystem -> Text
showMaybeBuildSystem  MenuKeyBindings
k
          MenuField CompileGHCOptions Name
-> (MenuField CompileGHCOptions Name
    -> MenuField CompileGHCOptions Name)
-> MenuField CompileGHCOptions Name
forall a b. a -> (a -> b) -> b
& Lens' (MenuField CompileGHCOptions Name) Text
forall s n. Lens' (MenuField s n) Text
Menu.fieldLabelL Lens' (MenuField CompileGHCOptions Name) Text
-> Text
-> MenuField CompileGHCOptions Name
-> MenuField CompileGHCOptions Name
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Text
"build system"
          MenuField CompileGHCOptions Name
-> (MenuField CompileGHCOptions Name
    -> MenuField CompileGHCOptions Name)
-> MenuField CompileGHCOptions Name
forall a b. a -> (a -> b) -> b
& Lens' (MenuField CompileGHCOptions Name) Text
forall s n. Lens' (MenuField s n) Text
Menu.fieldHelpMsgL Lens' (MenuField CompileGHCOptions Name) Text
-> Text
-> MenuField CompileGHCOptions Name
-> MenuField CompileGHCOptions Name
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Text
"Select the build system"
      , Name
-> (Text -> Either Text (Maybe [VersionPattern]))
-> Lens' CompileGHCOptions (Maybe [VersionPattern])
-> MenuField CompileGHCOptions 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.OvewrwiteVerEditBox) Text -> Either Text (Maybe [VersionPattern])
versionV Lens' CompileGHCOptions (Maybe [VersionPattern])
overwriteVer
          MenuField CompileGHCOptions Name
-> (MenuField CompileGHCOptions Name
    -> MenuField CompileGHCOptions Name)
-> MenuField CompileGHCOptions Name
forall a b. a -> (a -> b) -> b
& Lens' (MenuField CompileGHCOptions Name) Text
forall s n. Lens' (MenuField s n) Text
Menu.fieldLabelL Lens' (MenuField CompileGHCOptions Name) Text
-> Text
-> MenuField CompileGHCOptions Name
-> MenuField CompileGHCOptions Name
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Text
"overwrite-version"
          MenuField CompileGHCOptions Name
-> (MenuField CompileGHCOptions Name
    -> MenuField CompileGHCOptions Name)
-> MenuField CompileGHCOptions Name
forall a b. a -> (a -> b) -> b
& Lens' (MenuField CompileGHCOptions Name) Text
forall s n. Lens' (MenuField s n) Text
Menu.fieldHelpMsgL Lens' (MenuField CompileGHCOptions Name) Text
-> Text
-> MenuField CompileGHCOptions Name
-> MenuField CompileGHCOptions Name
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Text
"Allows to overwrite the finally installed VERSION with a different one. Allows to specify patterns: %v (version), %b (branch name), %h (short commit hash), %H (long commit hash), %g ('git describe' output)"
      , Name
-> (Text -> Either Text (Maybe FilePath))
-> Lens' CompileGHCOptions (Maybe FilePath)
-> MenuField CompileGHCOptions 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)
filepathV Lens' CompileGHCOptions (Maybe FilePath)
isolateDir
          MenuField CompileGHCOptions Name
-> (MenuField CompileGHCOptions Name
    -> MenuField CompileGHCOptions Name)
-> MenuField CompileGHCOptions Name
forall a b. a -> (a -> b) -> b
& Lens' (MenuField CompileGHCOptions Name) Text
forall s n. Lens' (MenuField s n) Text
Menu.fieldLabelL Lens' (MenuField CompileGHCOptions Name) Text
-> Text
-> MenuField CompileGHCOptions Name
-> MenuField CompileGHCOptions 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 CompileGHCOptions Name
-> (MenuField CompileGHCOptions Name
    -> MenuField CompileGHCOptions Name)
-> MenuField CompileGHCOptions Name
forall a b. a -> (a -> b) -> b
& Lens' (MenuField CompileGHCOptions Name) Text
forall s n. Lens' (MenuField s n) Text
Menu.fieldHelpMsgL Lens' (MenuField CompileGHCOptions Name) Text
-> Text
-> MenuField CompileGHCOptions Name
-> MenuField CompileGHCOptions 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
-> (Text -> Either Text (Maybe FilePath))
-> Lens' CompileGHCOptions (Maybe FilePath)
-> MenuField CompileGHCOptions 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.GitRefEditBox) (Maybe FilePath -> Either Text (Maybe FilePath)
forall a b. b -> Either a b
Right (Maybe FilePath -> Either Text (Maybe FilePath))
-> (Text -> Maybe FilePath) -> Text -> Either Text (Maybe FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath)
-> (Text -> FilePath) -> Text -> Maybe FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack) Lens' CompileGHCOptions (Maybe FilePath)
gitRef
          MenuField CompileGHCOptions Name
-> (MenuField CompileGHCOptions Name
    -> MenuField CompileGHCOptions Name)
-> MenuField CompileGHCOptions Name
forall a b. a -> (a -> b) -> b
& Lens' (MenuField CompileGHCOptions Name) Text
forall s n. Lens' (MenuField s n) Text
Menu.fieldLabelL Lens' (MenuField CompileGHCOptions Name) Text
-> Text
-> MenuField CompileGHCOptions Name
-> MenuField CompileGHCOptions Name
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Text
"git-ref"
          MenuField CompileGHCOptions Name
-> (MenuField CompileGHCOptions Name
    -> MenuField CompileGHCOptions Name)
-> MenuField CompileGHCOptions Name
forall a b. a -> (a -> b) -> b
& Lens' (MenuField CompileGHCOptions Name) Text
forall s n. Lens' (MenuField s n) Text
Menu.fieldHelpMsgL Lens' (MenuField CompileGHCOptions Name) Text
-> Text
-> MenuField CompileGHCOptions Name
-> MenuField CompileGHCOptions Name
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Text
"The git commit/branch/ref to build from"
      , Text
-> Name
-> (Text -> Either Text Text)
-> Lens' CompileGHCOptions Text
-> MenuField CompileGHCOptions 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' CompileGHCOptions Text
installTargets
          MenuField CompileGHCOptions Name
-> (MenuField CompileGHCOptions Name
    -> MenuField CompileGHCOptions Name)
-> MenuField CompileGHCOptions Name
forall a b. a -> (a -> b) -> b
& Lens' (MenuField CompileGHCOptions Name) Text
forall s n. Lens' (MenuField s n) Text
Menu.fieldLabelL Lens' (MenuField CompileGHCOptions Name) Text
-> Text
-> MenuField CompileGHCOptions Name
-> MenuField CompileGHCOptions 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 CompileGHCOptions Name
-> (MenuField CompileGHCOptions Name
    -> MenuField CompileGHCOptions Name)
-> MenuField CompileGHCOptions Name
forall a b. a -> (a -> b) -> b
& Lens' (MenuField CompileGHCOptions Name) Text
forall s n. Lens' (MenuField s n) Text
Menu.fieldHelpMsgL Lens' (MenuField CompileGHCOptions Name) Text
-> Text
-> MenuField CompileGHCOptions Name
-> MenuField CompileGHCOptions 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"
      ]

    buttons :: [MenuField s Name]
buttons = [
       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
"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 with options below\nRequired fields: bootstrap-ghc"
           MenuField s Name
-> (MenuField s Name -> MenuField s Name) -> MenuField s Name
forall a b. a -> (a -> b) -> b
& Lens' (MenuField s Name) ErrorStatus
forall s n. Lens' (MenuField s n) ErrorStatus
Menu.fieldStatusL Lens' (MenuField s Name) ErrorStatus
-> ErrorStatus -> 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 -> ErrorStatus
Menu.Invalid Text
"bootstrap GHC is mandatory"
      ]

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


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