{-# 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)

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)
  ]