{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# OPTIONS_GHC -Wno-unused-record-wildcards #-}
{-# OPTIONS_GHC -Wno-unused-matches #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module GHCup.BrickMain where
import GHCup.List ( ListResult (..))
import GHCup.Types
( Settings(noColor), Tool (GHC),
AppState(ghcupInfo, settings, keyBindings, loggerConfig), KeyBindings(..) )
import GHCup.Prelude.Logger ( logError )
import qualified GHCup.Brick.Actions as Actions
import qualified GHCup.Brick.Common as Common
import qualified GHCup.Brick.App as BrickApp
import qualified GHCup.Brick.Attributes as Attributes
import qualified GHCup.Brick.BrickState as AppState
import qualified GHCup.Brick.Widgets.Menus.Context as ContextMenu
import qualified GHCup.Brick.Widgets.SectionList as Navigation
import qualified GHCup.Brick.Widgets.Menus.AdvanceInstall as AdvanceInstall
import qualified GHCup.Brick.Widgets.Menus.CompileGHC as CompileGHC
import GHCup.Brick.Widgets.Menu (MenuKeyBindings(..))
import qualified Brick
import qualified Graphics.Vty as Vty
import Control.Monad.Reader ( ReaderT(runReaderT) )
import Data.Functor ( ($>) )
import Data.IORef (writeIORef)
import Prelude hiding ( appendFile )
import System.Exit ( ExitCode(ExitFailure), exitWith )
import qualified Data.Text as T
import qualified GHCup.Brick.Widgets.Menus.CompileHLS as CompileHLS
brickMain :: AppState
-> IO ()
brickMain :: AppState -> IO ()
brickMain AppState
s = do
IORef AppState -> AppState -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef AppState
Actions.settings' AppState
s
Either String BrickData
eAppData <- Maybe GHCupInfo -> IO (Either String BrickData)
Actions.getAppData (GHCupInfo -> Maybe GHCupInfo
forall a. a -> Maybe a
Just (GHCupInfo -> Maybe GHCupInfo) -> GHCupInfo -> Maybe GHCupInfo
forall a b. (a -> b) -> a -> b
$ AppState -> GHCupInfo
ghcupInfo AppState
s)
case Either String BrickData
eAppData of
Right BrickData
ad -> do
let initial_list :: BrickInternalState
initial_list = BrickData
-> BrickSettings -> Maybe BrickInternalState -> BrickInternalState
Actions.constructList BrickData
ad BrickSettings
Common.defaultAppSettings Maybe BrickInternalState
forall a. Maybe a
Nothing
current_element :: Maybe (Int, ListResult)
current_element = BrickInternalState -> Maybe (Int, ListResult)
forall n (t :: * -> *) e.
(Eq n, Splittable t, Traversable t, Semigroup (t e)) =>
GenericSectionList n t e -> Maybe (Int, e)
Navigation.sectionListSelectedElement BrickInternalState
initial_list
exit_key :: MenuKeyBindings
exit_key =
let KeyBindings {KeyCombination
bUp :: KeyCombination
bDown :: KeyCombination
bQuit :: KeyCombination
bInstall :: KeyCombination
bUninstall :: KeyCombination
bSet :: KeyCombination
bChangelog :: KeyCombination
bShowAllVersions :: KeyCombination
bChangelog :: KeyBindings -> KeyCombination
bDown :: KeyBindings -> KeyCombination
bInstall :: KeyBindings -> KeyCombination
bQuit :: KeyBindings -> KeyCombination
bSet :: KeyBindings -> KeyCombination
bShowAllVersions :: KeyBindings -> KeyCombination
bUninstall :: KeyBindings -> KeyCombination
bUp :: KeyBindings -> KeyCombination
..} = AppState -> KeyBindings
keyBindings AppState
s
in MenuKeyBindings { mKbUp :: KeyCombination
mKbUp = KeyCombination
bUp, mKbDown :: KeyCombination
mKbDown = KeyCombination
bDown, mKbQuit :: KeyCombination
mKbQuit = KeyCombination
bQuit}
case Maybe (Int, ListResult)
current_element of
Maybe (Int, ListResult)
Nothing -> do
(ReaderT AppState IO () -> AppState -> IO ())
-> AppState -> ReaderT AppState IO () -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT AppState IO () -> AppState -> IO ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT AppState
s (ReaderT AppState IO () -> IO ())
-> ReaderT AppState IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> ReaderT AppState IO ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logError Text
"Error building app state: empty ResultList"
ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith (ExitCode -> IO ()) -> ExitCode -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> ExitCode
ExitFailure Int
2
Just (Int
_, ListResult
e) ->
let initapp :: App BrickState () Name
initapp =
AttrMap -> AttrMap -> App BrickState () Name
BrickApp.app
(Bool -> AttrMap
Attributes.defaultAttributes (Bool -> AttrMap) -> Bool -> AttrMap
forall a b. (a -> b) -> a -> b
$ Settings -> Bool
noColor (Settings -> Bool) -> Settings -> Bool
forall a b. (a -> b) -> a -> b
$ AppState -> Settings
settings AppState
s)
(Bool -> AttrMap
Attributes.dimAttributes (Bool -> AttrMap) -> Bool -> AttrMap
forall a b. (a -> b) -> a -> b
$ Settings -> Bool
noColor (Settings -> Bool) -> Settings -> Bool
forall a b. (a -> b) -> a -> b
$ AppState -> Settings
settings AppState
s)
installedGHCs :: [Version]
installedGHCs = (ListResult -> Version) -> [ListResult] -> [Version]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ListResult -> Version
lVer ([ListResult] -> [Version]) -> [ListResult] -> [Version]
forall a b. (a -> b) -> a -> b
$
(ListResult -> Bool) -> [ListResult] -> [ListResult]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(ListResult {Bool
[Tag]
Maybe Text
Maybe Day
Version
Tool
lVer :: ListResult -> Version
lTool :: Tool
lVer :: Version
lCross :: Maybe Text
lTag :: [Tag]
lInstalled :: Bool
lSet :: Bool
lStray :: Bool
lNoBindist :: Bool
hlsPowered :: Bool
lReleaseDay :: Maybe Day
hlsPowered :: ListResult -> Bool
lCross :: ListResult -> Maybe Text
lInstalled :: ListResult -> Bool
lNoBindist :: ListResult -> Bool
lReleaseDay :: ListResult -> Maybe Day
lSet :: ListResult -> Bool
lStray :: ListResult -> Bool
lTag :: ListResult -> [Tag]
lTool :: ListResult -> Tool
..}) -> Bool
lInstalled Bool -> Bool -> Bool
&& Tool
lTool Tool -> Tool -> Bool
forall a. Eq a => a -> a -> Bool
== Tool
GHC Bool -> Bool -> Bool
&& Maybe Text
lCross Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Text
forall a. Maybe a
Nothing) (BrickData -> [ListResult]
Common._lr BrickData
ad)
initstate :: BrickState
initstate =
BrickData
-> BrickSettings
-> BrickInternalState
-> ContextMenu
-> AdvanceInstallMenu
-> CompileGHCMenu
-> CompileHLSMenu
-> KeyBindings
-> Mode
-> BrickState
AppState.BrickState BrickData
ad
BrickSettings
Common.defaultAppSettings
BrickInternalState
initial_list
(ListResult -> MenuKeyBindings -> ContextMenu
ContextMenu.create ListResult
e MenuKeyBindings
exit_key)
(MenuKeyBindings -> AdvanceInstallMenu
AdvanceInstall.create MenuKeyBindings
exit_key)
(MenuKeyBindings -> [Version] -> CompileGHCMenu
CompileGHC.create MenuKeyBindings
exit_key [Version]
installedGHCs)
(MenuKeyBindings -> [Version] -> CompileHLSMenu
CompileHLS.create MenuKeyBindings
exit_key [Version]
installedGHCs)
(AppState -> KeyBindings
keyBindings AppState
s)
Mode
Common.Navigation
in App BrickState () Name -> BrickState -> IO BrickState
forall n s e. Ord n => App s e n -> s -> IO s
Brick.defaultMain App BrickState () Name
initapp BrickState
initstate
IO BrickState -> () -> IO ()
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ()
Left String
e -> do
(ReaderT AppState IO () -> AppState -> IO ())
-> AppState -> ReaderT AppState IO () -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT AppState IO () -> AppState -> IO ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT AppState
s (ReaderT AppState IO () -> IO ())
-> ReaderT AppState IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> ReaderT AppState IO ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logError (Text -> ReaderT AppState IO ()) -> Text -> ReaderT AppState IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Error building app state: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (String -> String
forall a. Show a => a -> String
show String
e)
ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith (ExitCode -> IO ()) -> ExitCode -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> ExitCode
ExitFailure Int
2