{-# LANGUAGE NoImplicitPrelude #-}

module Stack.Options.HpcReportParser
  ( hpcReportOptsParser
  , pvpBoundsOption
  ) where

import qualified Data.Text as T
import           Options.Applicative
                   ( Parser, completer, completeWith, help, long, metavar
                   , option, readerError, strOption, switch
                   )
import           Options.Applicative.Builder.Extra
                   ( dirCompleter, fileExtCompleter, textArgument )
import           Options.Applicative.Types ( readerAsk )
import           Stack.Coverage ( HpcReportOpts (..) )
import           Stack.Options.Completion ( targetCompleter )
import           Stack.Prelude
import           Stack.Types.PvpBounds ( PvpBounds, parsePvpBounds )

-- | Parser for @stack hpc report@.

hpcReportOptsParser :: Parser HpcReportOpts
hpcReportOptsParser :: Parser HpcReportOpts
hpcReportOptsParser = [Text] -> Bool -> Maybe String -> Bool -> HpcReportOpts
HpcReportOpts
  ([Text] -> Bool -> Maybe String -> Bool -> HpcReportOpts)
-> Parser [Text]
-> Parser (Bool -> Maybe String -> Bool -> HpcReportOpts)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text -> Parser [Text]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Mod ArgumentFields Text -> Parser Text
textArgument
        (  String -> Mod ArgumentFields Text
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"TARGET_OR_TIX"
        Mod ArgumentFields Text
-> Mod ArgumentFields Text -> Mod ArgumentFields Text
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod ArgumentFields Text
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer (Completer
targetCompleter Completer -> Completer -> Completer
forall a. Semigroup a => a -> a -> a
<> [String] -> Completer
fileExtCompleter [String
".tix"])
        ))
  Parser (Bool -> Maybe String -> Bool -> HpcReportOpts)
-> Parser Bool -> Parser (Maybe String -> Bool -> HpcReportOpts)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch
        (  String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"all"
        Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"Use results from all packages and components involved in \
                \previous --coverage run."
        )
  Parser (Maybe String -> Bool -> HpcReportOpts)
-> Parser (Maybe String) -> Parser (Bool -> HpcReportOpts)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
        (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"destdir"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"DIR"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields String
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer Completer
dirCompleter
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"Output directory for HTML report."
        ))
  Parser (Bool -> HpcReportOpts)
-> Parser Bool -> Parser HpcReportOpts
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch
        (  String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"open"
        Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"Open the report in the browser."
        )

pvpBoundsOption :: Parser PvpBounds
pvpBoundsOption :: Parser PvpBounds
pvpBoundsOption = ReadM PvpBounds -> Mod OptionFields PvpBounds -> Parser PvpBounds
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM PvpBounds
readPvpBounds
  (  String -> Mod OptionFields PvpBounds
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"pvp-bounds"
  Mod OptionFields PvpBounds
-> Mod OptionFields PvpBounds -> Mod OptionFields PvpBounds
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields PvpBounds
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"PVP-BOUNDS"
  Mod OptionFields PvpBounds
-> Mod OptionFields PvpBounds -> Mod OptionFields PvpBounds
forall a. Semigroup a => a -> a -> a
<> [String] -> Mod OptionFields PvpBounds
forall (f :: * -> *) a. HasCompleter f => [String] -> Mod f a
completeWith [String
"none", String
"lower", String
"upper", String
"both"]
  Mod OptionFields PvpBounds
-> Mod OptionFields PvpBounds -> Mod OptionFields PvpBounds
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields PvpBounds
forall (f :: * -> *) a. String -> Mod f a
help String
"How PVP version bounds should be added to Cabal file: none, lower, \
          \upper, both."
  )
 where
  readPvpBounds :: ReadM PvpBounds
readPvpBounds = do
    String
s <- ReadM String
readerAsk
    case Text -> Either String PvpBounds
parsePvpBounds (Text -> Either String PvpBounds)
-> Text -> Either String PvpBounds
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
s of
      Left String
e -> String -> ReadM PvpBounds
forall a. String -> ReadM a
readerError String
e
      Right PvpBounds
v -> PvpBounds -> ReadM PvpBounds
forall a. a -> ReadM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PvpBounds
v