Lala

TODO.md

@@ -2,7 +2,8 @@
 
 ## New
 
-* proper subcommands: ghcup install ghc
+* better logs
+* better debug-output
 
 * download progress
 * upgrade            Upgrade this script in-place

app/ghcup/Main.hs

@@ -41,15 +41,17 @@ import qualified Data.Text                     as T
 
 
 data Options = Options
-  { optVerbose   :: Bool
+  {
+  -- global options
+    optVerbose   :: Bool
   , optCache     :: Bool
   , optUrlSource :: Maybe URI
+  -- commands
   , optCommand   :: Command
   }
 
 data Command
-  = InstallGHC InstallGHCOptions
-  | InstallCabal InstallCabalOptions
+  = Install InstallCommand
   | SetGHC SetGHCOptions
   | List ListOptions
   | Rm RmOptions
@@ -59,12 +61,11 @@ data ToolVersion = ToolVersion Version
                  | ToolTag Tag
 
 
-data InstallGHCOptions = InstallGHCOptions
-  { ghcVer :: Maybe ToolVersion
-  }
+data InstallCommand = InstallGHC InstallOptions
+                    | InstallCabal InstallOptions
 
-data InstallCabalOptions = InstallCabalOptions
-  { cabalVer :: Maybe ToolVersion
+data InstallOptions = InstallOptions
+  { instVer :: Maybe ToolVersion
   }
 
 data SetGHCOptions = SetGHCOptions
@@ -106,27 +107,12 @@ opts =
     bimap show id $ parseURI strictURIParserOptions (UTF8.fromString s')
 
 com :: Parser Command
-com = subparser
+com =
+  subparser
       (  command
-      "install-ghc"
-      (   InstallGHC
-      <$> (info (installGHCOpts <**> helper)
-                (progDesc "Install a GHC version")
-          )
-      )
-  <> command
-       "install-cabal"
-       (   InstallCabal
-       <$> (info (installCabalOpts <**> helper)
-                 (progDesc "Install a cabal-install version")
-           )
-       )
-  <> command
-       "set-ghc"
-       (   SetGHC
-       <$> (info (setGHCOpts <**> helper)
-                 (progDesc "Set the currently active GHC version")
-           )
+          "install"
+          (   Install
+          <$> (info (installP <**> helper) (progDesc "Install GHC or cabal"))
           )
       <> command
            "list"
@@ -135,24 +121,54 @@ com = subparser
                      (progDesc "Show available GHCs and other tools")
                )
            )
+      <> commandGroup "Main commands:"
+      )
+    <|> subparser
+          (  command
+              "set"
+              (   SetGHC
+              <$> (info (setGHCOpts <**> helper)
+                        (progDesc "Set the currently active GHC version")
+                  )
+              )
           <> command
                "rm"
                (   Rm
-       <$> (info (rmOpts <**> helper)
+               <$> (info
+                     (rmOpts <**> helper)
                      (progDesc "Remove a GHC version installed by ghcup")
                    )
                )
-  <> command
+          <> commandGroup "GHC commands:"
+          <> hidden
+          )
+    <|> subparser
+          (  command
               "debug-info"
               ((\_ -> DInfo) <$> (info (helper) (progDesc "Show debug info")))
+          <> commandGroup "Other commands:"
+          <> hidden
           )
 
-installGHCOpts :: Parser InstallGHCOptions
-installGHCOpts = InstallGHCOptions <$> optional toolVersionParser
 
+installP :: Parser InstallCommand
+installP = subparser
+  (  command
+      "ghc"
+      (   InstallGHC
+      <$> (info (installOpts <**> helper) (progDesc "Install a GHC version"))
+      )
+  <> command
+       "cabal"
+       (   InstallCabal
+       <$> (info (installOpts <**> helper)
+                 (progDesc "Install or update a Cabal version")
+           )
+       )
+  )
 
-installCabalOpts :: Parser InstallCabalOptions
-installCabalOpts = InstallCabalOptions <$> optional toolVersionParser
+installOpts :: Parser InstallOptions
+installOpts = InstallOptions <$> optional toolVersionParser
 
 setGHCOpts :: Parser SetGHCOptions
 setGHCOpts = SetGHCOptions <$> optional toolVersionParser
@@ -195,7 +211,8 @@ rmOpts =
 versionParser :: Parser Version
 versionParser = option
   (eitherReader (bimap (const "Not a valid version") id . version . T.pack))
-  (short 'v' <> long "version" <> metavar "VERSION")
+  (short 'v' <> long "version" <> metavar "VERSION" <> help "The target version"
+  )
 
 
 toolVersionParser :: Parser ToolVersion
@@ -212,7 +229,7 @@ toolVersionParser = verP <|> toolP
                 other         -> Left ([i|Unknown tag #{other}|])
               )
             )
-            (short 't' <> long "tag" <> metavar "TAG")
+            (short 't' <> long "tag" <> metavar "TAG" <> help "The target tag")
           )
 
 
@@ -297,11 +314,11 @@ main = do
                     @'[PlatformResultError , NoCompatibleArch , DistroNotFound]
 
           case optCommand of
-            InstallGHC (InstallGHCOptions {..}) ->
+            Install (InstallGHC InstallOptions {..}) ->
               void
                 $   (runInstTool $ do
                       av <- liftE getDownloads
-                      v  <- liftE $ fromVersion av ghcVer GHC
+                      v  <- liftE $ fromVersion av instVer GHC
                       liftE $ installTool (ToolRequest GHC v) Nothing
                     )
                 >>= \case
@@ -312,11 +329,11 @@ main = do
                           (T.pack (show treq) <> [s| already installed|])
                       VLeft e ->
                         runLogger ($(logError) [i|#{e}|]) >> exitFailure
-            InstallCabal (InstallCabalOptions {..}) ->
+            Install (InstallGHC InstallOptions {..}) ->
               void
                 $   (runInstTool $ do
                       av <- liftE getDownloads
-                      v  <- liftE $ fromVersion av cabalVer Cabal
+                      v  <- liftE $ fromVersion av instVer Cabal
                       liftE $ installTool (ToolRequest Cabal v) Nothing
                     )
                 >>= \case

lib/GHCup/File.hs

@@ -196,8 +196,7 @@ mkGhcupTmpDir = do
   parseAbs tmp
 
 
-withGHCupTmpDir :: (MonadResource m, MonadThrow m, MonadIO m)
-                => m (Path Abs)
+withGHCupTmpDir :: (MonadResource m, MonadThrow m, MonadIO m) => m (Path Abs)
 withGHCupTmpDir = snd <$> allocate mkGhcupTmpDir deleteDirRecursive