Add subcommand to output system requirements in markdown

Related: https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/411
haskell · Nov 12, 2022 · 1b9f1fc · 1b9f1fc
1 parent 32a75b4
commit 1b9f1fc
Show file tree

Hide file tree

Showing 4 changed files with 63 additions and 3 deletions.
diff --git a/ghcup-0.0.7.yaml b/ghcup-0.0.7.yaml
@@ -153,7 +153,7 @@ toolRequirements:
         unknown_versioning:
           distroPKGs: []
           notes: On Windows, msys2 should already have been set up during the installation,
-            so most users should just press ENTER.
+            so most users should just proceed.
             If you are installing manually, make sure to have a working mingw64 toolchain and
             shell.
 ghcupDownloads:

diff --git a/ghcup-0.0.7.yaml.sig b/ghcup-0.0.7.yaml.sig
diff --git a/ghcup-gen/Generate.hs b/ghcup-gen/Generate.hs
@@ -11,6 +11,7 @@ module Generate where
 
 import           GHCup
 import           GHCup.Download
+import           GHCup.Requirements
 import           GHCup.Errors
 import           GHCup.Types
 import           GHCup.Types.Optics
@@ -144,13 +145,14 @@ generateTable output = do
   handle <- case output of
               StdOut -> pure stdout
               FileOutput fp -> liftIO $ openFile fp WriteMode
-              
+
   forM_ [GHC,Cabal,HLS,Stack] $ \tool -> do
     case tool of
       GHC -> liftIO $ hPutStrLn handle $ "<details> <summary>Show all supported <a href='https://www.haskell.org/ghc/'>GHC</a> versions</summary>"
       Cabal -> liftIO $ hPutStrLn handle $ "<details> <summary>Show all supported <a href='https://cabal.readthedocs.io/en/stable/'>cabal-install</a> versions</summary>"
       HLS -> liftIO $ hPutStrLn handle $ "<details> <summary>Show all supported <a href='https://haskell-language-server.readthedocs.io/en/stable/'>HLS</a> versions</summary>"
       Stack -> liftIO $ hPutStrLn handle $ "<details> <summary>Show all supported <a href='https://docs.haskellstack.org/en/stable/README/'>Stack</a> versions</summary>"
+      _ -> fail "no"
     liftIO $ hPutStrLn handle $ "<table>"
     liftIO $ hPutStrLn handle $ "<thead><tr><th>" <> show tool <> " Version</th><th>Tags</th></tr></thead>"
     liftIO $ hPutStrLn handle $ "<tbody>"
@@ -175,3 +177,53 @@ generateTable output = do
   printTag (Base       pvp'') = "base-" ++ T.unpack (prettyPVP pvp'')
   printTag (UnknownTag t    ) = t
   printTag Old                = ""
+
+
+generateSystemInfo :: ( MonadFail m
+                      , MonadMask m
+                      , Monad m
+                      , MonadReader env m
+                      , HasSettings env
+                      , HasDirs env
+                      , HasLog env
+                      , MonadThrow m
+                      , MonadIO m
+                      , HasPlatformReq env
+                      , HasGHCupInfo env
+                      , MonadUnliftIO m
+                      )
+                   => Output
+                   -> m ExitCode
+generateSystemInfo output = do
+  handle <- case output of
+              StdOut -> pure stdout
+              FileOutput fp -> liftIO $ openFile fp WriteMode
+
+  forM_ [ Linux Debian
+        , Linux Ubuntu
+        , Linux Fedora
+        , Linux CentOS
+        , Linux Alpine
+        , Linux UnknownLinux
+        , Darwin
+        , FreeBSD
+        , Windows
+        ] $ \plat -> do
+            GHCupInfo { .. } <- getGHCupInfo
+            (Just req) <- pure $ getCommonRequirements (PlatformResult plat Nothing) _toolRequirements
+            liftIO $ hPutStrLn handle $ "### " <> (prettyPlat plat) <> "\n"
+            liftIO $ hPutStrLn handle $ (T.unpack $ pretty' req) <> "\n"
+  pure ExitSuccess
+ where
+  pretty' Requirements {..} =
+    let d = if not . null $ _distroPKGs
+          then "The following distro packages are required: " <> "`" <> T.intercalate " " _distroPKGs <> "`"
+          else ""
+        n = if not . T.null $ _notes then _notes else ""
+    in  if | T.null d -> n
+           | T.null n -> d
+           | otherwise -> d <> "\n" <> n
+
+  prettyPlat (Linux UnknownLinux) = "Linux (generic)"
+  prettyPlat p = show p
+
diff --git a/ghcup-gen/Main.hs b/ghcup-gen/Main.hs
@@ -65,6 +65,7 @@ data Command = ValidateYAML ValidateYAMLOpts
              | ValidateTarballs ValidateYAMLOpts TarballFilter
              | GenerateHlsGhc ValidateYAMLOpts Format Output
              | GenerateToolTable ValidateYAMLOpts Output
+             | GenerateSystemDepsInfo ValidateYAMLOpts Output
 
 
 fileOutput :: Parser Output
@@ -152,11 +153,17 @@ com = subparser
          (progDesc "Generate a list of HLS-GHC support")
        )
   <> command
-       "generate-table"
+       "generate-tool-table"
        (info
          ((GenerateToolTable <$> validateYAMLOpts <*> outputP) <**> helper)
          (progDesc "Generate a markdown table of available tool versions")
        )
+  <> command
+       "generate-system-deps-info"
+       (info
+         ((GenerateSystemDepsInfo <$> validateYAMLOpts <*> outputP) <**> helper)
+         (progDesc "Generate a markdown info for system dependencies")
+       )
   )
 
 
@@ -202,6 +209,7 @@ main = do
           ValidateTarballs vopts tarballFilter -> withValidateYamlOpts vopts (validateTarballs tarballFilter)
           GenerateHlsGhc vopts format output -> withValidateYamlOpts vopts (generateHLSGhc format output)
           GenerateToolTable vopts output -> withValidateYamlOpts vopts (generateTable output)
+          GenerateSystemDepsInfo vopts output -> withValidateYamlOpts vopts (generateSystemInfo output)
   pure ()
 
  where