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

module Stack.Options.GhciParser
  ( ghciOptsParser
  ) where

import           Options.Applicative
                   ( Parser, completer, flag, help, idm, internal, long, metavar
                   , strOption, switch
                   )
import           Options.Applicative.Args ( argsOption )
import           Options.Applicative.Builder.Extra
                   ( boolFlags, boolFlagsNoDefault, fileExtCompleter
                   , textArgument, textOption
                   )
import           Stack.Config ( packagesParser )
import           Stack.Ghci ( GhciOpts (..) )
import           Stack.Options.BuildParser ( flagsParser )
import           Stack.Options.Completion
                   ( ghcOptsCompleter, targetCompleter )
import           Stack.Prelude

-- | Parser for GHCI options

ghciOptsParser :: Parser GhciOpts
ghciOptsParser :: Parser GhciOpts
ghciOptsParser = [Text]
-> [String]
-> [String]
-> Map ApplyCLIFlag (Map FlagName Bool)
-> Maybe String
-> Bool
-> [String]
-> Maybe Text
-> Bool
-> Bool
-> Maybe Bool
-> Bool
-> Bool
-> GhciOpts
GhciOpts
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Mod ArgumentFields Text -> Parser Text
textArgument
        (  forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"TARGET/FILE"
        forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer (Completer
targetCompleter forall a. Semigroup a => a -> a -> a
<> [String] -> Completer
fileExtCompleter [String
".hs", String
".lhs"])
        forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"If none specified, use all local packages. See \
                \https://docs.haskellstack.org/en/stable/build_command/#target-syntax \
                \for details. If a path to a .hs or .lhs file is specified, it \
                \will be loaded."
        ))
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (     (\[String]
x [[String]]
y -> [String]
x forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[String]]
y)
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> a -> Mod FlagFields a -> Parser a
flag
              []
              [String
"-Wall", String
"-Werror"]
              (  forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"pedantic"
              forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Turn on -Wall and -Werror."
              )
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Mod OptionFields [String] -> Parser [String]
argsOption
              (  forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"ghci-options"
              forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"OPTIONS"
              forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer Completer
ghcOptsCompleter
              forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Additional options passed to GHCi (can be specified \
                      \multiple times)."
              ))
      )
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (     forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Mod OptionFields [String] -> Parser [String]
argsOption
              (  forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"ghc-options"
              forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"OPTIONS"
              forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer Completer
ghcOptsCompleter
              forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Additional options passed to both GHC and GHCi (can be \
                      \specified multiple times)."
              ))
      )
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Map ApplyCLIFlag (Map FlagName Bool))
flagsParser
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall s. IsString s => Mod OptionFields s -> Parser s
strOption
        (  forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"with-ghc"
        forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"GHC"
        forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Use this GHC to run GHCi."
        ))
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (     Bool -> Bool
not
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> String -> String -> Mod FlagFields Bool -> Parser Bool
boolFlags Bool
True
              String
"load"
              String
"load modules on start-up."
              forall m. Monoid m => m
idm
      )
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [String]
packagesParser
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Mod OptionFields Text -> Parser Text
textOption
        (  forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"main-is"
        forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"TARGET"
        forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer Completer
targetCompleter
        forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Specify which target should contain the main module to load, \
                \such as for an executable for test suite or benchmark."
        ))
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch
        (  forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"load-local-deps"
        forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Load all local dependencies of your targets."
        )
  -- TODO: deprecate this? probably useless.

  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch
        (  forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"skip-intermediate-deps"
        forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Skip loading intermediate target dependencies."
        forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Mod f a
internal
        )
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (String -> String -> Mod FlagFields Bool -> Parser Bool
boolFlagsNoDefault
        String
"package-hiding"
        String
"package hiding"
        forall m. Monoid m => m
idm)
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch
        (  forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"no-build"
        forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Don't build before launching GHCi."
        forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Mod f a
internal
        )
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch
        (  forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"only-main"
        forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Only load and import the main module. If no main module, no \
                \modules will be loaded."
        )