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

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