{-# LANGUAGE NoImplicitPrelude #-}

module Stack.Options.GhcBuildParser
( ghcBuildParser
) where

import           Options.Applicative
                   ( Parser, completeWith, help, long, metavar, option )
import           Options.Applicative.Types ( readerAsk, readerError )
import           Stack.Options.Utils ( hideMods )
import           Stack.Prelude
import           Stack.Types.CompilerBuild ( CompilerBuild, parseCompilerBuild )

-- | GHC build parser

ghcBuildParser :: Bool -> Parser CompilerBuild
ghcBuildParser :: Bool -> Parser CompilerBuild
ghcBuildParser Bool
hide = forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM CompilerBuild
readGHCBuild
  (  forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"ghc-build"
  forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"BUILD"
  forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasCompleter f => [String] -> Mod f a
completeWith
       [ String
"standard"
       , String
"gmp4"
       , String
"nopie"
       , String
"tinfo6"
       , String
"tinfo6-nopie"
       , String
"ncurses6"
       , String
"int-native"
       , String
"integersimple"
       ]
  forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Specialized GHC build, e.g. 'gmp4' or 'standard' (usually \
          \auto-detected)"
  forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Bool -> Mod f a
hideMods Bool
hide
  )
 where
  readGHCBuild :: ReadM CompilerBuild
readGHCBuild = do
    String
s <- ReadM String
readerAsk
    case forall (m :: * -> *). MonadThrow m => String -> m CompilerBuild
parseCompilerBuild String
s of
      Left SomeException
e -> forall a. String -> ReadM a
readerError (forall e. Exception e => e -> String
displayException SomeException
e)
      Right CompilerBuild
v -> forall (f :: * -> *) a. Applicative f => a -> f a
pure CompilerBuild
v