ghcup-hs/app/ghcup-gen/Main.hs

{-# LANGUAGE CPP               #-}
{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns    #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes       #-}
{-# LANGUAGE TemplateHaskell   #-}
{-# LANGUAGE TypeApplications  #-}


module Main where

import           GHCup.Types
import           GHCup.Types.JSON               ( )
import           GHCup.Utils.Logger

#if !MIN_VERSION_base(4,13,0)
import           Data.Semigroup                 ( (<>) )
#endif
import           Options.Applicative     hiding ( style )
import           System.Console.Pretty
import           System.Exit
import           System.IO                      ( stdout )
import           Validate

import qualified Data.ByteString               as B
import qualified Data.Yaml                     as Y


data Options = Options
  { optCommand :: Command
  }

data Command = ValidateYAML ValidateYAMLOpts
             | ValidateTarballs ValidateYAMLOpts


data Input
  = FileInput FilePath -- optsparse-applicative doesn't handle ByteString correctly anyway
  | StdInput

fileInput :: Parser Input
fileInput =
  FileInput
    <$> (strOption
          (long "file" <> short 'f' <> metavar "FILENAME" <> help
            "Input file to validate"
          )
        )

stdInput :: Parser Input
stdInput = flag'
  StdInput
  (short 'i' <> long "stdin" <> help "Validate from stdin (default)")

inputP :: Parser Input
inputP = fileInput <|> stdInput

data ValidateYAMLOpts = ValidateYAMLOpts
  { vInput :: Maybe Input
  }

validateYAMLOpts :: Parser ValidateYAMLOpts
validateYAMLOpts = ValidateYAMLOpts <$> optional inputP

opts :: Parser Options
opts = Options <$> com

com :: Parser Command
com = subparser
  (  (command
       "check"
       (   ValidateYAML
       <$> (info (validateYAMLOpts <**> helper)
                 (progDesc "Validate the YAML")
           )
       )
     )
  <> (command
       "check-tarballs"
       (   ValidateTarballs
       <$> (info
             (validateYAMLOpts <**> helper)
             (progDesc "Validate all tarballs (download and checksum)")
           )
       )
     )
  )



main :: IO ()
main = do
  _ <- customExecParser (prefs showHelpOnError) (info (opts <**> helper) idm)
    >>= \Options {..} -> case optCommand of
          ValidateYAML vopts -> case vopts of
            ValidateYAMLOpts { vInput = Nothing } ->
              B.getContents >>= valAndExit validate
            ValidateYAMLOpts { vInput = Just StdInput } ->
              B.getContents >>= valAndExit validate
            ValidateYAMLOpts { vInput = Just (FileInput file) } ->
              B.readFile file >>= valAndExit validate
          ValidateTarballs vopts -> case vopts of
            ValidateYAMLOpts { vInput = Nothing } ->
              B.getContents >>= valAndExit validateTarballs
            ValidateYAMLOpts { vInput = Just StdInput } ->
              B.getContents >>= valAndExit validateTarballs
            ValidateYAMLOpts { vInput = Just (FileInput file) } ->
              B.readFile file >>= valAndExit validateTarballs
  pure ()

 where
  valAndExit f contents = do
    (GHCupInfo _ av) <- case Y.decodeEither' contents of
      Right r -> pure r
      Left  e -> die (color Red $ show e)
    myLoggerT (LoggerConfig True (B.hPut stdout) (\_ -> pure ())) (f av)
      >>= exitWith