    {-# LANGUAGE CPP #-}
    {-# LANGUAGE DeriveDataTypeable #-}
    {-# LANGUAGE DeriveGeneric #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE RankNTypes #-}

    -----------------------------------------------------------------------------

    -- |
    -- Module      :  Distribution.Simple.Setup.Repl
    -- Copyright   :  Isaac Jones 2003-2004
    --                Duncan Coutts 2007
    -- License     :  BSD3
    --
    -- Maintainer  :  cabal-devel@haskell.org
    -- Portability :  portable
    --
    -- Definition of the repl command-line options.
    -- See: @Distribution.Simple.Setup@
    module Distribution.Simple.Setup.Repl
      ( ReplFlags (..)
      , defaultReplFlags
      , replCommand
      , ReplOptions (..)
      , replOptions
      ) where

    import Distribution.Compat.Prelude hiding (get)
    import Prelude ()

    import Distribution.ReadE
    import Distribution.Simple.Command hiding (boolOpt, boolOpt')
    import Distribution.Simple.Flag
    import Distribution.Simple.Program
    import Distribution.Simple.Utils
    import Distribution.Verbosity

    import Distribution.Simple.Setup.Common

    -- ------------------------------------------------------------

    -- * REPL Flags

    -- ------------------------------------------------------------

    data ReplOptions = ReplOptions
      { ReplOptions -> [String]
    replOptionsFlags :: [String]
      , ReplOptions -> Flag Bool
    replOptionsNoLoad :: Flag Bool
      , ReplOptions -> Flag String
    replOptionsFlagOutput :: Flag FilePath
      }
      deriving (Int -> ReplOptions -> ShowS
    [ReplOptions] -> ShowS
    ReplOptions -> String
    (Int -> ReplOptions -> ShowS)
    -> (ReplOptions -> String)
    -> ([ReplOptions] -> ShowS)
    -> Show ReplOptions
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> ReplOptions -> ShowS
    showsPrec :: Int -> ReplOptions -> ShowS
    $cshow :: ReplOptions -> String
    show :: ReplOptions -> String
    $cshowList :: [ReplOptions] -> ShowS
    showList :: [ReplOptions] -> ShowS
    Show, (forall x. ReplOptions -> Rep ReplOptions x)
    -> (forall x. Rep ReplOptions x -> ReplOptions)
    -> Generic ReplOptions
    forall x. Rep ReplOptions x -> ReplOptions
    forall x. ReplOptions -> Rep ReplOptions x
    forall a.
    (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
    $cfrom :: forall x. ReplOptions -> Rep ReplOptions x
    from :: forall x. ReplOptions -> Rep ReplOptions x
    $cto :: forall x. Rep ReplOptions x -> ReplOptions
    to :: forall x. Rep ReplOptions x -> ReplOptions
    Generic, Typeable)

    instance Binary ReplOptions
    instance Structured ReplOptions

    instance Monoid ReplOptions where
      mempty :: ReplOptions
    mempty = [String] -> Flag Bool -> Flag String -> ReplOptions
    ReplOptions [String]
    forall a. Monoid a => a
    mempty (Bool -> Flag Bool
    forall a. a -> Flag a
    Flag Bool
    False) Flag String
    forall a. Flag a
    NoFlag
      mappend :: ReplOptions -> ReplOptions -> ReplOptions
    mappend = ReplOptions -> ReplOptions -> ReplOptions
    forall a. Semigroup a => a -> a -> a
    (<>)

    instance Semigroup ReplOptions where
      <> :: ReplOptions -> ReplOptions -> ReplOptions
    (<>) = ReplOptions -> ReplOptions -> ReplOptions
    forall a. (Generic a, GSemigroup (Rep a)) => a -> a -> a
    gmappend

    data ReplFlags = ReplFlags
      { ReplFlags -> [(String, String)]
    replProgramPaths :: [(String, FilePath)]
      , ReplFlags -> [(String, [String])]
    replProgramArgs :: [(String, [String])]
      , ReplFlags -> Flag String
    replDistPref :: Flag FilePath
      , ReplFlags -> Flag Verbosity
    replVerbosity :: Flag Verbosity
      , ReplFlags -> Flag Bool
    replReload :: Flag Bool
      , ReplFlags -> ReplOptions
    replReplOptions :: ReplOptions
      }
      deriving (Int -> ReplFlags -> ShowS
    [ReplFlags] -> ShowS
    ReplFlags -> String
    (Int -> ReplFlags -> ShowS)
    -> (ReplFlags -> String)
    -> ([ReplFlags] -> ShowS)
    -> Show ReplFlags
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> ReplFlags -> ShowS
    showsPrec :: Int -> ReplFlags -> ShowS
    $cshow :: ReplFlags -> String
    show :: ReplFlags -> String
    $cshowList :: [ReplFlags] -> ShowS
    showList :: [ReplFlags] -> ShowS
    Show, (forall x. ReplFlags -> Rep ReplFlags x)
    -> (forall x. Rep ReplFlags x -> ReplFlags) -> Generic ReplFlags
    forall x. Rep ReplFlags x -> ReplFlags
    forall x. ReplFlags -> Rep ReplFlags x
    forall a.
    (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
    $cfrom :: forall x. ReplFlags -> Rep ReplFlags x
    from :: forall x. ReplFlags -> Rep ReplFlags x
    $cto :: forall x. Rep ReplFlags x -> ReplFlags
    to :: forall x. Rep ReplFlags x -> ReplFlags
    Generic, Typeable)

    instance Binary ReplFlags
    instance Structured ReplFlags

    defaultReplFlags :: ReplFlags
    defaultReplFlags :: ReplFlags
    defaultReplFlags =
      ReplFlags
        { replProgramPaths :: [(String, String)]
    replProgramPaths = [(String, String)]
    forall a. Monoid a => a
    mempty
        , replProgramArgs :: [(String, [String])]
    replProgramArgs = []
        , replDistPref :: Flag String
    replDistPref = Flag String
    forall a. Flag a
    NoFlag
        , replVerbosity :: Flag Verbosity
    replVerbosity = Verbosity -> Flag Verbosity
    forall a. a -> Flag a
    Flag Verbosity
    normal
        , replReload :: Flag Bool
    replReload = Bool -> Flag Bool
    forall a. a -> Flag a
    Flag Bool
    False
        , replReplOptions :: ReplOptions
    replReplOptions = ReplOptions
    forall a. Monoid a => a
    mempty
        }

    instance Monoid ReplFlags where
      mempty :: ReplFlags
    mempty = ReplFlags
    forall a. (Generic a, GMonoid (Rep a)) => a
    gmempty
      mappend :: ReplFlags -> ReplFlags -> ReplFlags
    mappend = ReplFlags -> ReplFlags -> ReplFlags
    forall a. Semigroup a => a -> a -> a
    (<>)

    instance Semigroup ReplFlags where
      <> :: ReplFlags -> ReplFlags -> ReplFlags
    (<>) = ReplFlags -> ReplFlags -> ReplFlags
    forall a. (Generic a, GSemigroup (Rep a)) => a -> a -> a
    gmappend

    replCommand :: ProgramDb -> CommandUI ReplFlags
    replCommand :: ProgramDb -> CommandUI ReplFlags
    replCommand ProgramDb
    progDb =
      CommandUI
        { commandName :: String
    commandName = String
    "repl"
        , commandSynopsis :: String
    commandSynopsis =
            String
    "Open an interpreter session for the given component."
        , commandDescription :: Maybe ShowS
    commandDescription = ShowS -> Maybe ShowS
    forall a. a -> Maybe a
    Just (ShowS -> Maybe ShowS) -> ShowS -> Maybe ShowS
    forall a b. (a -> b) -> a -> b
    $ \String
    pname ->
            ShowS
    wrapText ShowS -> ShowS
    forall a b. (a -> b) -> a -> b
    $
              String
    "If the current directory contains no package, ignores COMPONENT "
                String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "parameters and opens an interactive interpreter session; if a "
                String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "sandbox is present, its package database will be used.\n"
                String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n"
                String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "Otherwise, (re)configures with the given or default flags, and "
                String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "loads the interpreter with the relevant modules. For executables, "
                String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "tests and benchmarks, loads the main module (and its "
                String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "dependencies); for libraries all exposed/other modules.\n"
                String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n"
                String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "The default component is the library itself, or the executable "
                String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "if that is the only component.\n"
                String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n"
                String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "Support for loading specific modules is planned but not "
                String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "implemented yet. For certain scenarios, `"
                String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    pname
                String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    " exec -- ghci :l Foo` may be used instead. Note that `exec` will "
                String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "not (re)configure and you will have to specify the location of "
                String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "other modules, if required.\n"
        , commandNotes :: Maybe ShowS
    commandNotes = ShowS -> Maybe ShowS
    forall a. a -> Maybe a
    Just (ShowS -> Maybe ShowS) -> ShowS -> Maybe ShowS
    forall a b. (a -> b) -> a -> b
    $ \String
    pname ->
            String
    "Examples:\n"
              String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "  "
              String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    pname
              String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    " repl           "
              String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "    The first component in the package\n"
              String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "  "
              String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    pname
              String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    " repl foo       "
              String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "    A named component (i.e. lib, exe, test suite)\n"
              String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "  "
              String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    pname
              String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    " repl --repl-options=\"-lstdc++\""
              String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "  Specifying flags for interpreter\n"
        , -- TODO: re-enable once we have support for module/file targets
          --        ++ "  " ++ pname ++ " repl Foo.Bar   "
          --        ++ "    A module\n"
          --        ++ "  " ++ pname ++ " repl Foo/Bar.hs"
          --        ++ "    A file\n\n"
          --        ++ "If a target is ambiguous it can be qualified with the component "
          --        ++ "name, e.g.\n"
          --        ++ "  " ++ pname ++ " repl foo:Foo.Bar\n"
          --        ++ "  " ++ pname ++ " repl testsuite1:Foo/Bar.hs\n"
          commandUsage :: ShowS
    commandUsage = \String
    pname -> String
    "Usage: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    pname String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    " repl [COMPONENT] [FLAGS]\n"
        , commandDefaultFlags :: ReplFlags
    commandDefaultFlags = ReplFlags
    defaultReplFlags
        , commandOptions :: ShowOrParseArgs -> [OptionField ReplFlags]
    commandOptions = \ShowOrParseArgs
    showOrParseArgs ->
            (ReplFlags -> Flag Verbosity)
    -> (Flag Verbosity -> ReplFlags -> ReplFlags)
    -> OptionField ReplFlags
    forall flags.
    (flags -> Flag Verbosity)
    -> (Flag Verbosity -> flags -> flags) -> OptionField flags
    optionVerbosity ReplFlags -> Flag Verbosity
    replVerbosity (\Flag Verbosity
    v ReplFlags
    flags -> ReplFlags
    flags{replVerbosity = v})
              OptionField ReplFlags
    -> [OptionField ReplFlags] -> [OptionField ReplFlags]
    forall a. a -> [a] -> [a]
    : (ReplFlags -> Flag String)
    -> (Flag String -> ReplFlags -> ReplFlags)
    -> ShowOrParseArgs
    -> OptionField ReplFlags
    forall flags.
    (flags -> Flag String)
    -> (Flag String -> flags -> flags)
    -> ShowOrParseArgs
    -> OptionField flags
    optionDistPref
                ReplFlags -> Flag String
    replDistPref
                (\Flag String
    d ReplFlags
    flags -> ReplFlags
    flags{replDistPref = d})
                ShowOrParseArgs
    showOrParseArgs
              OptionField ReplFlags
    -> [OptionField ReplFlags] -> [OptionField ReplFlags]
    forall a. a -> [a] -> [a]
    : ProgramDb
    -> ShowOrParseArgs
    -> (ReplFlags -> [(String, String)])
    -> ([(String, String)] -> ReplFlags -> ReplFlags)
    -> [OptionField ReplFlags]
    forall flags.
    ProgramDb
    -> ShowOrParseArgs
    -> (flags -> [(String, String)])
    -> ([(String, String)] -> flags -> flags)
    -> [OptionField flags]
    programDbPaths
                ProgramDb
    progDb
                ShowOrParseArgs
    showOrParseArgs
                ReplFlags -> [(String, String)]
    replProgramPaths
                (\[(String, String)]
    v ReplFlags
    flags -> ReplFlags
    flags{replProgramPaths = v})
              [OptionField ReplFlags]
    -> [OptionField ReplFlags] -> [OptionField ReplFlags]
    forall a. [a] -> [a] -> [a]
    ++ ProgramDb
    -> ShowOrParseArgs
    -> (ReplFlags -> [(String, [String])])
    -> ([(String, [String])] -> ReplFlags -> ReplFlags)
    -> [OptionField ReplFlags]
    forall flags.
    ProgramDb
    -> ShowOrParseArgs
    -> (flags -> [(String, [String])])
    -> ([(String, [String])] -> flags -> flags)
    -> [OptionField flags]
    programDbOption
                ProgramDb
    progDb
                ShowOrParseArgs
    showOrParseArgs
                ReplFlags -> [(String, [String])]
    replProgramArgs
                (\[(String, [String])]
    v ReplFlags
    flags -> ReplFlags
    flags{replProgramArgs = v})
              [OptionField ReplFlags]
    -> [OptionField ReplFlags] -> [OptionField ReplFlags]
    forall a. [a] -> [a] -> [a]
    ++ ProgramDb
    -> ShowOrParseArgs
    -> (ReplFlags -> [(String, [String])])
    -> ([(String, [String])] -> ReplFlags -> ReplFlags)
    -> [OptionField ReplFlags]
    forall flags.
    ProgramDb
    -> ShowOrParseArgs
    -> (flags -> [(String, [String])])
    -> ([(String, [String])] -> flags -> flags)
    -> [OptionField flags]
    programDbOptions
                ProgramDb
    progDb
                ShowOrParseArgs
    showOrParseArgs
                ReplFlags -> [(String, [String])]
    replProgramArgs
                (\[(String, [String])]
    v ReplFlags
    flags -> ReplFlags
    flags{replProgramArgs = v})
              [OptionField ReplFlags]
    -> [OptionField ReplFlags] -> [OptionField ReplFlags]
    forall a. [a] -> [a] -> [a]
    ++ case ShowOrParseArgs
    showOrParseArgs of
                ShowOrParseArgs
    ParseArgs ->
                  [ String
    -> [String]
    -> String
    -> (ReplFlags -> Flag Bool)
    -> (Flag Bool -> ReplFlags -> ReplFlags)
    -> MkOptDescr
         (ReplFlags -> Flag Bool)
         (Flag Bool -> ReplFlags -> ReplFlags)
         ReplFlags
    -> OptionField ReplFlags
    forall get set a.
    String
    -> [String]
    -> String
    -> get
    -> set
    -> MkOptDescr get set a
    -> OptionField a
    option
                      String
    ""
                      [String
    "reload"]
                      String
    "Used from within an interpreter to update files."
                      ReplFlags -> Flag Bool
    replReload
                      (\Flag Bool
    v ReplFlags
    flags -> ReplFlags
    flags{replReload = v})
                      MkOptDescr
      (ReplFlags -> Flag Bool)
      (Flag Bool -> ReplFlags -> ReplFlags)
      ReplFlags
    forall a. MkOptDescr (a -> Flag Bool) (Flag Bool -> a -> a) a
    trueArg
                  ]
                ShowOrParseArgs
    _ -> []
              [OptionField ReplFlags]
    -> [OptionField ReplFlags] -> [OptionField ReplFlags]
    forall a. [a] -> [a] -> [a]
    ++ (OptionField ReplOptions -> OptionField ReplFlags)
    -> [OptionField ReplOptions] -> [OptionField ReplFlags]
    forall a b. (a -> b) -> [a] -> [b]
    map OptionField ReplOptions -> OptionField ReplFlags
    liftReplOption (ShowOrParseArgs -> [OptionField ReplOptions]
    replOptions ShowOrParseArgs
    showOrParseArgs)
        }
      where
        liftReplOption :: OptionField ReplOptions -> OptionField ReplFlags
    liftReplOption = (ReplFlags -> ReplOptions)
    -> (ReplOptions -> ReplFlags -> ReplFlags)
    -> OptionField ReplOptions
    -> OptionField ReplFlags
    forall b a.
    (b -> a) -> (a -> b -> b) -> OptionField a -> OptionField b
    liftOption ReplFlags -> ReplOptions
    replReplOptions (\ReplOptions
    v ReplFlags
    flags -> ReplFlags
    flags{replReplOptions = v})

    replOptions :: ShowOrParseArgs -> [OptionField ReplOptions]
    replOptions :: ShowOrParseArgs -> [OptionField ReplOptions]
    replOptions ShowOrParseArgs
    _ =
      [ String
    -> [String]
    -> String
    -> (ReplOptions -> Flag Bool)
    -> (Flag Bool -> ReplOptions -> ReplOptions)
    -> MkOptDescr
         (ReplOptions -> Flag Bool)
         (Flag Bool -> ReplOptions -> ReplOptions)
         ReplOptions
    -> OptionField ReplOptions
    forall get set a.
    String
    -> [String]
    -> String
    -> get
    -> set
    -> MkOptDescr get set a
    -> OptionField a
    option
          []
          [String
    "repl-no-load"]
          String
    "Disable loading of project modules at REPL startup."
          ReplOptions -> Flag Bool
    replOptionsNoLoad
          (\Flag Bool
    p ReplOptions
    flags -> ReplOptions
    flags{replOptionsNoLoad = p})
          MkOptDescr
      (ReplOptions -> Flag Bool)
      (Flag Bool -> ReplOptions -> ReplOptions)
      ReplOptions
    forall a. MkOptDescr (a -> Flag Bool) (Flag Bool -> a -> a) a
    trueArg
      , String
    -> [String]
    -> String
    -> (ReplOptions -> [String])
    -> ([String] -> ReplOptions -> ReplOptions)
    -> MkOptDescr
         (ReplOptions -> [String])
         ([String] -> ReplOptions -> ReplOptions)
         ReplOptions
    -> OptionField ReplOptions
    forall get set a.
    String
    -> [String]
    -> String
    -> get
    -> set
    -> MkOptDescr get set a
    -> OptionField a
    option
          []
          [String
    "repl-options"]
          String
    "Use the option(s) for the repl"
          ReplOptions -> [String]
    replOptionsFlags
          (\[String]
    p ReplOptions
    flags -> ReplOptions
    flags{replOptionsFlags = p})
          (String
    -> ReadE [String]
    -> ([String] -> [String])
    -> MkOptDescr
         (ReplOptions -> [String])
         ([String] -> ReplOptions -> ReplOptions)
         ReplOptions
    forall b a.
    Monoid b =>
    String
    -> ReadE b
    -> (b -> [String])
    -> MkOptDescr (a -> b) (b -> a -> a) a
    reqArg String
    "FLAG" ((String -> [String]) -> ReadE [String]
    forall a. (String -> a) -> ReadE a
    succeedReadE String -> [String]
    words) [String] -> [String]
    forall a. a -> a
    id)
      , String
    -> [String]
    -> String
    -> (ReplOptions -> Flag String)
    -> (Flag String -> ReplOptions -> ReplOptions)
    -> MkOptDescr
         (ReplOptions -> Flag String)
         (Flag String -> ReplOptions -> ReplOptions)
         ReplOptions
    -> OptionField ReplOptions
    forall get set a.
    String
    -> [String]
    -> String
    -> get
    -> set
    -> MkOptDescr get set a
    -> OptionField a
    option
          []
          [String
    "repl-multi-file"]
          String
    "Write repl options to this directory rather than starting repl mode"
          ReplOptions -> Flag String
    replOptionsFlagOutput
          (\Flag String
    p ReplOptions
    flags -> ReplOptions
    flags{replOptionsFlagOutput = p})
          (String
    -> ReadE (Flag String)
    -> (Flag String -> [String])
    -> MkOptDescr
         (ReplOptions -> Flag String)
         (Flag String -> ReplOptions -> ReplOptions)
         ReplOptions
    forall b a.
    Monoid b =>
    String
    -> ReadE b
    -> (b -> [String])
    -> MkOptDescr (a -> b) (b -> a -> a) a
    reqArg String
    "DIR" ((String -> Flag String) -> ReadE (Flag String)
    forall a. (String -> a) -> ReadE a
    succeedReadE String -> Flag String
    forall a. a -> Flag a
    Flag) Flag String -> [String]
    forall a. Flag a -> [a]
    flagToList)
      ]