{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ViewPatterns #-}

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

-- |
-- 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
      ( ReplCommonFlags
      , replVerbosity
      , replDistPref
      , replCabalFilePath
      , replWorkingDir
      , replTargets
      , ..
      )
  , 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.Setup.Common
import Distribution.Simple.Utils
import Distribution.Utils.Path
import Distribution.Verbosity

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

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

pattern ReplCommonFlags
  :: Flag Verbosity
  -> Flag (SymbolicPath Pkg (Dir Dist))
  -> Flag (SymbolicPath CWD (Dir Pkg))
  -> Flag (SymbolicPath Pkg File)
  -> [String]
  -> ReplFlags
pattern $mReplCommonFlags :: forall {r}.
ReplFlags
-> (Flag Verbosity
    -> Flag (SymbolicPath Pkg ('Dir Dist))
    -> Flag (SymbolicPath CWD ('Dir Pkg))
    -> Flag (SymbolicPath Pkg 'File)
    -> [String]
    -> r)
-> ((# #) -> r)
-> r
ReplCommonFlags
  { ReplFlags -> Flag Verbosity
replVerbosity
  , ReplFlags -> Flag (SymbolicPath Pkg ('Dir Dist))
replDistPref
  , ReplFlags -> Flag (SymbolicPath CWD ('Dir Pkg))
replWorkingDir
  , ReplFlags -> Flag (SymbolicPath Pkg 'File)
replCabalFilePath
  , ReplFlags -> [String]
replTargets
  } <-
  ( replCommonFlags ->
      CommonSetupFlags
        { setupVerbosity = replVerbosity
        , setupDistPref = replDistPref
        , setupWorkingDir = replWorkingDir
        , setupCabalFilePath = replCabalFilePath
        , setupTargets = replTargets
        }
    )

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 -> CommonSetupFlags
replCommonFlags :: !CommonSetupFlags
  , ReplFlags -> [(String, String)]
replProgramPaths :: [(String, FilePath)]
  , ReplFlags -> [(String, [String])]
replProgramArgs :: [(String, [String])]
  , 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
    { replCommonFlags :: CommonSetupFlags
replCommonFlags = CommonSetupFlags
defaultCommonSetupFlags
    , replProgramPaths :: [(String, String)]
replProgramPaths = [(String, String)]
forall a. Monoid a => a
mempty
    , replProgramArgs :: [(String, [String])]
replProgramArgs = []
    , 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 -> CommonSetupFlags)
-> (CommonSetupFlags -> ReplFlags -> ReplFlags)
-> ShowOrParseArgs
-> [OptionField ReplFlags]
-> [OptionField ReplFlags]
forall flags.
(flags -> CommonSetupFlags)
-> (CommonSetupFlags -> flags -> flags)
-> ShowOrParseArgs
-> [OptionField flags]
-> [OptionField flags]
withCommonSetupOptions
          ReplFlags -> CommonSetupFlags
replCommonFlags
          (\CommonSetupFlags
c ReplFlags
f -> ReplFlags
f{replCommonFlags = c})
          ShowOrParseArgs
showOrParseArgs
          ([OptionField ReplFlags] -> [OptionField ReplFlags])
-> [OptionField ReplFlags] -> [OptionField ReplFlags]
forall a b. (a -> b) -> a -> b
$ 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)
  ]