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
+  = Install InstallCommand
-  | InstallCabal InstallCabalOptions
   | SetGHC SetGHCOptions
   | List ListOptions
   | Rm RmOptions
@@ -59,12 +61,11 @@ data ToolVersion = ToolVersion Version
                  | ToolTag Tag
 
 
-data InstallGHCOptions = InstallGHCOptions
+data InstallCommand = InstallGHC InstallOptions
-  { ghcVer :: Maybe ToolVersion
+                    | InstallCabal InstallOptions
-  }
 
-data InstallCabalOptions = InstallCabalOptions
+data InstallOptions = InstallOptions
-  { cabalVer :: Maybe ToolVersion
+  { instVer :: Maybe ToolVersion
   }
 
 data SetGHCOptions = SetGHCOptions
@@ -106,53 +107,68 @@ opts =
     bimap show id $ parseURI strictURIParserOptions (UTF8.fromString s')
 
 com :: Parser Command
-com = subparser
+com =
-  (  command
+  subparser
-      "install-ghc"
+      (  command
-      (   InstallGHC
+          "install"
-      <$> (info (installGHCOpts <**> helper)
+          (   Install
-                (progDesc "Install a GHC version")
+          <$> (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)
+       <$> (info (installOpts <**> helper)
-                 (progDesc "Install a cabal-install version")
+                 (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
+installOpts :: Parser InstallOptions
-installGHCOpts = InstallGHCOptions <$> optional toolVersionParser
+installOpts = InstallOptions <$> optional toolVersionParser
-
-
-installCabalOpts :: Parser InstallCabalOptions
-installCabalOpts = InstallCabalOptions <$> 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)
+withGHCupTmpDir :: (MonadResource m, MonadThrow m, MonadIO m) => m (Path Abs)
-                => m (Path Abs)
 withGHCupTmpDir = snd <$> allocate mkGhcupTmpDir deleteDirRecursive