cabal-install/src/Distribution/Client/ReplFlags.hs

   1 module Distribution.Client.ReplFlags (EnvFlags (..), ReplFlags (..), topReplOptions, multiReplOption, defaultReplFlags) where
   2
   3 import Distribution.Client.Compat.Prelude
   4 import Prelude ()
   5
   6 import Distribution.Client.Setup
   7   ( liftOptions
   8   )
   9 import Distribution.Parsec
  10   ( parsecCommaList
  11   )
  12 import Distribution.ReadE
  13   ( ReadE
  14   , parsecToReadE
  15   )
  16 import Distribution.Simple.Command
  17   ( OptionField
  18   , ShowOrParseArgs
  19   , liftOption
  20   , option
  21   , reqArg
  22   )
  23 import Distribution.Simple.Setup
  24   ( Flag (..)
  25   , ReplOptions (..)
  26   , boolOpt
  27   , falseArg
  28   , replOptions
  29   , toFlag
  30   , trueArg
  31   )
  32 import Distribution.Types.Dependency
  33   ( Dependency (..)
  34   )
  35
  36 data EnvFlags = EnvFlags
  37   { envPackages :: [Dependency]
  38   , envIncludeTransitive :: Flag Bool
  39   }
  40
  41 instance Semigroup EnvFlags where
  42   (EnvFlags a1 a2) <> (EnvFlags b1 b2) = EnvFlags (a1 <> b1) (a2 <> b2)
  43
  44 instance Monoid EnvFlags where
  45   mempty = defaultEnvFlags
  46
  47 defaultEnvFlags :: EnvFlags
  48 defaultEnvFlags =
  49   EnvFlags
  50     { envPackages = []
  51     , envIncludeTransitive = toFlag True
  52     }
  53
  54 data ReplFlags = ReplFlags
  55   { configureReplOptions :: ReplOptions
  56   , replEnvFlags :: EnvFlags
  57   , replUseMulti :: Flag Bool
  58   , replKeepTempFiles :: Flag Bool
  59   }
  60
  61 instance Semigroup ReplFlags where
  62   (ReplFlags a1 a2 a3 a4) <> (ReplFlags b1 b2 b3 b4) = ReplFlags (a1 <> b1) (a2 <> b2) (a3 <> b3) (a4 <> b4)
  63
  64 instance Monoid ReplFlags where
  65   mempty = defaultReplFlags
  66
  67 defaultReplFlags :: ReplFlags
  68 defaultReplFlags =
  69   ReplFlags
  70     { configureReplOptions = mempty
  71     , replEnvFlags = defaultEnvFlags
  72     , replUseMulti = NoFlag
  73     , replKeepTempFiles = NoFlag
  74     }
  75
  76 topReplOptions :: ShowOrParseArgs -> [OptionField ReplFlags]
  77 topReplOptions showOrParseArgs =
  78   liftOptions configureReplOptions set1 (replOptions showOrParseArgs)
  79     ++ liftOptions replEnvFlags set2 (envOptions showOrParseArgs)
  80     ++ [ liftOption replUseMulti set3 multiReplOption
  81        , -- keeping temporary files is important functionality for HLS,
  82          -- which runs @cabal repl@ with fake GHC to get cli arguments.
  83          -- It will need the temporary files (incl. multi unit repl response files)
  84          -- to stay, even after the @cabal repl@ command exits.
  85          --
  86          option
  87           []
  88           ["keep-temp-files"]
  89           "Keep temporary files"
  90           replKeepTempFiles
  91           (\b flags -> flags{replKeepTempFiles = b})
  92           trueArg
  93        ]
  94   where
  95     set1 a x = x{configureReplOptions = a}
  96     set2 a x = x{replEnvFlags = a}
  97     set3 a x = x{replUseMulti = a}
  98
  99 multiReplOption :: OptionField (Flag Bool)
 100 multiReplOption =
 101   option
 102     []
 103     ["multi-repl"]
 104     "multi-component repl sessions"
 105     id
 106     (\v _ -> v)
 107     (boolOpt [] [])
 108
 109 envOptions :: ShowOrParseArgs -> [OptionField EnvFlags]
 110 envOptions _ =
 111   [ option
 112       ['b']
 113       ["build-depends"]
 114       "Include additional packages in the environment presented to GHCi."
 115       envPackages
 116       (\p flags -> flags{envPackages = p ++ envPackages flags})
 117       (reqArg "DEPENDENCIES" dependenciesReadE (fmap prettyShow :: [Dependency] -> [String]))
 118   , option
 119       []
 120       ["no-transitive-deps"]
 121       "Don't automatically include transitive dependencies of requested packages."
 122       envIncludeTransitive
 123       (\p flags -> flags{envIncludeTransitive = p})
 124       falseArg
 125   ]
 126   where
 127     dependenciesReadE :: ReadE [Dependency]
 128     dependenciesReadE =
 129       parsecToReadE
 130         ("couldn't parse dependencies: " ++)
 131         (parsecCommaList parsec)