mirror of
https://github.com/digital-asset/daml.git
synced 2024-09-17 15:57:21 +03:00
Move the DAML config stuff out of haskell-ide-core (#940)
* Move the GHC config stuff out of haskell-ide-core * Add an export list to UtilGHC
This commit is contained in:
Neil Mitchell
GitHub
parent
569fb1b2d2
commit
1a069ad80b
@ -11,25 +11,35 @@
|
||||
-- * Call runGhc, use runGhcFast instead. It's faster and doesn't require config we don't have.
|
||||
--
|
||||
-- * Call setSessionDynFlags, use modifyDynFlags instead. It's faster and avoids loading packages.
|
||||
module Development.IDE.UtilGHC(module Development.IDE.UtilGHC) where
|
||||
module Development.IDE.UtilGHC(
|
||||
PackageState(..),
|
||||
modifyDynFlags,
|
||||
textToStringBuffer,
|
||||
removeTypeableInfo,
|
||||
setPackageImports,
|
||||
setPackageDbs,
|
||||
fakeSettings,
|
||||
fakeLlvmConfig,
|
||||
prettyPrint,
|
||||
importGenerated,
|
||||
mkImport,
|
||||
runGhcFast,
|
||||
Development.IDE.UtilGHC.RealLocated,
|
||||
modIsInternal
|
||||
) where
|
||||
|
||||
import Config
|
||||
import qualified CmdLineParser as Cmd (warnMsg)
|
||||
import DynFlags (parseDynamicFilePragma)
|
||||
import Fingerprint
|
||||
import GHC hiding (convertLit)
|
||||
import GHC.LanguageExtensions.Type
|
||||
import GhcMonad
|
||||
import GhcPlugins as GHC hiding (PackageState, fst3, (<>))
|
||||
import HscMain
|
||||
import qualified Packages
|
||||
import Panic (throwGhcExceptionIO)
|
||||
import Platform
|
||||
import qualified StringBuffer as SB
|
||||
import qualified EnumSet
|
||||
|
||||
import Control.DeepSeq
|
||||
import Control.Monad
|
||||
import Data.IORef
|
||||
import Data.List
|
||||
import qualified Data.Text as T
|
||||
@ -38,111 +48,6 @@ import GHC.Generics (Generic)
|
||||
----------------------------------------------------------------------
|
||||
-- GHC setup
|
||||
|
||||
-- | Language options enabled in the DAML-1.2 compilation
|
||||
xExtensionsSet :: [Extension]
|
||||
xExtensionsSet =
|
||||
[ -- syntactic convenience
|
||||
RecordPuns, RecordWildCards, LambdaCase, TupleSections, BlockArguments, ViewPatterns,
|
||||
NumericUnderscores
|
||||
-- records
|
||||
, DuplicateRecordFields, DisambiguateRecordFields
|
||||
-- types and kinds
|
||||
, ScopedTypeVariables, ExplicitForAll
|
||||
, DataKinds, KindSignatures, RankNTypes, TypeApplications
|
||||
, ConstraintKinds
|
||||
-- type classes
|
||||
, MultiParamTypeClasses, FlexibleInstances, GeneralizedNewtypeDeriving, TypeSynonymInstances
|
||||
, DefaultSignatures, StandaloneDeriving, FunctionalDependencies, DeriveFunctor
|
||||
-- replacing primitives
|
||||
, RebindableSyntax, OverloadedStrings
|
||||
-- strictness
|
||||
, Strict, StrictData
|
||||
-- avoiding letrec in list comp (see DEL-3841)
|
||||
, MonadComprehensions
|
||||
-- package imports
|
||||
, PackageImports
|
||||
-- our changes
|
||||
, NewColonConvention
|
||||
, DamlVersionRequired
|
||||
, WithRecordSyntax
|
||||
, DamlTemplate
|
||||
]
|
||||
|
||||
|
||||
-- | Language settings _disabled_ ($-XNo...$) in the DAML-1.2 compilation
|
||||
xExtensionsUnset :: [Extension]
|
||||
xExtensionsUnset = [ ]
|
||||
|
||||
-- | Flags set for DAML-1.2 compilation
|
||||
xFlagsSet :: [ GeneralFlag ]
|
||||
xFlagsSet = [
|
||||
Opt_Haddock
|
||||
, Opt_Ticky
|
||||
]
|
||||
|
||||
-- | Warning options set for DAML compilation. Note that these can be modified
|
||||
-- (per file) by the user via file headers '{-# OPTIONS -fwarn-... #-} and
|
||||
-- '{-# OPTIONS -no-warn-... #-}'.
|
||||
wOptsSet :: [ WarningFlag ]
|
||||
wOptsSet =
|
||||
[ Opt_WarnUnusedImports
|
||||
, Opt_WarnPrepositiveQualifiedModule
|
||||
, Opt_WarnOverlappingPatterns
|
||||
, Opt_WarnIncompletePatterns
|
||||
]
|
||||
|
||||
-- | Warning options set for DAML compilation, which become errors.
|
||||
wOptsSetFatal :: [ WarningFlag ]
|
||||
wOptsSetFatal =
|
||||
[ Opt_WarnMissingFields
|
||||
]
|
||||
|
||||
-- | Warning options unset for DAML compilation. Note that these can be modified
|
||||
-- (per file) by the user via file headers '{-# OPTIONS -fwarn-... #-} and
|
||||
-- '{-# OPTIONS -no-warn-... #-}'.
|
||||
wOptsUnset :: [ WarningFlag ]
|
||||
wOptsUnset =
|
||||
[ Opt_WarnMissingMonadFailInstances -- failable pattern plus RebindableSyntax raises this error
|
||||
, Opt_WarnOverflowedLiterals -- this does not play well with -ticky and the error message is misleading
|
||||
]
|
||||
|
||||
|
||||
adjustDynFlags :: [FilePath] -> PackageState -> Maybe String -> DynFlags -> DynFlags
|
||||
adjustDynFlags paths packageState mbPackageName dflags
|
||||
= setImports paths
|
||||
$ setPackageState packageState
|
||||
$ setThisInstalledUnitId (maybe mainUnitId stringToUnitId mbPackageName)
|
||||
-- once we have package imports working, we want to import the base package and set this to
|
||||
-- the default instead of always compiling in the context of ghc-prim.
|
||||
$ apply wopt_set wOptsSet
|
||||
$ apply wopt_unset wOptsUnset
|
||||
$ apply wopt_set_fatal wOptsSetFatal
|
||||
$ apply xopt_set xExtensionsSet
|
||||
$ apply xopt_unset xExtensionsUnset
|
||||
$ apply gopt_set xFlagsSet
|
||||
dflags{
|
||||
mainModIs = mkModule primUnitId (mkModuleName "NotAnExistingName"), -- avoid DEL-6770
|
||||
debugLevel = 1,
|
||||
ghcLink = NoLink, hscTarget = HscNothing -- avoid generating .o or .hi files
|
||||
{-, dumpFlags = Opt_D_ppr_debug `EnumSet.insert` dumpFlags dflags -- turn on debug output from GHC-}
|
||||
}
|
||||
where apply f xs d = foldl' f d xs
|
||||
|
||||
setThisInstalledUnitId :: UnitId -> DynFlags -> DynFlags
|
||||
setThisInstalledUnitId unitId dflags =
|
||||
dflags {thisInstalledUnitId = toInstalledUnitId unitId}
|
||||
|
||||
setImports :: [FilePath] -> DynFlags -> DynFlags
|
||||
setImports paths dflags = dflags { importPaths = paths }
|
||||
|
||||
setPackageState :: PackageState -> DynFlags -> DynFlags
|
||||
setPackageState state dflags =
|
||||
dflags
|
||||
{ pkgDatabase = pkgStateDb state
|
||||
, pkgState = pkgStateState state
|
||||
, thisUnitIdInsts_ = pkgThisUnitIdInsts state
|
||||
}
|
||||
|
||||
setPackageDbs :: [FilePath] -> DynFlags -> DynFlags
|
||||
setPackageDbs paths dflags =
|
||||
dflags
|
||||
@ -185,31 +90,6 @@ data PackageState = PackageState
|
||||
instance NFData PackageState where
|
||||
rnf (PackageState db state insts) = db `seq` state `seq` rnf insts
|
||||
|
||||
-- | Configures the @DynFlags@ for this session to DAML-1.2
|
||||
-- compilation:
|
||||
-- * Installs a custom log action;
|
||||
-- * Sets up the package databases;
|
||||
-- * Sets the import paths to the given list of 'FilePath'.
|
||||
-- * if present, parses and applies custom options for GHC
|
||||
-- (may fail if the custom options are inconsistent with std DAML ones)
|
||||
setupDamlGHC :: GhcMonad m => [FilePath] -> Maybe String -> PackageState -> [String] -> m ()
|
||||
setupDamlGHC importPaths mbPackageName packageState [] =
|
||||
modifyDynFlags $ adjustDynFlags importPaths packageState mbPackageName
|
||||
-- if custom options are given, add them after the standard DAML flag setup
|
||||
setupDamlGHC importPaths mbPackageName packageState customOpts = do
|
||||
setupDamlGHC importPaths mbPackageName packageState []
|
||||
damlDFlags <- getSessionDynFlags
|
||||
(dflags', leftover, warns) <- parseDynamicFilePragma damlDFlags $ map noLoc customOpts
|
||||
|
||||
let leftoverError = CmdLineError $
|
||||
(unlines . ("Unable to parse custom flags:":) . map unLoc) leftover
|
||||
unless (null leftover) $ liftIO $ throwGhcExceptionIO leftoverError
|
||||
|
||||
unless (null warns) $
|
||||
liftIO $ putStrLn $ unlines $ "Warnings:" : map (unLoc . Cmd.warnMsg) warns
|
||||
|
||||
modifySession $ \h ->
|
||||
h { hsc_dflags = dflags', hsc_IC = (hsc_IC h) {ic_dflags = dflags' } }
|
||||
|
||||
-- | A version of `showSDoc` that uses default flags (to avoid uses of
|
||||
-- `showSDocUnsafe`).
|
||||
|
||||
156
daml-foundations/daml-ghc/src/DA/Daml/GHC/Compiler/Config.hs
Normal file
156
daml-foundations/daml-ghc/src/DA/Daml/GHC/Compiler/Config.hs
Normal file
@ -0,0 +1,156 @@
|
||||
-- Copyright (c) 2019 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved.
|
||||
-- SPDX-License-Identifier: Apache-2.0
|
||||
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE PatternSynonyms #-}
|
||||
{-# OPTIONS_GHC -Wno-missing-fields #-} -- to enable prettyPrint
|
||||
{-# OPTIONS_GHC -Wno-orphans #-}
|
||||
|
||||
-- | Set up the GHC monad in a way that works for us
|
||||
module DA.Daml.GHC.Compiler.Config(setupDamlGHC) where
|
||||
|
||||
import Development.IDE.UtilGHC
|
||||
import qualified CmdLineParser as Cmd (warnMsg)
|
||||
import DynFlags (parseDynamicFilePragma)
|
||||
import GHC hiding (convertLit)
|
||||
import GHC.LanguageExtensions.Type
|
||||
import GhcMonad
|
||||
import GhcPlugins as GHC hiding (PackageState, fst3, (<>))
|
||||
import Panic (throwGhcExceptionIO)
|
||||
|
||||
import Control.Monad
|
||||
import Data.List
|
||||
|
||||
----------------------------------------------------------------------
|
||||
-- GHC setup
|
||||
|
||||
-- | Language options enabled in the DAML-1.2 compilation
|
||||
xExtensionsSet :: [Extension]
|
||||
xExtensionsSet =
|
||||
[ -- syntactic convenience
|
||||
RecordPuns, RecordWildCards, LambdaCase, TupleSections, BlockArguments, ViewPatterns,
|
||||
NumericUnderscores
|
||||
-- records
|
||||
, DuplicateRecordFields, DisambiguateRecordFields
|
||||
-- types and kinds
|
||||
, ScopedTypeVariables, ExplicitForAll
|
||||
, DataKinds, KindSignatures, RankNTypes, TypeApplications
|
||||
, ConstraintKinds
|
||||
-- type classes
|
||||
, MultiParamTypeClasses, FlexibleInstances, GeneralizedNewtypeDeriving, TypeSynonymInstances
|
||||
, DefaultSignatures, StandaloneDeriving, FunctionalDependencies, DeriveFunctor
|
||||
-- replacing primitives
|
||||
, RebindableSyntax, OverloadedStrings
|
||||
-- strictness
|
||||
, Strict, StrictData
|
||||
-- avoiding letrec in list comp (see DEL-3841)
|
||||
, MonadComprehensions
|
||||
-- package imports
|
||||
, PackageImports
|
||||
-- our changes
|
||||
, NewColonConvention
|
||||
, DamlVersionRequired
|
||||
, WithRecordSyntax
|
||||
, DamlTemplate
|
||||
]
|
||||
|
||||
|
||||
-- | Language settings _disabled_ ($-XNo...$) in the DAML-1.2 compilation
|
||||
xExtensionsUnset :: [Extension]
|
||||
xExtensionsUnset = [ ]
|
||||
|
||||
-- | Flags set for DAML-1.2 compilation
|
||||
xFlagsSet :: [ GeneralFlag ]
|
||||
xFlagsSet = [
|
||||
Opt_Haddock
|
||||
, Opt_Ticky
|
||||
]
|
||||
|
||||
-- | Warning options set for DAML compilation. Note that these can be modified
|
||||
-- (per file) by the user via file headers '{-# OPTIONS -fwarn-... #-} and
|
||||
-- '{-# OPTIONS -no-warn-... #-}'.
|
||||
wOptsSet :: [ WarningFlag ]
|
||||
wOptsSet =
|
||||
[ Opt_WarnUnusedImports
|
||||
, Opt_WarnPrepositiveQualifiedModule
|
||||
, Opt_WarnOverlappingPatterns
|
||||
, Opt_WarnIncompletePatterns
|
||||
]
|
||||
|
||||
-- | Warning options set for DAML compilation, which become errors.
|
||||
wOptsSetFatal :: [ WarningFlag ]
|
||||
wOptsSetFatal =
|
||||
[ Opt_WarnMissingFields
|
||||
]
|
||||
|
||||
-- | Warning options unset for DAML compilation. Note that these can be modified
|
||||
-- (per file) by the user via file headers '{-# OPTIONS -fwarn-... #-} and
|
||||
-- '{-# OPTIONS -no-warn-... #-}'.
|
||||
wOptsUnset :: [ WarningFlag ]
|
||||
wOptsUnset =
|
||||
[ Opt_WarnMissingMonadFailInstances -- failable pattern plus RebindableSyntax raises this error
|
||||
, Opt_WarnOverflowedLiterals -- this does not play well with -ticky and the error message is misleading
|
||||
]
|
||||
|
||||
|
||||
adjustDynFlags :: [FilePath] -> PackageState -> Maybe String -> DynFlags -> DynFlags
|
||||
adjustDynFlags paths packageState mbPackageName dflags
|
||||
= setImports paths
|
||||
$ setPackageState packageState
|
||||
$ setThisInstalledUnitId (maybe mainUnitId stringToUnitId mbPackageName)
|
||||
-- once we have package imports working, we want to import the base package and set this to
|
||||
-- the default instead of always compiling in the context of ghc-prim.
|
||||
$ apply wopt_set wOptsSet
|
||||
$ apply wopt_unset wOptsUnset
|
||||
$ apply wopt_set_fatal wOptsSetFatal
|
||||
$ apply xopt_set xExtensionsSet
|
||||
$ apply xopt_unset xExtensionsUnset
|
||||
$ apply gopt_set xFlagsSet
|
||||
dflags{
|
||||
mainModIs = mkModule primUnitId (mkModuleName "NotAnExistingName"), -- avoid DEL-6770
|
||||
debugLevel = 1,
|
||||
ghcLink = NoLink, hscTarget = HscNothing -- avoid generating .o or .hi files
|
||||
{-, dumpFlags = Opt_D_ppr_debug `EnumSet.insert` dumpFlags dflags -- turn on debug output from GHC-}
|
||||
}
|
||||
where apply f xs d = foldl' f d xs
|
||||
|
||||
setThisInstalledUnitId :: UnitId -> DynFlags -> DynFlags
|
||||
setThisInstalledUnitId unitId dflags =
|
||||
dflags {thisInstalledUnitId = toInstalledUnitId unitId}
|
||||
|
||||
setImports :: [FilePath] -> DynFlags -> DynFlags
|
||||
setImports paths dflags = dflags { importPaths = paths }
|
||||
|
||||
setPackageState :: PackageState -> DynFlags -> DynFlags
|
||||
setPackageState state dflags =
|
||||
dflags
|
||||
{ pkgDatabase = pkgStateDb state
|
||||
, pkgState = pkgStateState state
|
||||
, thisUnitIdInsts_ = pkgThisUnitIdInsts state
|
||||
}
|
||||
|
||||
-- | Configures the @DynFlags@ for this session to DAML-1.2
|
||||
-- compilation:
|
||||
-- * Installs a custom log action;
|
||||
-- * Sets up the package databases;
|
||||
-- * Sets the import paths to the given list of 'FilePath'.
|
||||
-- * if present, parses and applies custom options for GHC
|
||||
-- (may fail if the custom options are inconsistent with std DAML ones)
|
||||
setupDamlGHC :: GhcMonad m => [FilePath] -> Maybe String -> PackageState -> [String] -> m ()
|
||||
setupDamlGHC importPaths mbPackageName packageState [] =
|
||||
modifyDynFlags $ adjustDynFlags importPaths packageState mbPackageName
|
||||
-- if custom options are given, add them after the standard DAML flag setup
|
||||
setupDamlGHC importPaths mbPackageName packageState customOpts = do
|
||||
setupDamlGHC importPaths mbPackageName packageState []
|
||||
damlDFlags <- getSessionDynFlags
|
||||
(dflags', leftover, warns) <- parseDynamicFilePragma damlDFlags $ map noLoc customOpts
|
||||
|
||||
let leftoverError = CmdLineError $
|
||||
(unlines . ("Unable to parse custom flags:":) . map unLoc) leftover
|
||||
unless (null leftover) $ liftIO $ throwGhcExceptionIO leftoverError
|
||||
|
||||
unless (null warns) $
|
||||
liftIO $ putStrLn $ unlines $ "Warnings:" : map (unLoc . Cmd.warnMsg) warns
|
||||
|
||||
modifySession $ \h ->
|
||||
h { hsc_dflags = dflags', hsc_IC = (hsc_IC h) {ic_dflags = dflags' } }
|
||||
@ -13,7 +13,8 @@ module DA.Daml.GHC.Compiler.Options
|
||||
) where
|
||||
|
||||
|
||||
import Development.IDE.UtilGHC (runGhcFast, setupDamlGHC)
|
||||
import Development.IDE.UtilGHC (runGhcFast)
|
||||
import DA.Daml.GHC.Compiler.Config (setupDamlGHC)
|
||||
import qualified Development.IDE.Functions.Compile as Compile
|
||||
|
||||
import DA.Bazel.Runfiles
|
||||
|
||||
Loading…
Reference in New Issue
Block a user