Fix brick not updating downloads correctly

This commit is contained in:
Julian Ospald 2020-11-21 00:32:26 +01:00
parent 66f989e691
commit e829bd8235
No known key found for this signature in database
GPG Key ID: 511B62C09D50CD28
2 changed files with 5 additions and 11 deletions

View File

@ -48,6 +48,8 @@ import System.Exit
import System.IO.Unsafe import System.IO.Unsafe
import URI.ByteString import URI.ByteString
import qualified GHCup.Types as GT
import qualified Data.Text as T import qualified Data.Text as T
import qualified Graphics.Vty as Vty import qualified Graphics.Vty as Vty
import qualified Data.Vector as V import qualified Data.Vector as V
@ -480,11 +482,6 @@ changelog' BrickState { appData = BrickData {..} } (_, ListResult {..}) = do
Left e -> pure $ Left [i|#{e}|] Left e -> pure $ Left [i|#{e}|]
uri' :: IORef (Maybe URI)
{-# NOINLINE uri' #-}
uri' = unsafePerformIO (newIORef Nothing)
settings' :: IORef AppState settings' :: IORef AppState
{-# NOINLINE settings' #-} {-# NOINLINE settings' #-}
settings' = unsafePerformIO $ do settings' = unsafePerformIO $ do
@ -513,13 +510,11 @@ logger' = unsafePerformIO
brickMain :: AppState brickMain :: AppState
-> Maybe URI
-> LoggerConfig -> LoggerConfig
-> GHCupDownloads -> GHCupDownloads
-> PlatformRequest -> PlatformRequest
-> IO () -> IO ()
brickMain s muri l av pfreq' = do brickMain s l av pfreq' = do
writeIORef uri' muri
writeIORef settings' s writeIORef settings' s
-- logger interpreter -- logger interpreter
writeIORef logger' l writeIORef logger' l
@ -548,7 +543,6 @@ defaultAppSettings = BrickSettings { showAll = False }
getDownloads' :: IO (Either String GHCupDownloads) getDownloads' :: IO (Either String GHCupDownloads)
getDownloads' = do getDownloads' = do
muri <- readIORef uri'
settings <- readIORef settings' settings <- readIORef settings'
l <- readIORef logger' l <- readIORef logger'
let runLogger = myLoggerT l let runLogger = myLoggerT l
@ -559,7 +553,7 @@ getDownloads' = do
. runE @'[JSONError , DownloadFailed , FileDoesNotExistError] . runE @'[JSONError , DownloadFailed , FileDoesNotExistError]
$ fmap _ghcupDownloads $ fmap _ghcupDownloads
$ liftE $ liftE
$ getDownloadsF (maybe GHCupURL OwnSource muri) $ getDownloadsF (urlSource . GT.settings $ settings)
case r of case r of
VRight a -> pure $ Right a VRight a -> pure $ Right a

View File

@ -1349,7 +1349,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
res <- case optCommand of res <- case optCommand of
#if defined(BRICK) #if defined(BRICK)
Interactive -> liftIO $ brickMain appstate optUrlSource loggerConfig dls pfreq >> pure ExitSuccess Interactive -> liftIO $ brickMain appstate loggerConfig dls pfreq >> pure ExitSuccess
#endif #endif
Install (Right iopts) -> do Install (Right iopts) -> do
runLogger ($(logWarn) [i|This is an old-style command for installing GHC. Use 'ghcup install ghc' instead.|]) runLogger ($(logWarn) [i|This is an old-style command for installing GHC. Use 'ghcup install ghc' instead.|])