Don't update ghcup if already latest version

Fixes #2

app/ghcup/Main.hs

@@ -80,7 +80,7 @@ data Command
   | Rm RmOptions
   | DInfo
   | Compile CompileCommand
-  | Upgrade UpgradeOpts
+  | Upgrade UpgradeOpts Bool
   | NumericVersion
   | ToolRequirements
 
@@ -194,9 +194,12 @@ com =
            )
       <> command
            "upgrade"
-           (   Upgrade
+           (info ((Upgrade <$> upgradeOptsP <*>
-           <$> (info (upgradeOptsP <**> helper) (progDesc "Upgrade ghcup"))
+            switch
-           )
+            (short 'f' <> long "force" <> help
+              "Force update"
+            )
+           ) <**> helper) (progDesc "Upgrade ghcup"))
       <> command
            "compile"
            (   Compile
@@ -626,6 +629,7 @@ main = do
                       , NoCompatiblePlatform
                       , NoCompatibleArch
                       , NoDownload
+                      , NoUpdate
                       , FileDoesNotExistError
                       , CopyError
                       , DownloadFailed
@@ -770,7 +774,7 @@ Check the logs at ~/.ghcup/logs and the build directory #{tmpdir} for more clues
                       VLeft e ->
                         runLogger ($(logError) [i|#{e}|]) >> exitFailure
 
-            Upgrade (uOpts) -> do
+            Upgrade (uOpts) force -> do
               target <- case uOpts of
                 UpgradeInplace -> do
                   efp <- liftIO $ getExecutablePath
@@ -783,7 +787,7 @@ Check the logs at ~/.ghcup/logs and the build directory #{tmpdir} for more clues
 
               void
                 $   (runUpgrade $ do
-                      liftE $ upgradeGHCup dls target
+                      liftE $ upgradeGHCup dls target force
                     )
                 >>= \case
                       VRight v' -> do
@@ -791,6 +795,9 @@ Check the logs at ~/.ghcup/logs and the build directory #{tmpdir} for more clues
                         runLogger
                           $ $(logInfo)
                               [i|Successfully upgraded GHCup to version #{pretty_v}|]
+                      VLeft (V NoUpdate) ->
+                        runLogger $ $(logWarn)
+                          [i|No GHCup update available|]
                       VLeft e ->
                         runLogger ($(logError) [i|#{e}|]) >> exitFailure
 

lib/GHCup.hs

@@ -675,6 +675,8 @@ upgradeGHCup :: ( MonadMask m
                 )
              => GHCupDownloads
              -> Maybe (Path Abs)  -- ^ full file destination to write ghcup into
+             -> Bool              -- ^ whether to force update regardless
+                                  --   of currently installed version
              -> Excepts
                   '[ CopyError
                    , DigestError
@@ -683,12 +685,14 @@ upgradeGHCup :: ( MonadMask m
                    , NoCompatibleArch
                    , NoCompatiblePlatform
                    , NoDownload
+                   , NoUpdate
                    ]
                   m
                   Version
-upgradeGHCup dls mtarget = do
+upgradeGHCup dls mtarget force = do
   lift $ $(logInfo) [i|Upgrading GHCup...|]
   let latestVer = fromJust $ getLatest dls GHCup
+  when (not force && (latestVer < pvpToVersion ghcUpVer)) $ throwE NoUpdate
   pfreq <- liftE platformRequest
   dli   <- lE $ getDownloadInfo GHCup latestVer pfreq dls
   tmp   <- lift withGHCupTmpDir

lib/GHCup/Errors.hs

@@ -30,6 +30,10 @@ data NoCompatiblePlatform = NoCompatiblePlatform String -- the platform we got
 data NoDownload = NoDownload
   deriving Show
 
+-- | No update available or necessary.
+data NoUpdate = NoUpdate
+  deriving Show
+
 -- | The Architecture is unknown and unsupported.
 data NoCompatibleArch = NoCompatibleArch String
   deriving Show

lib/GHCup/Utils/Prelude.hs

@@ -240,3 +240,7 @@ addToCurrentEnv :: MonadIO m
 addToCurrentEnv adds = do
   cEnv <- liftIO $ getEnvironment
   pure (adds ++ cEnv)
+
+
+pvpToVersion :: PVP -> Version
+pvpToVersion = either (\_ -> error "Couldn't convert PVP to Version") id . version . prettyPVP