diff --git a/ghcup-gen/Generate.hs b/ghcup-gen/Generate.hs index 01ef0ac..766bfef 100644 --- a/ghcup-gen/Generate.hs +++ b/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 GhcHlsVersions = GhcHlsVersions { - -} +data Output + = 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 diff --git a/ghcup-gen/Main.hs b/ghcup-gen/Main.hs index d0450c2..b826352 100644 --- a/ghcup-gen/Main.hs +++ b/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 diff --git a/ghcup-gen/ghcup-gen.cabal b/ghcup-gen/ghcup-gen.cabal index d9d955a..9d625b3 100644 --- a/ghcup-gen/ghcup-gen.cabal +++ b/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