Improve generate subcommand

ghcup-gen/Generate.hs

@@ -9,55 +9,45 @@
 
 module Generate where
 
-import           GHCup
 import           GHCup.Download
 import           GHCup.Errors
 import           GHCup.Types
 import           GHCup.Types.Optics
 import           GHCup.Utils
-import           GHCup.Utils.Logger
+
-import           GHCup.Utils.Version.QQ
 
 import           Codec.Archive
-import           Control.Applicative
 import           Control.Exception.Safe
 import           Control.Monad
 import           Control.Monad.IO.Class
 import           Control.Monad.Reader.Class
-import           Control.Monad.Trans.Class      ( lift )
-import           Control.Monad.Trans.Reader     ( runReaderT )
 import           Control.Monad.Trans.Resource   ( runResourceT
                                                 , MonadUnliftIO
                                                 )
-import           Data.Containers.ListUtils      ( nubOrd )
+import qualified Data.Aeson.Encode.Pretty     as Aeson
 import           Data.ByteString                ( ByteString )
-import           Data.IORef
 import           Data.Either
 import           Data.Maybe
 import           Data.List
 import           Data.Map.Strict                ( Map )
 import           Data.Versions
 import           Haskus.Utils.Variant.Excepts
-import           Optics
-import           System.FilePath
 import           System.Exit
-import           Text.ParserCombinators.ReadP
-import           Text.PrettyPrint.HughesPJClass ( prettyShow )
 import           Text.Regex.Posix
 import           GHCup.Utils.String.QQ
 
-import qualified Data.ByteString               as BS
+import qualified Data.ByteString.Lazy          as BSL
 import qualified Data.Map.Strict               as M
 import qualified Data.Text                     as T
-import qualified Data.Version                  as V
 import qualified Data.Yaml.Pretty              as YAML
 import qualified Text.Megaparsec               as MP
 
+data Format = FormatJSON
+            | FormatYAML
 
-
+data Output
-data GhcHlsVersions = GhcHlsVersions {
+  = FileOutput FilePath -- optsparse-applicative doesn't handle ByteString correctly anyway
-
+  | StdOut
-}
 
 type HlsGhcVersions = Map Version (Map Architecture (Map Platform Version))
 
@@ -74,8 +64,10 @@ generate :: ( MonadFail m
             )
          => GHCupDownloads
          -> M.Map GlobalTool DownloadInfo
+         -> Format
+         -> Output
          -> m ExitCode
-generate dls _ = do
+generate dls _ format output = do
   let hlses = dls M.! HLS
   r <- forM hlses $ \(_viArch -> archs) ->
          forM archs $ \plats ->
@@ -97,5 +89,10 @@ generate dls _ = do
                                 <$> filter (match regex) files
                pure ghcs
              pure r
-  liftIO $ BS.putStr $ YAML.encodePretty YAML.defConfig r
+  let w = case format of
+            FormatYAML -> BSL.fromStrict $ YAML.encodePretty YAML.defConfig r
+            FormatJSON -> Aeson.encodePretty r
+  case output of
+    StdOut -> liftIO $ BSL.putStr w
+    FileOutput f -> liftIO $ BSL.writeFile f w
   pure ExitSuccess

ghcup-gen/Main.hs

@@ -43,11 +43,45 @@ data Options = Options
   { optCommand :: Command
   }
 
+
+formatParser :: Parser Format
+formatParser =
+    option
+    (eitherReader formatP)
+          (long "format" <> metavar "FORMAT" <> help
+            "Which format to use (JSON | YAML). Yaml is default."
+            <> value FormatJSON
+          )
+ where
+  formatP :: String -> Either String Format
+  formatP s' | t == T.pack "json" = Right FormatJSON
+             | t == T.pack "yaml" = Right FormatYAML
+             | t == T.pack "yml"  = Right FormatYAML
+             | otherwise          = Left ("Unknown format value: " <> s')
+    where t = T.toLower (T.pack s')
+
+
 data Command = ValidateYAML ValidateYAMLOpts
              | ValidateTarballs ValidateYAMLOpts TarballFilter
-             | GenerateHlsGhc ValidateYAMLOpts
+             | GenerateHlsGhc ValidateYAMLOpts Format Output
 
 
+fileOutput :: Parser Output
+fileOutput =
+  FileOutput
+    <$> strOption
+          (long "output-file" <> short 'o' <> metavar "FILENAME" <> help
+            "Output file to write to"
+          )
+
+stdOutput :: Parser Output
+stdOutput = flag'
+  StdOut
+  (short 'o' <> long "stdout" <> help "Output to stdout (default)")
+
+outputP :: Parser Output
+outputP = fileOutput <|> stdOutput
+
 data Input
   = FileInput FilePath -- optsparse-applicative doesn't handle ByteString correctly anyway
   | StdInput
@@ -113,7 +147,7 @@ com = subparser
   <> command
        "generate-hls-ghcs"
        (info
-         ((GenerateHlsGhc <$> validateYAMLOpts) <**> helper)
+         ((GenerateHlsGhc <$> validateYAMLOpts <*> formatParser <*> outputP) <**> helper)
          (progDesc "Generate a list of HLS-GHC support")
        )
   )
@@ -145,7 +179,7 @@ main = do
     >>= \Options {..} -> case optCommand of
           ValidateYAML vopts -> withValidateYamlOpts vopts (\dl m -> flip runReaderT appstate $ validate dl m)
           ValidateTarballs vopts tarballFilter -> withValidateYamlOpts vopts (\dl m -> flip runReaderT appstate $ validateTarballs tarballFilter dl m)
-          GenerateHlsGhc vopts -> withValidateYamlOpts vopts (\dl m -> flip runReaderT appstate $ generate dl m)
+          GenerateHlsGhc vopts format output -> withValidateYamlOpts vopts (\dl m -> flip runReaderT appstate $ generate dl m format output)
   pure ()
 
  where

ghcup-gen/ghcup-gen.cabal

@@ -45,6 +45,7 @@ executable ghcup-gen
     -fwarn-incomplete-record-updates -threaded
 
   build-depends:
+    , aeson-pretty          ^>=0.8.9
     , base                  >=4.13     && <5
     , bytestring            ^>=0.10
     , containers            ^>=0.6