From d598c42d1960470a7dadf6af3c604f326f8037e8 Mon Sep 17 00:00:00 2001
From: Julian Ospald <hasufell@posteo.de>
Date: Sun, 1 Mar 2020 12:54:46 +0100
Subject: [PATCH] Lala

---
 TODO.md           |   3 +-
 app/ghcup/Main.hs | 123 ++++++++++++++++++++++++++--------------------
 lib/GHCup/File.hs |   3 +-
 3 files changed, 73 insertions(+), 56 deletions(-)

diff --git a/TODO.md b/TODO.md
index a27f467..2a71039 100644
--- a/TODO.md
+++ b/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
diff --git a/app/ghcup/Main.hs b/app/ghcup/Main.hs
index 39517cb..102dad8 100644
--- a/app/ghcup/Main.hs
+++ b/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,53 +107,68 @@ opts =
     bimap show id $ parseURI strictURIParserOptions (UTF8.fromString s')
 
 com :: Parser Command
-com = subparser
-  (  command
-      "install-ghc"
-      (   InstallGHC
-      <$> (info (installGHCOpts <**> helper)
-                (progDesc "Install a GHC version")
+com =
+  subparser
+      (  command
+          "install"
+          (   Install
+          <$> (info (installP <**> helper) (progDesc "Install GHC or cabal"))
           )
+      <> command
+           "list"
+           (   List
+           <$> (info (listOpts <**> helper)
+                     (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)
+                     (progDesc "Remove a GHC version installed by ghcup")
+                   )
+               )
+          <> commandGroup "GHC commands:"
+          <> hidden
+          )
+    <|> subparser
+          (  command
+              "debug-info"
+              ((\_ -> DInfo) <$> (info (helper) (progDesc "Show debug info")))
+          <> commandGroup "Other commands:"
+          <> hidden
+          )
+
+
+installP :: Parser InstallCommand
+installP = subparser
+  (  command
+      "ghc"
+      (   InstallGHC
+      <$> (info (installOpts <**> helper) (progDesc "Install a GHC version"))
       )
   <> command
-       "install-cabal"
+       "cabal"
        (   InstallCabal
-       <$> (info (installCabalOpts <**> helper)
-                 (progDesc "Install a cabal-install version")
+       <$> (info (installOpts <**> helper)
+                 (progDesc "Install or update a Cabal version")
            )
        )
-  <> command
-       "set-ghc"
-       (   SetGHC
-       <$> (info (setGHCOpts <**> helper)
-                 (progDesc "Set the currently active GHC version")
-           )
-       )
-  <> command
-       "list"
-       (   List
-       <$> (info (listOpts <**> helper)
-                 (progDesc "Show available GHCs and other tools")
-           )
-       )
-  <> command
-       "rm"
-       (   Rm
-       <$> (info (rmOpts <**> helper)
-                 (progDesc "Remove a GHC version installed by ghcup")
-           )
-       )
-  <> command
-       "debug-info"
-       ((\_ -> DInfo) <$> (info (helper) (progDesc "Show debug info")))
   )
 
-installGHCOpts :: Parser InstallGHCOptions
-installGHCOpts = InstallGHCOptions <$> optional toolVersionParser
-
-
-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
diff --git a/lib/GHCup/File.hs b/lib/GHCup/File.hs
index e923867..3aca28b 100644
--- a/lib/GHCup/File.hs
+++ b/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