@@ -14,6 +14,8 @@
1414module Development.IDE.UtilGHC where
1515
1616import "ghc-lib-parser" Config
17+import qualified "ghc-lib-parser" CmdLineParser as Cmd (warnMsg)
18+import "ghc-lib-parser" DynFlags (parseDynamicFilePragma)
1719import "ghc-lib-parser" Fingerprint
1820import "ghc-lib" GHC hiding (convertLit)
1921import "ghc-lib-parser" GHC.LanguageExtensions.Type
@@ -21,11 +23,13 @@ import "ghc-lib-parser" GhcMonad
2123import "ghc-lib" GhcPlugins as GHC hiding (PackageState, fst3, (<>))
2224import "ghc-lib" HscMain
2325import qualified "ghc-lib-parser" Packages
26+import "ghc-lib-parser" Panic (throwGhcExceptionIO)
2427import "ghc-lib-parser" Platform
2528import qualified "ghc-lib-parser" StringBuffer as SB
2629import qualified "ghc-lib-parser" EnumSet
2730
2831import Control.DeepSeq
32+import Control.Monad
2933import Data.IORef
3034import Data.List
3135import qualified Data.Text as T
@@ -185,9 +189,26 @@ instance NFData PackageState where
185189-- * Installs a custom log action;
186190-- * Sets up the package databases;
187191-- * Sets the import paths to the given list of 'FilePath'.
188−setupDamlGHC :: GhcMonad m => [FilePath] -> Maybe String -> PackageState -> m ()
189−setupDamlGHC importPaths mbPackageName packageState = do
192+-- * if present, parses and applies custom options for GHC
193+-- (may fail if the custom options are inconsistent with std DAML ones)
194+setupDamlGHC :: GhcMonad m => [FilePath] -> Maybe String -> PackageState -> [String] -> m ()
195+setupDamlGHC importPaths mbPackageName packageState [] =
190196 modifyDynFlags $ adjustDynFlags importPaths packageState mbPackageName
197+-- if custom options are given, add them after the standard DAML flag setup
198+setupDamlGHC importPaths mbPackageName packageState customOpts = do
199+ setupDamlGHC importPaths mbPackageName packageState []
200+ damlDFlags <- getSessionDynFlags
201+ (dflags', leftover, warns) <- parseDynamicFilePragma damlDFlags $ map noLoc customOpts
202+
203+ let leftoverError = CmdLineError $
204+ (unlines . ("Unable to parse custom flags:":) . map unLoc) leftover
205+ unless (null leftover) $ liftIO $ throwGhcExceptionIO leftoverError
206+
207+ unless (null warns) $
208+ liftIO $ putStrLn $ unlines $ "Warnings:" : map (unLoc . Cmd.warnMsg) warns
209+
210+ modifySession $ \h ->
211+ h { hsc_dflags = dflags', hsc_IC = (hsc_IC h) {ic_dflags = dflags' } }
191212
192213-- | A version of `showSDoc` that uses default flags (to avoid uses of
193214-- `showSDocUnsafe`).