Compare commits
11 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
| 486a1bac25 | |||
| a73ce186b5 | |||
| 76204aa366 | |||
| 502f0ea62f | |||
| e7e6663017 | |||
| e27fed09f3 | |||
| 9eeac00714 | |||
| c0ffb22d6a | |||
| f0b145d8dd | |||
| bb700281a3 | |||
|
|
fcdec4ba2c |
@@ -5,7 +5,6 @@
|
|||||||
{-# LANGUAGE TypeApplications #-}
|
{-# LANGUAGE TypeApplications #-}
|
||||||
{-# LANGUAGE RankNTypes #-}
|
{-# LANGUAGE RankNTypes #-}
|
||||||
{-# LANGUAGE ViewPatterns #-}
|
{-# LANGUAGE ViewPatterns #-}
|
||||||
{-# LANGUAGE TemplateHaskell #-}
|
|
||||||
|
|
||||||
module BrickMain where
|
module BrickMain where
|
||||||
|
|
||||||
@@ -26,7 +25,6 @@ import Brick
|
|||||||
import Brick.Widgets.Border
|
import Brick.Widgets.Border
|
||||||
import Brick.Widgets.Border.Style
|
import Brick.Widgets.Border.Style
|
||||||
import Brick.Widgets.Center
|
import Brick.Widgets.Center
|
||||||
import Brick.Widgets.Dialog (buttonSelectedAttr)
|
|
||||||
import Brick.Widgets.List ( listSelectedFocusedAttr
|
import Brick.Widgets.List ( listSelectedFocusedAttr
|
||||||
, listSelectedAttr
|
, listSelectedAttr
|
||||||
, listAttr
|
, listAttr
|
||||||
@@ -43,11 +41,11 @@ import Data.Bool
|
|||||||
import Data.Functor
|
import Data.Functor
|
||||||
import Data.List
|
import Data.List
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Data.IORef (IORef, readIORef, newIORef, writeIORef, modifyIORef)
|
import Data.IORef
|
||||||
import Data.Vector ( Vector
|
import Data.Vector ( Vector
|
||||||
, (!?)
|
, (!?)
|
||||||
)
|
)
|
||||||
import Data.Versions hiding ( str, Lens' )
|
import Data.Versions hiding ( str )
|
||||||
import Haskus.Utils.Variant.Excepts
|
import Haskus.Utils.Variant.Excepts
|
||||||
import Prelude hiding ( appendFile )
|
import Prelude hiding ( appendFile )
|
||||||
import System.FilePath
|
import System.FilePath
|
||||||
@@ -63,84 +61,68 @@ import qualified Graphics.Vty as Vty
|
|||||||
import qualified Data.Vector as V
|
import qualified Data.Vector as V
|
||||||
import System.Environment (getExecutablePath)
|
import System.Environment (getExecutablePath)
|
||||||
import qualified System.Posix.Process as SPP
|
import qualified System.Posix.Process as SPP
|
||||||
import Lens.Micro.TH (makeLenses)
|
|
||||||
import Lens.Micro.Mtl ( (.=), use, (%=), view )
|
|
||||||
import Lens.Micro ((.~), (&))
|
|
||||||
|
|
||||||
hiddenTools :: [Tool]
|
hiddenTools :: [Tool]
|
||||||
hiddenTools = []
|
hiddenTools = []
|
||||||
|
|
||||||
|
|
||||||
data BrickData = BrickData
|
data BrickData = BrickData
|
||||||
{ _lr :: [ListResult]
|
{ lr :: [ListResult]
|
||||||
}
|
}
|
||||||
deriving Show
|
deriving Show
|
||||||
|
|
||||||
makeLenses ''BrickData
|
|
||||||
|
|
||||||
data BrickSettings = BrickSettings
|
data BrickSettings = BrickSettings
|
||||||
{ _showAllVersions :: Bool
|
{ showAllVersions :: Bool
|
||||||
, _showAllTools :: Bool
|
, showAllTools :: Bool
|
||||||
}
|
}
|
||||||
--deriving Show
|
deriving Show
|
||||||
|
|
||||||
makeLenses ''BrickSettings
|
|
||||||
|
|
||||||
data BrickInternalState = BrickInternalState
|
data BrickInternalState = BrickInternalState
|
||||||
{ _clr :: Vector ListResult
|
{ clr :: Vector ListResult
|
||||||
, _ix :: Int
|
, ix :: Int
|
||||||
}
|
}
|
||||||
--deriving Show
|
deriving Show
|
||||||
|
|
||||||
makeLenses ''BrickInternalState
|
|
||||||
|
|
||||||
data BrickState = BrickState
|
data BrickState = BrickState
|
||||||
{ _appData :: BrickData
|
{ appData :: BrickData
|
||||||
, _appSettings :: BrickSettings
|
, appSettings :: BrickSettings
|
||||||
, _appState :: BrickInternalState
|
, appState :: BrickInternalState
|
||||||
, _appKeys :: KeyBindings
|
, appKeys :: KeyBindings
|
||||||
}
|
}
|
||||||
--deriving Show
|
deriving Show
|
||||||
|
|
||||||
makeLenses ''BrickState
|
|
||||||
|
|
||||||
keyHandlers :: KeyBindings
|
keyHandlers :: KeyBindings
|
||||||
-> [ ( Vty.Key
|
-> [ ( Vty.Key
|
||||||
, BrickSettings -> String
|
, BrickSettings -> String
|
||||||
, EventM String BrickState ()
|
, BrickState -> EventM String BrickState ()
|
||||||
)
|
)
|
||||||
]
|
]
|
||||||
keyHandlers KeyBindings {..} =
|
keyHandlers KeyBindings {..} =
|
||||||
[ (bQuit, const "Quit" , halt)
|
[ (bQuit, const "Quit" , \_ -> halt)
|
||||||
, (bInstall, const "Install" , withIOAction install')
|
, (bInstall, const "Install" , withIOAction install')
|
||||||
, (bUninstall, const "Uninstall", withIOAction del')
|
, (bUninstall, const "Uninstall", withIOAction del')
|
||||||
, (bSet, const "Set" , withIOAction set')
|
, (bSet, const "Set" , withIOAction set')
|
||||||
, (bChangelog, const "ChangeLog", withIOAction changelog')
|
, (bChangelog, const "ChangeLog", withIOAction changelog')
|
||||||
, ( bShowAllVersions
|
, ( bShowAllVersions
|
||||||
, \BrickSettings {..} ->
|
, \BrickSettings {..} ->
|
||||||
if _showAllVersions then "Don't show all versions" else "Show all versions"
|
if showAllVersions then "Don't show all versions" else "Show all versions"
|
||||||
, hideShowHandler' (not . _showAllVersions) _showAllTools
|
, hideShowHandler (not . showAllVersions) showAllTools
|
||||||
)
|
)
|
||||||
, ( bShowAllTools
|
, ( bShowAllTools
|
||||||
, \BrickSettings {..} ->
|
, \BrickSettings {..} ->
|
||||||
if _showAllTools then "Don't show all tools" else "Show all tools"
|
if showAllTools then "Don't show all tools" else "Show all tools"
|
||||||
, hideShowHandler' _showAllVersions (not . _showAllTools)
|
, hideShowHandler showAllVersions (not . showAllTools)
|
||||||
)
|
)
|
||||||
, (bUp, const "Up", appState %= moveCursor 1 Up)
|
, (bUp, const "Up", \BrickState {..} -> put BrickState{ appState = moveCursor 1 appState Up, .. })
|
||||||
, (bDown, const "Down", appState %= moveCursor 1 Down)
|
, (bDown, const "Down", \BrickState {..} -> put BrickState{ appState = moveCursor 1 appState Down, .. })
|
||||||
]
|
]
|
||||||
where
|
where
|
||||||
--hideShowHandler' :: (BrickSettings -> Bool) -> (BrickSettings -> Bool) -> m ()
|
hideShowHandler f p BrickState{..} =
|
||||||
hideShowHandler' f p = do
|
let newAppSettings = appSettings { showAllVersions = f appSettings , showAllTools = p appSettings }
|
||||||
app_settings <- use appSettings
|
newInternalState = constructList appData newAppSettings (Just appState)
|
||||||
let
|
in put (BrickState appData newAppSettings newInternalState appKeys)
|
||||||
vers = f app_settings
|
|
||||||
tools = p app_settings
|
|
||||||
newAppSettings = app_settings & showAllVersions .~ vers & showAllTools .~ tools
|
|
||||||
ad <- use appData
|
|
||||||
current_app_state <- use appState
|
|
||||||
appSettings .= newAppSettings
|
|
||||||
appState .= constructList ad app_settings (Just current_app_state)
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
showKey :: Vty.Key -> String
|
showKey :: Vty.Key -> String
|
||||||
@@ -149,12 +131,13 @@ showKey Vty.KUp = "↑"
|
|||||||
showKey Vty.KDown = "↓"
|
showKey Vty.KDown = "↓"
|
||||||
showKey key = tail (show key)
|
showKey key = tail (show key)
|
||||||
|
|
||||||
|
|
||||||
ui :: AttrMap -> BrickState -> Widget String
|
ui :: AttrMap -> BrickState -> Widget String
|
||||||
ui dimAttrs BrickState{ _appSettings = as@BrickSettings{}, ..}
|
ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
|
||||||
= padBottom Max
|
= padBottom Max
|
||||||
( withBorderStyle unicode
|
( withBorderStyle unicode
|
||||||
$ borderWithLabel (str "GHCup")
|
$ borderWithLabel (str "GHCup")
|
||||||
(center (header <=> hBorder <=> renderList' _appState))
|
(center (header <=> hBorder <=> renderList' appState))
|
||||||
)
|
)
|
||||||
<=> footer
|
<=> footer
|
||||||
|
|
||||||
@@ -165,7 +148,7 @@ ui dimAttrs BrickState{ _appSettings = as@BrickSettings{}, ..}
|
|||||||
. T.pack
|
. T.pack
|
||||||
. foldr1 (\x y -> x <> " " <> y)
|
. foldr1 (\x y -> x <> " " <> y)
|
||||||
. fmap (\(key, s, _) -> showKey key <> ":" <> s as)
|
. fmap (\(key, s, _) -> showKey key <> ":" <> s as)
|
||||||
$ keyHandlers _appKeys
|
$ keyHandlers appKeys
|
||||||
header =
|
header =
|
||||||
minHSize 2 emptyWidget
|
minHSize 2 emptyWidget
|
||||||
<+> padLeft (Pad 2) (minHSize 6 $ str "Tool")
|
<+> padLeft (Pad 2) (minHSize 6 $ str "Tool")
|
||||||
@@ -173,8 +156,8 @@ ui dimAttrs BrickState{ _appSettings = as@BrickSettings{}, ..}
|
|||||||
<+> padLeft (Pad 1) (minHSize 25 $ str "Tags")
|
<+> padLeft (Pad 1) (minHSize 25 $ str "Tags")
|
||||||
<+> padLeft (Pad 5) (str "Notes")
|
<+> padLeft (Pad 5) (str "Notes")
|
||||||
renderList' bis@BrickInternalState{..} =
|
renderList' bis@BrickInternalState{..} =
|
||||||
let minTagSize = V.maximum $ V.map (length . intercalate "," . fmap tagToString . lTag) _clr
|
let minTagSize = V.maximum $ V.map (length . intercalate "," . fmap tagToString . lTag) clr
|
||||||
minVerSize = V.maximum $ V.map (\ListResult{..} -> T.length $ tVerToText (GHCTargetVersion lCross lVer)) _clr
|
minVerSize = V.maximum $ V.map (\ListResult{..} -> T.length $ tVerToText (GHCTargetVersion lCross lVer)) clr
|
||||||
in withDefAttr listAttr . drawListElements (renderItem minTagSize minVerSize) True $ bis
|
in withDefAttr listAttr . drawListElements (renderItem minTagSize minVerSize) True $ bis
|
||||||
renderItem minTagSize minVerSize _ b listResult@ListResult{lTag = lTag', ..} =
|
renderItem minTagSize minVerSize _ b listResult@ListResult{lTag = lTag', ..} =
|
||||||
let marks = if
|
let marks = if
|
||||||
@@ -280,10 +263,11 @@ ui dimAttrs BrickState{ _appSettings = as@BrickSettings{}, ..}
|
|||||||
minHSize :: Int -> Widget n -> Widget n
|
minHSize :: Int -> Widget n -> Widget n
|
||||||
minHSize s' = hLimit s' . vLimit 1 . (<+> fill ' ')
|
minHSize s' = hLimit s' . vLimit 1 . (<+> fill ' ')
|
||||||
|
|
||||||
app :: AttrMap -> AttrMap -> App BrickState () String
|
|
||||||
|
app :: AttrMap -> AttrMap -> App BrickState e String
|
||||||
app attrs dimAttrs =
|
app attrs dimAttrs =
|
||||||
App { appDraw = \st -> [ui dimAttrs st]
|
App { appDraw = \st -> [ui dimAttrs st]
|
||||||
, appHandleEvent = eventHandler
|
, appHandleEvent = \be -> get >>= \s -> eventHandler s be
|
||||||
, appStartEvent = return ()
|
, appStartEvent = return ()
|
||||||
, appAttrMap = const attrs
|
, appAttrMap = const attrs
|
||||||
, appChooseCursor = showFirstCursor
|
, appChooseCursor = showFirstCursor
|
||||||
@@ -308,7 +292,6 @@ defaultAttributes no_color = attrMap
|
|||||||
, (attrName "day" , Vty.defAttr `withForeColor` Vty.blue)
|
, (attrName "day" , Vty.defAttr `withForeColor` Vty.blue)
|
||||||
, (attrName "help" , Vty.defAttr `withStyle` Vty.italic)
|
, (attrName "help" , Vty.defAttr `withStyle` Vty.italic)
|
||||||
, (attrName "hooray" , Vty.defAttr `withForeColor` Vty.brightWhite)
|
, (attrName "hooray" , Vty.defAttr `withForeColor` Vty.brightWhite)
|
||||||
, (buttonSelectedAttr , Vty.defAttr `withBackColor` Vty.brightWhite)
|
|
||||||
]
|
]
|
||||||
where
|
where
|
||||||
withForeColor | no_color = const
|
withForeColor | no_color = const
|
||||||
@@ -329,51 +312,56 @@ dimAttributes no_color = attrMap
|
|||||||
withBackColor | no_color = \attr _ -> attr `Vty.withStyle` Vty.reverseVideo
|
withBackColor | no_color = \attr _ -> attr `Vty.withStyle` Vty.reverseVideo
|
||||||
| otherwise = Vty.withBackColor
|
| otherwise = Vty.withBackColor
|
||||||
|
|
||||||
eventHandler :: BrickEvent String e -> EventM String BrickState ()
|
eventHandler :: BrickState -> BrickEvent String e -> EventM String BrickState ()
|
||||||
eventHandler ev = do
|
eventHandler st@BrickState{..} ev = do
|
||||||
AppState { keyBindings = kb } <- liftIO $ readIORef settings'
|
AppState { keyBindings = kb } <- liftIO $ readIORef settings'
|
||||||
case ev of
|
case ev of
|
||||||
(MouseDown _ Vty.BScrollUp _ _) -> appState %= moveCursor 1 Up
|
(MouseDown _ Vty.BScrollUp _ _) ->
|
||||||
(MouseDown _ Vty.BScrollDown _ _) -> appState %= moveCursor 1 Down
|
put (BrickState { appState = moveCursor 1 appState Up, .. })
|
||||||
(VtyEvent (Vty.EvResize _ _)) -> pure ()
|
(MouseDown _ Vty.BScrollDown _ _) ->
|
||||||
(VtyEvent (Vty.EvKey Vty.KUp _)) -> appState %= moveCursor 1 Up
|
put (BrickState { appState = moveCursor 1 appState Down, .. })
|
||||||
(VtyEvent (Vty.EvKey Vty.KDown _)) -> appState %= moveCursor 1 Down
|
(VtyEvent (Vty.EvResize _ _)) -> put st
|
||||||
|
(VtyEvent (Vty.EvKey Vty.KUp _)) ->
|
||||||
|
put BrickState{ appState = moveCursor 1 appState Up, .. }
|
||||||
|
(VtyEvent (Vty.EvKey Vty.KDown _)) ->
|
||||||
|
put BrickState{ appState = moveCursor 1 appState Down, .. }
|
||||||
(VtyEvent (Vty.EvKey key _)) ->
|
(VtyEvent (Vty.EvKey key _)) ->
|
||||||
case find (\(key', _, _) -> key' == key) (keyHandlers kb) of
|
case find (\(key', _, _) -> key' == key) (keyHandlers kb) of
|
||||||
Nothing -> pure ()
|
Nothing -> put st
|
||||||
Just (_, _, handler) -> handler
|
Just (_, _, handler) -> handler st
|
||||||
_ -> pure ()
|
_ -> put st
|
||||||
|
|
||||||
|
|
||||||
moveCursor :: Int -> Direction -> BrickInternalState -> BrickInternalState
|
moveCursor :: Int -> BrickInternalState -> Direction -> BrickInternalState
|
||||||
moveCursor steps direction ais@BrickInternalState{..} =
|
moveCursor steps ais@BrickInternalState{..} direction =
|
||||||
let newIx = if direction == Down then _ix + steps else _ix - steps
|
let newIx = if direction == Down then ix + steps else ix - steps
|
||||||
in case _clr !? newIx of
|
in case clr !? newIx of
|
||||||
Just _ -> ais & ix .~ newIx
|
Just _ -> BrickInternalState { ix = newIx, .. }
|
||||||
Nothing -> ais
|
Nothing -> ais
|
||||||
|
|
||||||
|
|
||||||
-- | Suspend the current UI and run an IO action in terminal. If the
|
-- | Suspend the current UI and run an IO action in terminal. If the
|
||||||
-- IO action returns a Left value, then it's thrown as userError.
|
-- IO action returns a Left value, then it's thrown as userError.
|
||||||
withIOAction :: Ord n
|
withIOAction :: Ord n
|
||||||
=> ( (Int, ListResult) -> ReaderT AppState IO (Either String a))
|
=> (BrickState
|
||||||
|
-> (Int, ListResult)
|
||||||
|
-> ReaderT AppState IO (Either String a))
|
||||||
|
-> BrickState
|
||||||
-> EventM n BrickState ()
|
-> EventM n BrickState ()
|
||||||
withIOAction action = do
|
withIOAction action as = case listSelectedElement' (appState as) of
|
||||||
as <- get
|
Nothing -> put as
|
||||||
case listSelectedElement' (view appState as) of
|
Just (ix, e) -> do
|
||||||
Nothing -> pure ()
|
suspendAndResume $ do
|
||||||
Just (curr_ix, e) -> do
|
settings <- readIORef settings'
|
||||||
suspendAndResume $ do
|
flip runReaderT settings $ action as (ix, e) >>= \case
|
||||||
settings <- readIORef settings'
|
Left err -> liftIO $ putStrLn ("Error: " <> err)
|
||||||
flip runReaderT settings $ action (curr_ix, e) >>= \case
|
Right _ -> liftIO $ putStrLn "Success"
|
||||||
Left err -> liftIO $ putStrLn ("Error: " <> err)
|
getAppData Nothing >>= \case
|
||||||
Right _ -> liftIO $ putStrLn "Success"
|
Right data' -> do
|
||||||
getAppData Nothing >>= \case
|
putStrLn "Press enter to continue"
|
||||||
Right data' -> do
|
_ <- getLine
|
||||||
putStrLn "Press enter to continue"
|
pure (updateList data' as)
|
||||||
_ <- getLine
|
Left err -> throwIO $ userError err
|
||||||
pure (updateList data' as)
|
|
||||||
Left err -> throwIO $ userError err
|
|
||||||
|
|
||||||
|
|
||||||
-- | Update app data and list internal state based on new evidence.
|
-- | Update app data and list internal state based on new evidence.
|
||||||
@@ -381,11 +369,11 @@ withIOAction action = do
|
|||||||
-- and @BrickSettings@.
|
-- and @BrickSettings@.
|
||||||
updateList :: BrickData -> BrickState -> BrickState
|
updateList :: BrickData -> BrickState -> BrickState
|
||||||
updateList appD BrickState{..} =
|
updateList appD BrickState{..} =
|
||||||
let newInternalState = constructList appD _appSettings (Just _appState)
|
let newInternalState = constructList appD appSettings (Just appState)
|
||||||
in BrickState { _appState = newInternalState
|
in BrickState { appState = newInternalState
|
||||||
, _appData = appD
|
, appData = appD
|
||||||
, _appSettings = _appSettings
|
, appSettings = appSettings
|
||||||
, _appKeys = _appKeys
|
, appKeys = appKeys
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
@@ -394,12 +382,12 @@ constructList :: BrickData
|
|||||||
-> Maybe BrickInternalState
|
-> Maybe BrickInternalState
|
||||||
-> BrickInternalState
|
-> BrickInternalState
|
||||||
constructList appD appSettings =
|
constructList appD appSettings =
|
||||||
replaceLR (filterVisible (_showAllVersions appSettings)
|
replaceLR (filterVisible (showAllVersions appSettings)
|
||||||
(_showAllTools appSettings))
|
(showAllTools appSettings))
|
||||||
(_lr appD)
|
(lr appD)
|
||||||
|
|
||||||
listSelectedElement' :: BrickInternalState -> Maybe (Int, ListResult)
|
listSelectedElement' :: BrickInternalState -> Maybe (Int, ListResult)
|
||||||
listSelectedElement' BrickInternalState{..} = fmap (_ix, ) $ _clr !? _ix
|
listSelectedElement' BrickInternalState{..} = fmap (ix, ) $ clr !? ix
|
||||||
|
|
||||||
|
|
||||||
selectLatest :: Vector ListResult -> Int
|
selectLatest :: Vector ListResult -> Int
|
||||||
@@ -445,9 +433,10 @@ filterVisible v t e | lInstalled e = True
|
|||||||
|
|
||||||
|
|
||||||
install' :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m)
|
install' :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m)
|
||||||
=> (Int, ListResult)
|
=> BrickState
|
||||||
|
-> (Int, ListResult)
|
||||||
-> m (Either String ())
|
-> m (Either String ())
|
||||||
install' (_, ListResult {..}) = do
|
install' _ (_, ListResult {..}) = do
|
||||||
AppState { ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask
|
AppState { ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask
|
||||||
|
|
||||||
let run =
|
let run =
|
||||||
@@ -521,9 +510,10 @@ install' (_, ListResult {..}) = do
|
|||||||
|
|
||||||
|
|
||||||
set' :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m)
|
set' :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m)
|
||||||
=> (Int, ListResult)
|
=> BrickState
|
||||||
|
-> (Int, ListResult)
|
||||||
-> m (Either String ())
|
-> m (Either String ())
|
||||||
set' input@(_, ListResult {..}) = do
|
set' bs input@(_, ListResult {..}) = do
|
||||||
settings <- liftIO $ readIORef settings'
|
settings <- liftIO $ readIORef settings'
|
||||||
|
|
||||||
let run =
|
let run =
|
||||||
@@ -545,12 +535,12 @@ set' input@(_, ListResult {..}) = do
|
|||||||
promptAnswer <- getUserPromptResponse userPrompt
|
promptAnswer <- getUserPromptResponse userPrompt
|
||||||
case promptAnswer of
|
case promptAnswer of
|
||||||
PromptYes -> do
|
PromptYes -> do
|
||||||
res <- install' input
|
res <- install' bs input
|
||||||
case res of
|
case res of
|
||||||
(Left err) -> pure $ Left err
|
(Left err) -> pure $ Left err
|
||||||
(Right _) -> do
|
(Right _) -> do
|
||||||
logInfo "Setting now..."
|
logInfo "Setting now..."
|
||||||
set' input
|
set' bs input
|
||||||
|
|
||||||
PromptNo -> pure $ Left (prettyHFError e)
|
PromptNo -> pure $ Left (prettyHFError e)
|
||||||
where
|
where
|
||||||
@@ -565,9 +555,10 @@ set' input@(_, ListResult {..}) = do
|
|||||||
|
|
||||||
|
|
||||||
del' :: (MonadReader AppState m, MonadIO m, MonadFail m, MonadMask m, MonadUnliftIO m)
|
del' :: (MonadReader AppState m, MonadIO m, MonadFail m, MonadMask m, MonadUnliftIO m)
|
||||||
=> (Int, ListResult)
|
=> BrickState
|
||||||
|
-> (Int, ListResult)
|
||||||
-> m (Either String ())
|
-> m (Either String ())
|
||||||
del' (_, ListResult {..}) = do
|
del' _ (_, ListResult {..}) = do
|
||||||
AppState { ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask
|
AppState { ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask
|
||||||
|
|
||||||
let run = runE @'[NotInstalled, UninstallFailed]
|
let run = runE @'[NotInstalled, UninstallFailed]
|
||||||
@@ -591,9 +582,10 @@ del' (_, ListResult {..}) = do
|
|||||||
|
|
||||||
|
|
||||||
changelog' :: (MonadReader AppState m, MonadIO m)
|
changelog' :: (MonadReader AppState m, MonadIO m)
|
||||||
=> (Int, ListResult)
|
=> BrickState
|
||||||
|
-> (Int, ListResult)
|
||||||
-> m (Either String ())
|
-> m (Either String ())
|
||||||
changelog' (_, ListResult {..}) = do
|
changelog' _ (_, ListResult {..}) = do
|
||||||
AppState { pfreq, ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask
|
AppState { pfreq, ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask
|
||||||
case getChangeLog dls lTool (ToolVersion lVer) of
|
case getChangeLog dls lTool (ToolVersion lVer) of
|
||||||
Nothing -> pure $ Left $
|
Nothing -> pure $ Left $
|
||||||
@@ -626,6 +618,7 @@ settings' = unsafePerformIO $ do
|
|||||||
loggerConfig
|
loggerConfig
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
brickMain :: AppState
|
brickMain :: AppState
|
||||||
-> IO ()
|
-> IO ()
|
||||||
brickMain s = do
|
brickMain s = do
|
||||||
@@ -649,7 +642,7 @@ brickMain s = do
|
|||||||
|
|
||||||
|
|
||||||
defaultAppSettings :: BrickSettings
|
defaultAppSettings :: BrickSettings
|
||||||
defaultAppSettings = BrickSettings { _showAllVersions = False, _showAllTools = False }
|
defaultAppSettings = BrickSettings { showAllVersions = False, showAllTools = False }
|
||||||
|
|
||||||
|
|
||||||
getGHCupInfo :: IO (Either String GHCupInfo)
|
getGHCupInfo :: IO (Either String GHCupInfo)
|
||||||
@@ -676,4 +669,3 @@ getAppData mgi = runExceptT $ do
|
|||||||
flip runReaderT settings $ do
|
flip runReaderT settings $ do
|
||||||
lV <- listVersions Nothing [] False True (Nothing, Nothing)
|
lV <- listVersions Nothing [] False True (Nothing, Nothing)
|
||||||
pure $ BrickData (reverse lV)
|
pure $ BrickData (reverse lV)
|
||||||
|
|
||||||
|
|||||||
@@ -43,6 +43,12 @@ All of the following are valid arguments to `ghcup install ghc`:
|
|||||||
|
|
||||||
If the argument is omitted, the default is `recommended`.
|
If the argument is omitted, the default is `recommended`.
|
||||||
|
|
||||||
|
Other tags include:
|
||||||
|
|
||||||
|
- `prerelease`: a prerelease version
|
||||||
|
- `latest-prerelease`: the latest prerelease version
|
||||||
|
|
||||||
|
|
||||||
## Manpages
|
## Manpages
|
||||||
|
|
||||||
For man pages to work you need [man-db](http://man-db.nongnu.org/) as your `man` provider, then issue `man ghc`. Manpages only work for the currently set ghc.
|
For man pages to work you need [man-db](http://man-db.nongnu.org/) as your `man` provider, then issue `man ghc`. Manpages only work for the currently set ghc.
|
||||||
@@ -203,34 +209,6 @@ url-source:
|
|||||||
- "https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml"
|
- "https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml"
|
||||||
```
|
```
|
||||||
|
|
||||||
### Nightlies
|
|
||||||
|
|
||||||
Nightlies are just another release channel. Currently, only GHC supports nightlies, which are binary releases
|
|
||||||
that are built every night from `master`.
|
|
||||||
|
|
||||||
To add the nightly channel, run:
|
|
||||||
|
|
||||||
```sh
|
|
||||||
ghcup config add-release-channel https://ghc.gitlab.haskell.org/ghcup-metadata/ghcup-nightlies-0.0.7.yaml
|
|
||||||
```
|
|
||||||
|
|
||||||
To list all nightlies from 2023, run:
|
|
||||||
|
|
||||||
```sh
|
|
||||||
ghcup list --show-nightly --tool=ghc --since=2023-01-01
|
|
||||||
```
|
|
||||||
|
|
||||||
Ways to install a nightly:
|
|
||||||
|
|
||||||
```sh
|
|
||||||
# by date
|
|
||||||
ghcup install ghc 2023-06-20
|
|
||||||
# by version
|
|
||||||
ghcup install ghc 9.7.20230619
|
|
||||||
# by tag
|
|
||||||
ghcup install ghc latest-nightly
|
|
||||||
```
|
|
||||||
|
|
||||||
## Stack integration
|
## Stack integration
|
||||||
|
|
||||||
Stack manages GHC versions internally by default. In order to make it use ghcup installed
|
Stack manages GHC versions internally by default. In order to make it use ghcup installed
|
||||||
@@ -489,9 +467,10 @@ this is cryptographically secure.
|
|||||||
First, obtain the gpg keys:
|
First, obtain the gpg keys:
|
||||||
|
|
||||||
```sh
|
```sh
|
||||||
gpg --batch --keyserver keys.openpgp.org --recv-keys 7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C
|
gpg --batch --keyserver keyserver.ubuntu.com --recv-keys 7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C
|
||||||
gpg --batch --keyserver keyserver.ubuntu.com --recv-keys FE5AB6C91FEA597C3B31180B73EDE9E8CFBAEF01
|
gpg --batch --keyserver keyserver.ubuntu.com --recv-keys FE5AB6C91FEA597C3B31180B73EDE9E8CFBAEF01
|
||||||
gpg --batch --keyserver keyserver.ubuntu.com --recv-keys 88B57FCF7DB53B4DB3BFA4B1588764FBE22D19C4
|
gpg --batch --keyserver keyserver.ubuntu.com --recv-keys 88B57FCF7DB53B4DB3BFA4B1588764FBE22D19C4
|
||||||
|
gpg --batch --keyserver keyserver.ubuntu.com --recv-keys EAF2A9A722C0C96F2B431CA511AAD8CEDEE0CAEF
|
||||||
```
|
```
|
||||||
|
|
||||||
Then verify the gpg key in one of these ways:
|
Then verify the gpg key in one of these ways:
|
||||||
|
|||||||
@@ -296,7 +296,14 @@ Lower availability of bindists. Stack and HLS binaries are experimental.
|
|||||||
Download the binary for your platform at [https://downloads.haskell.org/~ghcup/](https://downloads.haskell.org/~ghcup/)
|
Download the binary for your platform at [https://downloads.haskell.org/~ghcup/](https://downloads.haskell.org/~ghcup/)
|
||||||
and place it into your `PATH` anywhere.
|
and place it into your `PATH` anywhere.
|
||||||
|
|
||||||
If you want to GPG verify the binaries, import the following keys first: `7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C` and `FE5AB6C91FEA597C3B31180B73EDE9E8CFBAEF01`.
|
If you want to GPG verify the binaries, import the following keys first:
|
||||||
|
|
||||||
|
```sh
|
||||||
|
gpg --batch --keyserver keyserver.ubuntu.com --recv-keys 7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C
|
||||||
|
gpg --batch --keyserver keyserver.ubuntu.com --recv-keys FE5AB6C91FEA597C3B31180B73EDE9E8CFBAEF01
|
||||||
|
gpg --batch --keyserver keyserver.ubuntu.com --recv-keys 88B57FCF7DB53B4DB3BFA4B1588764FBE22D19C4
|
||||||
|
gpg --batch --keyserver keyserver.ubuntu.com --recv-keys EAF2A9A722C0C96F2B431CA511AAD8CEDEE0CAEF
|
||||||
|
```
|
||||||
|
|
||||||
Then adjust your `PATH` in `~/.bashrc` (or similar, depending on your shell) like so:
|
Then adjust your `PATH` in `~/.bashrc` (or similar, depending on your shell) like so:
|
||||||
|
|
||||||
|
|||||||
43
ghcup.cabal
43
ghcup.cabal
@@ -25,10 +25,10 @@ extra-source-files:
|
|||||||
cbits/dirutils.h
|
cbits/dirutils.h
|
||||||
data/build_mk/cross
|
data/build_mk/cross
|
||||||
data/build_mk/default
|
data/build_mk/default
|
||||||
test/data/dir/.keep
|
test/ghcup-test/data/dir/.keep
|
||||||
test/data/file
|
test/ghcup-test/data/file
|
||||||
test/golden/unix/GHCupInfo.json
|
test/ghcup-test/golden/unix/GHCupInfo.json
|
||||||
test/golden/windows/GHCupInfo.json
|
test/ghcup-test/golden/windows/GHCupInfo.json
|
||||||
|
|
||||||
source-repository head
|
source-repository head
|
||||||
type: git
|
type: git
|
||||||
@@ -236,7 +236,7 @@ library
|
|||||||
|
|
||||||
if (flag(tui) && !os(windows))
|
if (flag(tui) && !os(windows))
|
||||||
cpp-options: -DBRICK
|
cpp-options: -DBRICK
|
||||||
build-depends: vty ^>=5.37
|
build-depends: vty ^>=5.39
|
||||||
|
|
||||||
library ghcup-optparse
|
library ghcup-optparse
|
||||||
import: app-common-depends
|
import: app-common-depends
|
||||||
@@ -261,7 +261,7 @@ library ghcup-optparse
|
|||||||
GHCup.OptParse.Upgrade
|
GHCup.OptParse.Upgrade
|
||||||
GHCup.OptParse.Whereis
|
GHCup.OptParse.Whereis
|
||||||
|
|
||||||
hs-source-dirs: app/ghcup
|
hs-source-dirs: lib-opt
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
default-extensions:
|
default-extensions:
|
||||||
LambdaCase
|
LambdaCase
|
||||||
@@ -284,12 +284,6 @@ library ghcup-optparse
|
|||||||
|
|
||||||
if (flag(tui) && !os(windows))
|
if (flag(tui) && !os(windows))
|
||||||
cpp-options: -DBRICK
|
cpp-options: -DBRICK
|
||||||
other-modules: BrickMain
|
|
||||||
build-depends:
|
|
||||||
, brick ^>=1.5
|
|
||||||
, transformers ^>=0.5
|
|
||||||
, unix ^>=2.7
|
|
||||||
, vty ^>=5.37
|
|
||||||
|
|
||||||
if os(windows)
|
if os(windows)
|
||||||
cpp-options: -DIS_WINDOWS
|
cpp-options: -DIS_WINDOWS
|
||||||
@@ -300,26 +294,6 @@ library ghcup-optparse
|
|||||||
executable ghcup
|
executable ghcup
|
||||||
import: app-common-depends
|
import: app-common-depends
|
||||||
main-is: Main.hs
|
main-is: Main.hs
|
||||||
other-modules:
|
|
||||||
GHCup.OptParse
|
|
||||||
GHCup.OptParse.ChangeLog
|
|
||||||
GHCup.OptParse.Common
|
|
||||||
GHCup.OptParse.Compile
|
|
||||||
GHCup.OptParse.Config
|
|
||||||
GHCup.OptParse.DInfo
|
|
||||||
GHCup.OptParse.GC
|
|
||||||
GHCup.OptParse.Install
|
|
||||||
GHCup.OptParse.List
|
|
||||||
GHCup.OptParse.Nuke
|
|
||||||
GHCup.OptParse.Prefetch
|
|
||||||
GHCup.OptParse.Rm
|
|
||||||
GHCup.OptParse.Run
|
|
||||||
GHCup.OptParse.Set
|
|
||||||
GHCup.OptParse.Test
|
|
||||||
GHCup.OptParse.ToolRequirements
|
|
||||||
GHCup.OptParse.UnSet
|
|
||||||
GHCup.OptParse.Upgrade
|
|
||||||
GHCup.OptParse.Whereis
|
|
||||||
|
|
||||||
hs-source-dirs: app/ghcup
|
hs-source-dirs: app/ghcup
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
@@ -351,10 +325,7 @@ executable ghcup
|
|||||||
, brick ^>=1.5
|
, brick ^>=1.5
|
||||||
, transformers ^>=0.5
|
, transformers ^>=0.5
|
||||||
, unix ^>=2.7
|
, unix ^>=2.7
|
||||||
, vty ^>=5.37
|
, vty ^>=5.39
|
||||||
, microlens ^>=0.4.13
|
|
||||||
, microlens-th ^>=0.4.3
|
|
||||||
, microlens-mtl ^>=0.2.0
|
|
||||||
|
|
||||||
if os(windows)
|
if os(windows)
|
||||||
cpp-options: -DIS_WINDOWS
|
cpp-options: -DIS_WINDOWS
|
||||||
|
|||||||
@@ -824,7 +824,7 @@ checkForUpdates = do
|
|||||||
|
|
||||||
logGHCPostRm :: (MonadReader env m, HasLog env, MonadIO m) => GHCTargetVersion -> m ()
|
logGHCPostRm :: (MonadReader env m, HasLog env, MonadIO m) => GHCTargetVersion -> m ()
|
||||||
logGHCPostRm ghcVer = do
|
logGHCPostRm ghcVer = do
|
||||||
cabalStore <- liftIO $ handleIO (\_ -> if isWindows then pure "C:\\cabal\\store" else pure "~/.cabal/store")
|
cabalStore <- liftIO $ handleIO (\_ -> if isWindows then pure "C:\\cabal\\store" else pure "~/.cabal/store or ~/.local/state/cabal/store")
|
||||||
(runIdentity . CC.cfgStoreDir <$> CC.readConfig)
|
(runIdentity . CC.cfgStoreDir <$> CC.readConfig)
|
||||||
let storeGhcDir = cabalStore </> ("ghc-" <> T.unpack (prettyVer $ _tvVersion ghcVer))
|
let storeGhcDir = cabalStore </> ("ghc-" <> T.unpack (prettyVer $ _tvVersion ghcVer))
|
||||||
logInfo $ T.pack $ "After removing GHC you might also want to clean up your cabal store at: " <> storeGhcDir
|
logInfo $ T.pack $ "After removing GHC you might also want to clean up your cabal store at: " <> storeGhcDir
|
||||||
@@ -157,13 +157,17 @@ instance NFData VersionInfo
|
|||||||
|
|
||||||
|
|
||||||
-- | A tag. These are currently attached to a version of a tool.
|
-- | A tag. These are currently attached to a version of a tool.
|
||||||
data Tag = Latest
|
data Tag = Latest -- ^ the latest version of a tool (unique per tool)
|
||||||
| Recommended
|
| Recommended -- ^ the recommended version of a tool (unique per tool)
|
||||||
| Prerelease
|
| Prerelease -- ^ denotes a prerelease version
|
||||||
| LatestPrerelease
|
-- (a version should either be 'Prerelease' or
|
||||||
| Nightly
|
-- 'LatestPrerelease', but not both)
|
||||||
| LatestNightly
|
| LatestPrerelease -- ^ the latest prerelease (unique per tool)
|
||||||
| Base PVP
|
| Nightly -- ^ denotes a nightly version
|
||||||
|
-- (a version should either be 'Nightly' or
|
||||||
|
-- 'LatestNightly', but not both)
|
||||||
|
| LatestNightly -- ^ the latest nightly (unique per tool)
|
||||||
|
| Base PVP -- ^ the base version shipped with GHC
|
||||||
| Old -- ^ old versions are hidden by default in TUI
|
| Old -- ^ old versions are hidden by default in TUI
|
||||||
| UnknownTag String -- ^ used for upwardscompat
|
| UnknownTag String -- ^ used for upwardscompat
|
||||||
deriving (Ord, Eq, GHC.Generic, Show) -- FIXME: manual JSON instance
|
deriving (Ord, Eq, GHC.Generic, Show) -- FIXME: manual JSON instance
|
||||||
|
|||||||
@@ -1,4 +1,4 @@
|
|||||||
resolver: lts-20.20
|
resolver: lts-20.26
|
||||||
|
|
||||||
packages:
|
packages:
|
||||||
- .
|
- .
|
||||||
|
|||||||
Reference in New Issue
Block a user