hasufell/ghcup-hs
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Check for new ghcup version on start

Browse Source
This commit is contained in:
Julian Ospald 2020-03-09 22:21:22 +01:00
parent dcd6812fb7
commit b7f49b1c94
1 changed files with 54 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

97
app/ghcup/Main.hs
View File

@ -18,11 +18,13 @@ import GHCup.Utils.Prelude
import GHCup.Utils.String.QQ import GHCup.Utils.String.QQ
import GHCup.Version import GHCup.Version
import Control.Monad.Fail ( MonadFail )
import Control.Monad.Logger import Control.Monad.Logger
import Control.Monad.Reader import Control.Monad.Reader
import Control.Monad.Trans.Resource import Control.Monad.Trans.Resource
import Data.Bifunctor import Data.Bifunctor
import Data.Char import Data.Char
import Data.Either
import Data.List ( intercalate ) import Data.List ( intercalate )
import Data.Semigroup ( (<>) ) import Data.Semigroup ( (<>) )
import Data.String.Interpolate import Data.String.Interpolate
@ -127,8 +129,11 @@ opts =
<*> (optional <*> (optional
(option (option
(eitherReader parseUri) (eitherReader parseUri)
(short 's' <> long "url-source" <> metavar "URL" <> help ( short 's'
"Alternative ghcup download info url" <> internal <> long "url-source"
<> metavar "URL"
<> help "Alternative ghcup download info url"
<> internal
) )
) )
) )
@ -167,13 +172,13 @@ com =
(progDesc "Upgrade ghcup (per default in ~/.ghcup/bin/)") (progDesc "Upgrade ghcup (per default in ~/.ghcup/bin/)")
) )
) )
<> command <> command
"compile" "compile"
( Compile ( Compile
<$> (info (compileP <**> helper) <$> (info (compileP <**> helper)
(progDesc "Compile a tool from source") (progDesc "Compile a tool from source")
)
) )
)
<> commandGroup "Main commands:" <> commandGroup "Main commands:"
) )
<|> subparser <|> subparser
@ -416,7 +421,6 @@ main = do
, DistroNotFound , DistroNotFound
, FileDoesNotExistError , FileDoesNotExistError
, CopyError , CopyError
, JSONError
, NoCompatibleArch , NoCompatibleArch
, NoDownload , NoDownload
, NotInstalled , NotInstalled
@ -427,22 +431,21 @@ main = do
, DownloadFailed , DownloadFailed
] ]
let runSetGHC = let
runLogger runSetGHC =
. flip runReaderT settings runLogger
. runE . flip runReaderT settings
@'[ FileDoesNotExistError . runE
, NotInstalled @'[ FileDoesNotExistError
, TagNotFound , NotInstalled
, JSONError , TagNotFound
, TagNotFound , TagNotFound
, DownloadFailed ]
]
let runListGHC = let runListGHC =
runLogger runLogger
. flip runReaderT settings . flip runReaderT settings
. runE @'[FileDoesNotExistError , JSONError , DownloadFailed] . runE @'[FileDoesNotExistError]
let runRmGHC = let runRmGHC =
runLogger . flip runReaderT settings . runE @'[NotInstalled] runLogger . flip runReaderT settings . runE @'[NotInstalled]
@ -461,12 +464,10 @@ main = do
@'[ AlreadyInstalled @'[ AlreadyInstalled
, BuildFailed , BuildFailed
, DigestError , DigestError
, DownloadFailed
, GHCupSetError , GHCupSetError
, NoDownload , NoDownload
, UnknownArchive , UnknownArchive
-- , DownloadFailed
, JSONError
] ]
let runCompileCabal = let runCompileCabal =
@ -474,12 +475,11 @@ main = do
. flip runReaderT settings . flip runReaderT settings
. runResourceT . runResourceT
. runE . runE
@'[ JSONError @'[ UnknownArchive
, UnknownArchive
, NoDownload , NoDownload
, DigestError , DigestError
, DownloadFailed
, BuildFailed , BuildFailed
, DownloadFailed
] ]
let runUpgrade = let runUpgrade =
@ -493,18 +493,29 @@ main = do
, NoCompatibleArch , NoCompatibleArch
, NoDownload , NoDownload
, FileDoesNotExistError , FileDoesNotExistError
, JSONError
, DownloadFailed
, CopyError , CopyError
, DownloadFailed
] ]
dls <-
( runLogger
. flip runReaderT settings
. runE @'[JSONError , DownloadFailed]
$ liftE getDownloads
)
>>= \case
VRight r -> pure r
VLeft e ->
runLogger
($(logError) [i|Error fetching download info: #{e}|])
>> exitFailure
runLogger $ checkForUpdates dls
case optCommand of case optCommand of
Install (InstallGHC InstallOptions {..}) -> Install (InstallGHC InstallOptions {..}) ->
void void
$ (runInstTool $ do $ (runInstTool $ do
dls <- liftE getDownloads v <- liftE $ fromVersion dls instVer GHC
v <- liftE $ fromVersion dls instVer GHC
liftE $ installGHCBin dls v Nothing liftE $ installGHCBin dls v Nothing
) )
>>= \case >>= \case
@ -527,8 +538,7 @@ Check the logs at ~/ghcup/logs and the build directory #{tmpdir} for more clues.
Install (InstallCabal InstallOptions {..}) -> Install (InstallCabal InstallOptions {..}) ->
void void
$ (runInstTool $ do $ (runInstTool $ do
dls <- liftE getDownloads v <- liftE $ fromVersion dls instVer Cabal
v <- liftE $ fromVersion dls instVer Cabal
liftE $ installCabalBin dls v Nothing liftE $ installCabalBin dls v Nothing
) )
>>= \case >>= \case
@ -546,8 +556,7 @@ Check the logs at ~/ghcup/logs and the build directory #{tmpdir} for more clues.
SetGHC (SetGHCOptions {..}) -> SetGHC (SetGHCOptions {..}) ->
void void
$ (runSetGHC $ do $ (runSetGHC $ do
dls <- liftE getDownloads v <- liftE $ fromVersion dls ghcVer GHC
v <- liftE $ fromVersion dls ghcVer GHC
liftE $ setGHC v SetGHCOnly liftE $ setGHC v SetGHCOnly
) )
>>= \case >>= \case
@ -559,7 +568,6 @@ Check the logs at ~/ghcup/logs and the build directory #{tmpdir} for more clues.
List (ListOptions {..}) -> List (ListOptions {..}) ->
void void
$ (runListGHC $ do $ (runListGHC $ do
dls <- liftE getDownloads
liftIO $ listVersions dls lTool lCriteria liftIO $ listVersions dls lTool lCriteria
) )
>>= \case >>= \case
@ -590,7 +598,6 @@ Check the logs at ~/ghcup/logs and the build directory #{tmpdir} for more clues.
Compile (CompileGHC CompileOptions {..}) -> Compile (CompileGHC CompileOptions {..}) ->
void void
$ (runCompileGHC $ do $ (runCompileGHC $ do
dls <- liftE getDownloads
liftE liftE
$ compileGHC dls targetVer bootstrapVer jobs buildConfig $ compileGHC dls targetVer bootstrapVer jobs buildConfig
) )
@ -613,11 +620,7 @@ Check the logs at ~/ghcup/logs and the build directory #{tmpdir} for more clues.
Compile (CompileCabal CompileOptions {..}) -> Compile (CompileCabal CompileOptions {..}) ->
void void
$ (runCompileCabal $ do $ (runCompileCabal $ do
dls <- liftE getDownloads liftE $ compileCabal dls targetVer bootstrapVer jobs
liftE $ compileCabal dls
targetVer
bootstrapVer
jobs
) )
>>= \case >>= \case
VRight _ -> VRight _ ->
@ -645,7 +648,6 @@ Check the logs at ~/ghcup/logs and the build directory #{tmpdir} for more clues.
void void
$ (runUpgrade $ do $ (runUpgrade $ do
dls <- liftE getDownloads
liftE $ upgradeGHCup dls target liftE $ upgradeGHCup dls target
) )
>>= \case >>= \case
@ -700,3 +702,12 @@ printListResult lr = do
) )
lr lr
putStrLn $ formatted putStrLn $ formatted
checkForUpdates :: (MonadFail m, MonadLogger m) => GHCupDownloads -> m ()
checkForUpdates dls = do
forM_ (getLatest dls GHCup) $ \l -> do
(Right ghc_ver) <- pure $ version $ prettyPVP ghcUpVer
when (l > ghc_ver)
$ $(logWarn)
[i|New GHCup version available: #{prettyVer l}. To upgrade, run 'ghcup upgrade'|]