{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE OverloadedStrings #-}

-- | Functions to parse command line arguments for Stack's @setup@ command.

module Stack.Options.SetupParser
  ( setupOptsParser
  ) where

import qualified Data.Text as T
import qualified Options.Applicative as OA
import qualified Options.Applicative.Builder.Extra as OA
import qualified Options.Applicative.Types as OA
import           Stack.Prelude
import           Stack.SetupCmd ( SetupCmdOpts (..) )

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

setupOptsParser :: OA.Parser SetupCmdOpts
setupOptsParser :: Parser SetupCmdOpts
setupOptsParser = Maybe WantedCompiler
-> Bool -> Maybe String -> [String] -> Bool -> SetupCmdOpts
SetupCmdOpts
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
OA.optional (forall a. ReadM a -> Mod ArgumentFields a -> Parser a
OA.argument ReadM WantedCompiler
readVersion
        (  forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
OA.metavar String
"GHC_VERSION"
        forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
OA.help String
"Version of GHC to install, e.g. 9.2.7. (default: install \
                   \the version implied by the resolver)"
        ))
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> String -> String -> Mod FlagFields Bool -> Parser Bool
OA.boolFlags Bool
False
        String
"reinstall"
        String
"reinstalling GHC, even if available (incompatible with --system-ghc)."
        forall m. Monoid m => m
OA.idm
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
OA.optional (forall s. IsString s => Mod OptionFields s -> Parser s
OA.strOption
        (  forall (f :: * -> *) a. HasName f => String -> Mod f a
OA.long String
"ghc-bindist"
        forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
OA.metavar String
"URL"
        forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
OA.help String
"Alternate GHC binary distribution (requires custom \
                   \--ghc-variant)."
        ))
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f [a]
OA.many (forall s. IsString s => Mod OptionFields s -> Parser s
OA.strOption
        (  forall (f :: * -> *) a. HasName f => String -> Mod f a
OA.long String
"ghcjs-boot-options"
        forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
OA.metavar String
"GHCJS_BOOT"
        forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
OA.help String
"Additional ghcjs-boot options."
        ))
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> String -> String -> Mod FlagFields Bool -> Parser Bool
OA.boolFlags Bool
True
        String
"ghcjs-boot-clean"
        String
"Control if ghcjs-boot should have --clean option present."
        forall m. Monoid m => m
OA.idm
 where
  readVersion :: ReadM WantedCompiler
readVersion = do
    String
s <- ReadM String
OA.readerAsk
    case Text -> Either PantryException WantedCompiler
parseWantedCompiler (Text
"ghc-" forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
s) of
      Left PantryException
_ ->
        case Text -> Either PantryException WantedCompiler
parseWantedCompiler (String -> Text
T.pack String
s) of
          Left PantryException
_ -> forall a. String -> ReadM a
OA.readerError forall a b. (a -> b) -> a -> b
$ String
"Invalid version: " forall a. [a] -> [a] -> [a]
++ String
s
          Right WantedCompiler
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure WantedCompiler
x
      Right WantedCompiler
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure WantedCompiler
x