Cabal/src/Distribution/Simple/Setup/Repl.hs

   1 {-# LANGUAGE CPP #-}
   2 {-# LANGUAGE DeriveDataTypeable #-}
   3 {-# LANGUAGE DeriveGeneric #-}
   4 {-# LANGUAGE FlexibleContexts #-}
   5 {-# LANGUAGE RankNTypes #-}
   6
   7 -----------------------------------------------------------------------------
   8
   9 -- |
  10 -- Module      :  Distribution.Simple.Setup.Repl
  11 -- Copyright   :  Isaac Jones 2003-2004
  12 --                Duncan Coutts 2007
  13 -- License     :  BSD3
  14 --
  15 -- Maintainer  :  cabal-devel@haskell.org
  16 -- Portability :  portable
  17 --
  18 -- Definition of the repl command-line options.
  19 -- See: @Distribution.Simple.Setup@
  20 module Distribution.Simple.Setup.Repl
  21   ( ReplFlags (..)
  22   , defaultReplFlags
  23   , replCommand
  24   , ReplOptions (..)
  25   , replOptions
  26   ) where
  27
  28 import Distribution.Compat.Prelude hiding (get)
  29 import Prelude ()
  30
  31 import Distribution.ReadE
  32 import Distribution.Simple.Command hiding (boolOpt, boolOpt')
  33 import Distribution.Simple.Flag
  34 import Distribution.Simple.Program
  35 import Distribution.Simple.Utils
  36 import Distribution.Verbosity
  37
  38 import Distribution.Simple.Setup.Common
  39
  40 -- ------------------------------------------------------------
  41
  42 -- * REPL Flags
  43
  44 -- ------------------------------------------------------------
  45
  46 data ReplOptions = ReplOptions
  47   { replOptionsFlags :: [String]
  48   , replOptionsNoLoad :: Flag Bool
  49   , replOptionsFlagOutput :: Flag FilePath
  50   }
  51   deriving (Show, Generic, Typeable)
  52
  53 instance Binary ReplOptions
  54 instance Structured ReplOptions
  55
  56 instance Monoid ReplOptions where
  57   mempty = ReplOptions mempty (Flag False) NoFlag
  58   mappend = (<>)
  59
  60 instance Semigroup ReplOptions where
  61   (<>) = gmappend
  62
  63 data ReplFlags = ReplFlags
  64   { replProgramPaths :: [(String, FilePath)]
  65   , replProgramArgs :: [(String, [String])]
  66   , replDistPref :: Flag FilePath
  67   , replVerbosity :: Flag Verbosity
  68   , replReload :: Flag Bool
  69   , replReplOptions :: ReplOptions
  70   }
  71   deriving (Show, Generic, Typeable)
  72
  73 defaultReplFlags :: ReplFlags
  74 defaultReplFlags =
  75   ReplFlags
  76     { replProgramPaths = mempty
  77     , replProgramArgs = []
  78     , replDistPref = NoFlag
  79     , replVerbosity = Flag normal
  80     , replReload = Flag False
  81     , replReplOptions = mempty
  82     }
  83
  84 instance Monoid ReplFlags where
  85   mempty = gmempty
  86   mappend = (<>)
  87
  88 instance Semigroup ReplFlags where
  89   (<>) = gmappend
  90
  91 replCommand :: ProgramDb -> CommandUI ReplFlags
  92 replCommand progDb =
  93   CommandUI
  94     { commandName = "repl"
  95     , commandSynopsis =
  96         "Open an interpreter session for the given component."
  97     , commandDescription = Just $ \pname ->
  98         wrapText $
  99           "If the current directory contains no package, ignores COMPONENT "
 100             ++ "parameters and opens an interactive interpreter session; if a "
 101             ++ "sandbox is present, its package database will be used.\n"
 102             ++ "\n"
 103             ++ "Otherwise, (re)configures with the given or default flags, and "
 104             ++ "loads the interpreter with the relevant modules. For executables, "
 105             ++ "tests and benchmarks, loads the main module (and its "
 106             ++ "dependencies); for libraries all exposed/other modules.\n"
 107             ++ "\n"
 108             ++ "The default component is the library itself, or the executable "
 109             ++ "if that is the only component.\n"
 110             ++ "\n"
 111             ++ "Support for loading specific modules is planned but not "
 112             ++ "implemented yet. For certain scenarios, `"
 113             ++ pname
 114             ++ " exec -- ghci :l Foo` may be used instead. Note that `exec` will "
 115             ++ "not (re)configure and you will have to specify the location of "
 116             ++ "other modules, if required.\n"
 117     , commandNotes = Just $ \pname ->
 118         "Examples:\n"
 119           ++ "  "
 120           ++ pname
 121           ++ " repl           "
 122           ++ "    The first component in the package\n"
 123           ++ "  "
 124           ++ pname
 125           ++ " repl foo       "
 126           ++ "    A named component (i.e. lib, exe, test suite)\n"
 127           ++ "  "
 128           ++ pname
 129           ++ " repl --repl-options=\"-lstdc++\""
 130           ++ "  Specifying flags for interpreter\n"
 131     , -- TODO: re-enable once we have support for module/file targets
 132       --        ++ "  " ++ pname ++ " repl Foo.Bar   "
 133       --        ++ "    A module\n"
 134       --        ++ "  " ++ pname ++ " repl Foo/Bar.hs"
 135       --        ++ "    A file\n\n"
 136       --        ++ "If a target is ambiguous it can be qualified with the component "
 137       --        ++ "name, e.g.\n"
 138       --        ++ "  " ++ pname ++ " repl foo:Foo.Bar\n"
 139       --        ++ "  " ++ pname ++ " repl testsuite1:Foo/Bar.hs\n"
 140       commandUsage = \pname -> "Usage: " ++ pname ++ " repl [COMPONENT] [FLAGS]\n"
 141     , commandDefaultFlags = defaultReplFlags
 142     , commandOptions = \showOrParseArgs ->
 143         optionVerbosity replVerbosity (\v flags -> flags{replVerbosity = v})
 144           : optionDistPref
 145             replDistPref
 146             (\d flags -> flags{replDistPref = d})
 147             showOrParseArgs
 148           : programDbPaths
 149             progDb
 150             showOrParseArgs
 151             replProgramPaths
 152             (\v flags -> flags{replProgramPaths = v})
 153           ++ programDbOption
 154             progDb
 155             showOrParseArgs
 156             replProgramArgs
 157             (\v flags -> flags{replProgramArgs = v})
 158           ++ programDbOptions
 159             progDb
 160             showOrParseArgs
 161             replProgramArgs
 162             (\v flags -> flags{replProgramArgs = v})
 163           ++ case showOrParseArgs of
 164             ParseArgs ->
 165               [ option
 166                   ""
 167                   ["reload"]
 168                   "Used from within an interpreter to update files."
 169                   replReload
 170                   (\v flags -> flags{replReload = v})
 171                   trueArg
 172               ]
 173             _ -> []
 174           ++ map liftReplOption (replOptions showOrParseArgs)
 175     }
 176   where
 177     liftReplOption = liftOption replReplOptions (\v flags -> flags{replReplOptions = v})
 178
 179 replOptions :: ShowOrParseArgs -> [OptionField ReplOptions]
 180 replOptions _ =
 181   [ option
 182       []
 183       ["repl-no-load"]
 184       "Disable loading of project modules at REPL startup."
 185       replOptionsNoLoad
 186       (\p flags -> flags{replOptionsNoLoad = p})
 187       trueArg
 188   , option
 189       []
 190       ["repl-options"]
 191       "Use the option(s) for the repl"
 192       replOptionsFlags
 193       (\p flags -> flags{replOptionsFlags = p})
 194       (reqArg "FLAG" (succeedReadE words) id)
 195   , option
 196       []
 197       ["repl-multi-file"]
 198       "Write repl options to this directory rather than starting repl mode"
 199       replOptionsFlagOutput
 200       (\p flags -> flags{replOptionsFlagOutput = p})
 201       (reqArg "DIR" (succeedReadE Flag) flagToList)
 202   ]