{-# LANGUAGE NoImplicitPrelude #-}

module Stack.Options.GhcVariantParser
  ( ghcVariantParser
  ) where

import           Options.Applicative
                   ( Parser, help, long, metavar, option, readerError )
import           Options.Applicative.Types ( readerAsk )
import           Stack.Prelude
import           Stack.Options.Utils ( hideMods )
import           Stack.Types.GHCVariant ( GHCVariant, parseGHCVariant )

-- | GHC variant parser

ghcVariantParser :: Bool -> Parser GHCVariant
ghcVariantParser :: Bool -> Parser GHCVariant
ghcVariantParser Bool
hide = ReadM GHCVariant
-> Mod OptionFields GHCVariant -> Parser GHCVariant
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM GHCVariant
readGHCVariant
  (  String -> Mod OptionFields GHCVariant
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"ghc-variant"
  Mod OptionFields GHCVariant
-> Mod OptionFields GHCVariant -> Mod OptionFields GHCVariant
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields GHCVariant
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"VARIANT"
  Mod OptionFields GHCVariant
-> Mod OptionFields GHCVariant -> Mod OptionFields GHCVariant
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields GHCVariant
forall (f :: * -> *) a. String -> Mod f a
help String
"Specialized GHC variant, e.g. int-native or integersimple \
          \(incompatible with --system-ghc)."
  Mod OptionFields GHCVariant
-> Mod OptionFields GHCVariant -> Mod OptionFields GHCVariant
forall a. Semigroup a => a -> a -> a
<> Bool -> Mod OptionFields GHCVariant
forall (f :: * -> *) a. Bool -> Mod f a
hideMods Bool
hide
  )
 where
  readGHCVariant :: ReadM GHCVariant
readGHCVariant = do
    String
s <- ReadM String
readerAsk
    case String -> Either SomeException GHCVariant
forall (m :: * -> *). MonadThrow m => String -> m GHCVariant
parseGHCVariant String
s of
      Left SomeException
e -> String -> ReadM GHCVariant
forall a. String -> ReadM a
readerError (SomeException -> String
forall e. Exception e => e -> String
displayException SomeException
e)
      Right GHCVariant
v -> GHCVariant -> ReadM GHCVariant
forall a. a -> ReadM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GHCVariant
v