{-# LANGUAGE NoImplicitPrelude #-}

{-|
Module      : Stack.Options.ConfigSetParser
License     : BSD-3-Clause

Functions to parse command line arguments for Stack's @config set@ command.
-}

module Stack.Options.ConfigSetParser
  ( configCmdSetParser
  ) where

import qualified Data.Text as T
import qualified Options.Applicative as OA
import qualified Options.Applicative.Types as OA
import           Stack.Prelude
import           Stack.Types.ConfigMonoid
                   ( configMonoidInstallGHCName
                   , configMonoidInstallMsysName
                   , configMonoidRecommendStackUpgradeName
                   , configMonoidSystemGHCName
                   )
import           Stack.Types.ConfigSetOpts
                   ( CommandScope (..), ConfigCmdSet (..) )
import           Stack.Types.Snapshot ( readAbstractSnapshot )

-- | Parse command line arguments for Stack's @config set@ command.

configCmdSetParser :: OA.Parser ConfigCmdSet
configCmdSetParser :: Parser ConfigCmdSet
configCmdSetParser =
  Mod CommandFields ConfigCmdSet -> Parser ConfigCmdSet
forall a. Mod CommandFields a -> Parser a
OA.hsubparser (Mod CommandFields ConfigCmdSet -> Parser ConfigCmdSet)
-> Mod CommandFields ConfigCmdSet -> Parser ConfigCmdSet
forall a b. (a -> b) -> a -> b
$
    [Mod CommandFields ConfigCmdSet] -> Mod CommandFields ConfigCmdSet
forall a. Monoid a => [a] -> a
mconcat
      [ String -> ParserInfo ConfigCmdSet -> Mod CommandFields ConfigCmdSet
forall a. String -> ParserInfo a -> Mod CommandFields a
OA.command String
"snapshot"
          ( Parser ConfigCmdSet
-> InfoMod ConfigCmdSet -> ParserInfo ConfigCmdSet
forall a. Parser a -> InfoMod a -> ParserInfo a
OA.info
              (   Unresolved AbstractSnapshot -> ConfigCmdSet
ConfigCmdSetSnapshot
              (Unresolved AbstractSnapshot -> ConfigCmdSet)
-> Parser (Unresolved AbstractSnapshot) -> Parser ConfigCmdSet
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM (Unresolved AbstractSnapshot)
-> Mod ArgumentFields (Unresolved AbstractSnapshot)
-> Parser (Unresolved AbstractSnapshot)
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
OA.argument
                    ReadM (Unresolved AbstractSnapshot)
readAbstractSnapshot
                    (  String -> Mod ArgumentFields (Unresolved AbstractSnapshot)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
OA.metavar String
"SNAPSHOT"
                    Mod ArgumentFields (Unresolved AbstractSnapshot)
-> Mod ArgumentFields (Unresolved AbstractSnapshot)
-> Mod ArgumentFields (Unresolved AbstractSnapshot)
forall a. Semigroup a => a -> a -> a
<> String -> Mod ArgumentFields (Unresolved AbstractSnapshot)
forall (f :: * -> *) a. String -> Mod f a
OA.help String
"E.g. \"nightly\" or \"lts-22.8\"" ))
              ( String -> InfoMod ConfigCmdSet
forall a. String -> InfoMod a
OA.progDesc
                  String
"Change the snapshot of the current project." ))
      , String -> ParserInfo ConfigCmdSet -> Mod CommandFields ConfigCmdSet
forall a. String -> ParserInfo a -> Mod CommandFields a
OA.command String
"resolver"
          ( Parser ConfigCmdSet
-> InfoMod ConfigCmdSet -> ParserInfo ConfigCmdSet
forall a. Parser a -> InfoMod a -> ParserInfo a
OA.info
              (   Unresolved AbstractSnapshot -> ConfigCmdSet
ConfigCmdSetResolver
              (Unresolved AbstractSnapshot -> ConfigCmdSet)
-> Parser (Unresolved AbstractSnapshot) -> Parser ConfigCmdSet
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM (Unresolved AbstractSnapshot)
-> Mod ArgumentFields (Unresolved AbstractSnapshot)
-> Parser (Unresolved AbstractSnapshot)
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
OA.argument
                    ReadM (Unresolved AbstractSnapshot)
readAbstractSnapshot
                    (  String -> Mod ArgumentFields (Unresolved AbstractSnapshot)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
OA.metavar String
"SNAPSHOT"
                    Mod ArgumentFields (Unresolved AbstractSnapshot)
-> Mod ArgumentFields (Unresolved AbstractSnapshot)
-> Mod ArgumentFields (Unresolved AbstractSnapshot)
forall a. Semigroup a => a -> a -> a
<> String -> Mod ArgumentFields (Unresolved AbstractSnapshot)
forall (f :: * -> *) a. String -> Mod f a
OA.help String
"E.g. \"nightly\" or \"lts-22.8\"" ))
              ( String -> InfoMod ConfigCmdSet
forall a. String -> InfoMod a
OA.progDesc
                  String
"Change the snapshot of the current project, using the \
                  \resolver key." ))
      , String -> ParserInfo ConfigCmdSet -> Mod CommandFields ConfigCmdSet
forall a. String -> ParserInfo a -> Mod CommandFields a
OA.command (Text -> String
T.unpack Text
configMonoidSystemGHCName)
          ( Parser ConfigCmdSet
-> InfoMod ConfigCmdSet -> ParserInfo ConfigCmdSet
forall a. Parser a -> InfoMod a -> ParserInfo a
OA.info
              (   CommandScope -> Bool -> ConfigCmdSet
ConfigCmdSetSystemGhc
              (CommandScope -> Bool -> ConfigCmdSet)
-> Parser CommandScope -> Parser (Bool -> ConfigCmdSet)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser CommandScope
globalScopeFlag
              Parser (Bool -> ConfigCmdSet) -> Parser Bool -> Parser ConfigCmdSet
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
boolArgument )
              ( String -> InfoMod ConfigCmdSet
forall a. String -> InfoMod a
OA.progDesc
                  String
"Configure whether or not Stack should use a system GHC \
                  \installation." ))
      , String -> ParserInfo ConfigCmdSet -> Mod CommandFields ConfigCmdSet
forall a. String -> ParserInfo a -> Mod CommandFields a
OA.command (Text -> String
T.unpack Text
configMonoidInstallGHCName)
          ( Parser ConfigCmdSet
-> InfoMod ConfigCmdSet -> ParserInfo ConfigCmdSet
forall a. Parser a -> InfoMod a -> ParserInfo a
OA.info
              (   CommandScope -> Bool -> ConfigCmdSet
ConfigCmdSetInstallGhc
              (CommandScope -> Bool -> ConfigCmdSet)
-> Parser CommandScope -> Parser (Bool -> ConfigCmdSet)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser CommandScope
globalScopeFlag
              Parser (Bool -> ConfigCmdSet) -> Parser Bool -> Parser ConfigCmdSet
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
boolArgument )
              ( String -> InfoMod ConfigCmdSet
forall a. String -> InfoMod a
OA.progDesc
                  String
"Configure whether or not Stack should automatically install \
                  \GHC when necessary." ))
      , String -> ParserInfo ConfigCmdSet -> Mod CommandFields ConfigCmdSet
forall a. String -> ParserInfo a -> Mod CommandFields a
OA.command (Text -> String
T.unpack Text
configMonoidInstallMsysName)
          ( Parser ConfigCmdSet
-> InfoMod ConfigCmdSet -> ParserInfo ConfigCmdSet
forall a. Parser a -> InfoMod a -> ParserInfo a
OA.info
              (   CommandScope -> Bool -> ConfigCmdSet
ConfigCmdSetInstallMsys
              (CommandScope -> Bool -> ConfigCmdSet)
-> Parser CommandScope -> Parser (Bool -> ConfigCmdSet)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser CommandScope
globalScopeFlag
              Parser (Bool -> ConfigCmdSet) -> Parser Bool -> Parser ConfigCmdSet
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
boolArgument )
              ( String -> InfoMod ConfigCmdSet
forall a. String -> InfoMod a
OA.progDesc
                  String
"Configure whether or not Stack should automatically install \
                  \MSYS2 when necessary." ))
      , String -> ParserInfo ConfigCmdSet -> Mod CommandFields ConfigCmdSet
forall a. String -> ParserInfo a -> Mod CommandFields a
OA.command (Text -> String
T.unpack Text
configMonoidRecommendStackUpgradeName)
          ( Parser ConfigCmdSet
-> InfoMod ConfigCmdSet -> ParserInfo ConfigCmdSet
forall a. Parser a -> InfoMod a -> ParserInfo a
OA.info
              (   CommandScope -> Bool -> ConfigCmdSet
ConfigCmdSetRecommendStackUpgrade
              (CommandScope -> Bool -> ConfigCmdSet)
-> Parser CommandScope -> Parser (Bool -> ConfigCmdSet)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser CommandScope
projectScopeFlag
              Parser (Bool -> ConfigCmdSet) -> Parser Bool -> Parser ConfigCmdSet
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
boolArgument )
              ( String -> InfoMod ConfigCmdSet
forall a. String -> InfoMod a
OA.progDesc
                  String
"Configure whether or not Stack should notify the user if it \
                  \identifes a new version of Stack is available." ))
      , String -> ParserInfo ConfigCmdSet -> Mod CommandFields ConfigCmdSet
forall a. String -> ParserInfo a -> Mod CommandFields a
OA.command String
"package-index"
          ( Parser ConfigCmdSet
-> InfoMod ConfigCmdSet -> ParserInfo ConfigCmdSet
forall a. Parser a -> InfoMod a -> ParserInfo a
OA.info
              ( Mod CommandFields ConfigCmdSet -> Parser ConfigCmdSet
forall a. Mod CommandFields a -> Parser a
OA.hsubparser (Mod CommandFields ConfigCmdSet -> Parser ConfigCmdSet)
-> Mod CommandFields ConfigCmdSet -> Parser ConfigCmdSet
forall a b. (a -> b) -> a -> b
$
                  String -> ParserInfo ConfigCmdSet -> Mod CommandFields ConfigCmdSet
forall a. String -> ParserInfo a -> Mod CommandFields a
OA.command String
"download-prefix"
                    ( Parser ConfigCmdSet
-> InfoMod ConfigCmdSet -> ParserInfo ConfigCmdSet
forall a. Parser a -> InfoMod a -> ParserInfo a
OA.info
                        (   CommandScope -> Text -> ConfigCmdSet
ConfigCmdSetDownloadPrefix
                        (CommandScope -> Text -> ConfigCmdSet)
-> Parser CommandScope -> Parser (Text -> ConfigCmdSet)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser CommandScope
globalScopeFlag
                        Parser (Text -> ConfigCmdSet) -> Parser Text -> Parser ConfigCmdSet
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text
urlArgument )
                        ( String -> InfoMod ConfigCmdSet
forall a. String -> InfoMod a
OA.progDesc
                            String
"Configure download prefix for Stack's package \
                            \index." )))
              ( String -> InfoMod ConfigCmdSet
forall a. String -> InfoMod a
OA.progDesc
                  String
"Configure Stack's package index" ))
      ]

globalScopeFlag :: OA.Parser CommandScope
globalScopeFlag :: Parser CommandScope
globalScopeFlag = CommandScope
-> CommandScope
-> Mod FlagFields CommandScope
-> Parser CommandScope
forall a. a -> a -> Mod FlagFields a -> Parser a
OA.flag
  CommandScope
CommandScopeProject
  CommandScope
CommandScopeGlobal
  (  String -> Mod FlagFields CommandScope
forall (f :: * -> *) a. HasName f => String -> Mod f a
OA.long String
"global"
  Mod FlagFields CommandScope
-> Mod FlagFields CommandScope -> Mod FlagFields CommandScope
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields CommandScope
forall (f :: * -> *) a. String -> Mod f a
OA.help
       String
"Modify the user-specific global configuration file ('config.yaml') \
       \instead of the project-level configuration file ('stack.yaml')."
  )

projectScopeFlag :: OA.Parser CommandScope
projectScopeFlag :: Parser CommandScope
projectScopeFlag = CommandScope
-> CommandScope
-> Mod FlagFields CommandScope
-> Parser CommandScope
forall a. a -> a -> Mod FlagFields a -> Parser a
OA.flag
  CommandScope
CommandScopeGlobal
  CommandScope
CommandScopeProject
  (  String -> Mod FlagFields CommandScope
forall (f :: * -> *) a. HasName f => String -> Mod f a
OA.long String
"project"
  Mod FlagFields CommandScope
-> Mod FlagFields CommandScope -> Mod FlagFields CommandScope
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields CommandScope
forall (f :: * -> *) a. String -> Mod f a
OA.help
       String
"Modify the project-level configuration file ('stack.yaml') instead of \
       \the user-specific global configuration file ('config.yaml')."
  )

boolArgument :: OA.Parser Bool
boolArgument :: Parser Bool
boolArgument = ReadM Bool -> Mod ArgumentFields Bool -> Parser Bool
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
OA.argument
  ReadM Bool
readBool
  (  String -> Mod ArgumentFields Bool
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
OA.metavar String
"true|false"
  Mod ArgumentFields Bool
-> Mod ArgumentFields Bool -> Mod ArgumentFields Bool
forall a. Semigroup a => a -> a -> a
<> [String] -> Mod ArgumentFields Bool
forall (f :: * -> *) a. HasCompleter f => [String] -> Mod f a
OA.completeWith [String
"true", String
"false"]
  )

readBool :: OA.ReadM Bool
readBool :: ReadM Bool
readBool = do
  String
s <- ReadM String
OA.readerAsk
  case String
s of
    String
"true" -> Bool -> ReadM Bool
forall a. a -> ReadM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
    String
"false" -> Bool -> ReadM Bool
forall a. a -> ReadM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
    String
_ -> String -> ReadM Bool
forall a. String -> ReadM a
OA.readerError (String
"Invalid value " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++
           String
": Expected \"true\" or \"false\"")

urlArgument :: OA.Parser Text
urlArgument :: Parser Text
urlArgument = Mod ArgumentFields Text -> Parser Text
forall s. IsString s => Mod ArgumentFields s -> Parser s
OA.strArgument
  (  String -> Mod ArgumentFields Text
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
OA.metavar String
"URL"
  Mod ArgumentFields Text
-> Mod ArgumentFields Text -> Mod ArgumentFields Text
forall a. Semigroup a => a -> a -> a
<> Text -> Mod ArgumentFields Text
forall (f :: * -> *) a. HasValue f => a -> Mod f a
OA.value Text
defaultDownloadPrefix
  Mod ArgumentFields Text
-> Mod ArgumentFields Text -> Mod ArgumentFields Text
forall a. Semigroup a => a -> a -> a
<> Mod ArgumentFields Text
forall a (f :: * -> *). Show a => Mod f a
OA.showDefault
  Mod ArgumentFields Text
-> Mod ArgumentFields Text -> Mod ArgumentFields Text
forall a. Semigroup a => a -> a -> a
<> String -> Mod ArgumentFields Text
forall (f :: * -> *) a. String -> Mod f a
OA.help
       String
"Location of package index. It is highly recommended to use only the \
       \official Hackage server or a mirror."
  )