Commit ed5f858b authored by Shayne Fletcher's avatar Shayne Fletcher 🥝 Committed by Marge Bot
Browse files

Implement ImportQualifiedPost

parent 0eeb4cfa
Pipeline #5600 failed with stages
in 430 minutes
......@@ -29,6 +29,7 @@ import SrcLoc
import HsExtension
import Data.Data
import Data.Maybe
{-
************************************************************************
......@@ -48,6 +49,29 @@ type LImportDecl pass = Located (ImportDecl pass)
-- For details on above see note [Api annotations] in ApiAnnotation
-- | If/how an import is 'qualified'.
data ImportDeclQualifiedStyle
= QualifiedPre -- ^ 'qualified' appears in prepositive position.
| QualifiedPost -- ^ 'qualified' appears in postpositive position.
| NotQualified -- ^ Not qualified.
deriving (Eq, Data)
-- | Given two possible located 'qualified' tokens, compute a style
-- (in a conforming Haskell program only one of the two can be not
-- 'Nothing'). This is called from 'Parser.y'.
importDeclQualifiedStyle :: Maybe (Located a)
-> Maybe (Located a)
-> ImportDeclQualifiedStyle
importDeclQualifiedStyle mPre mPost =
if isJust mPre then QualifiedPre
else if isJust mPost then QualifiedPost else NotQualified
-- | Convenience function to answer the question if an import decl. is
-- qualified.
isImportDeclQualified :: ImportDeclQualifiedStyle -> Bool
isImportDeclQualified NotQualified = False
isImportDeclQualified _ = True
-- | Import Declaration
--
-- A single Haskell @import@ declaration.
......@@ -60,7 +84,7 @@ data ImportDecl pass
ideclPkgQual :: Maybe StringLiteral, -- ^ Package qualifier.
ideclSource :: Bool, -- ^ True <=> {-\# SOURCE \#-} import
ideclSafe :: Bool, -- ^ True => safe import
ideclQualified :: Bool, -- ^ True => qualified
ideclQualified :: ImportDeclQualifiedStyle, -- ^ If/how the import is qualified.
ideclImplicit :: Bool, -- ^ True => implicit import (of Prelude)
ideclAs :: Maybe (Located ModuleName), -- ^ as Module
ideclHiding :: Maybe (Bool, Located [LIE pass])
......@@ -96,7 +120,7 @@ simpleImportDecl mn = ImportDecl {
ideclSource = False,
ideclSafe = False,
ideclImplicit = False,
ideclQualified = False,
ideclQualified = NotQualified,
ideclAs = Nothing,
ideclHiding = Nothing
}
......@@ -109,7 +133,7 @@ instance (p ~ GhcPass pass,OutputableBndrId p)
, ideclQualified = qual, ideclImplicit = implicit
, ideclAs = as, ideclHiding = spec })
= hang (hsep [text "import", ppr_imp from, pp_implicit implicit, pp_safe safe,
pp_qual qual, pp_pkg pkg, ppr mod', pp_as as])
pp_qual qual False, pp_pkg pkg, ppr mod', pp_qual qual True, pp_as as])
4 (pp_spec spec)
where
pp_implicit False = empty
......@@ -119,8 +143,11 @@ instance (p ~ GhcPass pass,OutputableBndrId p)
pp_pkg (Just (StringLiteral st p))
= pprWithSourceText st (doubleQuotes (ftext p))
pp_qual False = empty
pp_qual True = text "qualified"
pp_qual QualifiedPre False = text "qualified" -- Prepositive qualifier/prepositive position.
pp_qual QualifiedPost True = text "qualified" -- Postpositive qualifier/postpositive position.
pp_qual QualifiedPre True = empty -- Prepositive qualifier/postpositive position.
pp_qual QualifiedPost False = empty -- Postpositive qualifier/prepositive position.
pp_qual NotQualified _ = empty
pp_safe False = empty
pp_safe True = text "safe"
......
......@@ -843,6 +843,7 @@ data WarningFlag =
| Opt_WarnImplicitKindVars -- Since 8.6
| Opt_WarnSpaceAfterBang
| Opt_WarnMissingDerivingStrategies -- Since 8.8
| Opt_WarnPrepositiveQualifiedModule -- Since TBD
deriving (Eq, Show, Enum)
data Language = Haskell98 | Haskell2010
......@@ -4070,7 +4071,10 @@ wWarningFlagsDeps = [
flagSpec "star-binder" Opt_WarnStarBinder,
flagSpec "star-is-type" Opt_WarnStarIsType,
flagSpec "missing-space-after-bang" Opt_WarnSpaceAfterBang,
flagSpec "partial-fields" Opt_WarnPartialFields ]
flagSpec "partial-fields" Opt_WarnPartialFields,
flagSpec "prepositive-qualified-module"
Opt_WarnPrepositiveQualifiedModule
]
-- | These @-\<blah\>@ flags can all be reversed with @-no-\<blah\>@
negatableFlagsDeps :: [(Deprecation, FlagSpec GeneralFlag)]
......@@ -4396,6 +4400,7 @@ xFlagsDeps = [
setGenDeriving,
flagSpec "ImplicitParams" LangExt.ImplicitParams,
flagSpec "ImplicitPrelude" LangExt.ImplicitPrelude,
flagSpec "ImportQualifiedPost" LangExt.ImportQualifiedPost,
flagSpec "ImpredicativeTypes" LangExt.ImpredicativeTypes,
flagSpec' "IncoherentInstances" LangExt.IncoherentInstances
setIncoherentInsts,
......
......@@ -131,7 +131,7 @@ mkPrelImports this_mod loc implicit_prelude import_decls
ideclPkgQual = Nothing,
ideclSource = False,
ideclSafe = False, -- Not a safe import
ideclQualified = False,
ideclQualified = NotQualified,
ideclImplicit = True, -- Implicit!
ideclAs = Nothing,
ideclHiding = Nothing }
......
......@@ -126,9 +126,10 @@ ppSourceStats short (dL->L _ (HsModule _ exports imports ldecls _ _))
import_info _ = panic " import_info: Impossible Match"
-- due to #15884
safe_info = qual_info
qual_info False = 0
qual_info True = 1
safe_info False = 0
safe_info True = 1
qual_info NotQualified = 0
qual_info _ = 1
as_info Nothing = 0
as_info (Just _) = 1
spec_info Nothing = (0,0,0,0,1,0,0)
......
......@@ -2329,6 +2329,7 @@ data ExtBits
| DoAndIfThenElseBit
| MultiWayIfBit
| GadtSyntaxBit
| ImportQualifiedPostBit
-- Flags that are updated once parsing starts
| InRulePragBit
......@@ -2415,6 +2416,7 @@ mkParserFlags' warningFlags extensionFlags thisPackage
.|. DoAndIfThenElseBit `xoptBit` LangExt.DoAndIfThenElse
.|. MultiWayIfBit `xoptBit` LangExt.MultiWayIf
.|. GadtSyntaxBit `xoptBit` LangExt.GADTSyntax
.|. ImportQualifiedPostBit `xoptBit` LangExt.ImportQualifiedPost
optBits =
HaddockBit `setBitIf` isHaddock
.|. RawTokenStreamBit `setBitIf` rawTokStream
......
......@@ -39,6 +39,7 @@ module Parser (parseModule, parseSignature, parseImport, parseStatement, parseBa
import Control.Monad ( unless, liftM, when, (<=<) )
import GHC.Exts
import Data.Char
import Data.Maybe ( maybeToList )
import Control.Monad ( mplus )
import Control.Applicative ((<$))
......@@ -955,17 +956,22 @@ importdecls_semi
| {- empty -} { [] }
importdecl :: { LImportDecl GhcPs }
: 'import' maybe_src maybe_safe optqualified maybe_pkg modid maybeas maybeimpspec
{% ams (cL (comb4 $1 $6 (snd $7) $8) $
ImportDecl { ideclExt = noExt
, ideclSourceSrc = snd $ fst $2
, ideclName = $6, ideclPkgQual = snd $5
, ideclSource = snd $2, ideclSafe = snd $3
, ideclQualified = snd $4, ideclImplicit = False
, ideclAs = unLoc (snd $7)
, ideclHiding = unLoc $8 })
((mj AnnImport $1 : (fst $ fst $2) ++ fst $3 ++ fst $4
++ fst $5 ++ fst $7)) }
: 'import' maybe_src maybe_safe optqualified maybe_pkg modid optqualified maybeas maybeimpspec
{% do {
; checkImportDecl $4 $7
; ams (cL (comb4 $1 $6 (snd $8) $9) $
ImportDecl { ideclExt = noExt
, ideclSourceSrc = snd $ fst $2
, ideclName = $6, ideclPkgQual = snd $5
, ideclSource = snd $2, ideclSafe = snd $3
, ideclQualified = importDeclQualifiedStyle $4 $7
, ideclImplicit = False
, ideclAs = unLoc (snd $8)
, ideclHiding = unLoc $9 })
((mj AnnImport $1 : fst (fst $2) ++ fst $3 ++ fmap (mj AnnQualified) (maybeToList $4)
++ fst $5 ++ fmap (mj AnnQualified) (maybeToList $7) ++ fst $8))
}
}
maybe_src :: { (([AddAnn],SourceText),IsBootInterface) }
: '{-# SOURCE' '#-}' { (([mo $1,mc $2],getSOURCE_PRAGs $1)
......@@ -986,9 +992,9 @@ maybe_pkg :: { ([AddAnn],Maybe StringLiteral) }
; return ([mj AnnPackageName $1], Just (StringLiteral (getSTRINGs $1) pkgFS)) } }
| {- empty -} { ([],Nothing) }
optqualified :: { ([AddAnn],Bool) }
: 'qualified' { ([mj AnnQualified $1],True) }
| {- empty -} { ([],False) }
optqualified :: { Maybe (Located Token) }
: 'qualified' { Just $1 }
| {- empty -} { Nothing }
maybeas :: { ([AddAnn],Located (Maybe (Located ModuleName))) }
: 'as' modid { ([mj AnnAs $1]
......
......@@ -49,6 +49,7 @@ module RdrHsSyn (
-- Bunch of functions in the parser monad for
-- checking and constructing values
checkImportDecl,
checkExpBlockArguments,
checkPrecP, -- Int -> P Int
checkContext, -- HsType -> P HsContext
......@@ -81,7 +82,10 @@ module RdrHsSyn (
-- Warnings and errors
warnStarIsType,
warnPrepositiveQualifiedModule,
failOpFewArgs,
failOpNotEnabledImportQualifiedPost,
failOpImportQualifiedTwice,
SumOrTuple (..),
......@@ -1051,6 +1055,31 @@ checkNoDocs msg ty = go ty
, text "on", msg, quotes (ppr t) ]
go _ = pure ()
checkImportDecl :: Maybe (Located Token)
-> Maybe (Located Token)
-> P ()
checkImportDecl mPre mPost = do
let whenJust mg f = maybe (pure ()) f mg
importQualifiedPostEnabled <- getBit ImportQualifiedPostBit
-- Error if 'qualified' found in postpostive position and
-- 'ImportQualifiedPost' is not in effect.
whenJust mPost $ \post ->
when (not importQualifiedPostEnabled) $
failOpNotEnabledImportQualifiedPost (getLoc post)
-- Error if 'qualified' occurs in both pre and postpositive
-- positions.
whenJust mPost $ \post ->
when (isJust mPre) $
failOpImportQualifiedTwice (getLoc post)
-- Warn if 'qualified' found in prepositive position and
-- 'Opt_WarnPrepositiveQualifiedModule' is enabled.
whenJust mPre $ \pre ->
warnPrepositiveQualifiedModule (getLoc pre)
-- -------------------------------------------------------------------------
-- Checking Patterns.
......@@ -2945,6 +2974,27 @@ isImpExpQcWildcard _ = False
-----------------------------------------------------------------------------
-- Warnings and failures
warnPrepositiveQualifiedModule :: SrcSpan -> P ()
warnPrepositiveQualifiedModule span =
addWarning Opt_WarnPrepositiveQualifiedModule span msg
where
msg = text "Found" <+> quotes (text "qualified")
<+> text "in prepositive position"
$$ text "Suggested fix: place " <+> quotes (text "qualified")
<+> text "after the module name instead."
failOpNotEnabledImportQualifiedPost :: SrcSpan -> P ()
failOpNotEnabledImportQualifiedPost loc = addError loc msg
where
msg = text "Found" <+> quotes (text "qualified")
<+> text "in postpositive position. "
$$ text "To allow this, enable language extension 'ImportQualifiedPost'"
failOpImportQualifiedTwice :: SrcSpan -> P ()
failOpImportQualifiedTwice loc = addError loc msg
where
msg = text "Multiple occurences of 'qualified'"
warnStarIsType :: SrcSpan -> P ()
warnStarIsType span = addWarning Opt_WarnStarIsType span msg
where
......
......@@ -267,7 +267,7 @@ rnImportDecl this_mod
, ideclName = loc_imp_mod_name
, ideclPkgQual = mb_pkg
, ideclSource = want_boot, ideclSafe = mod_safe
, ideclQualified = qual_only, ideclImplicit = implicit
, ideclQualified = qual_style, ideclImplicit = implicit
, ideclAs = as_mod, ideclHiding = imp_details }))
= setSrcSpan loc $ do
......@@ -275,6 +275,8 @@ rnImportDecl this_mod
pkg_imports <- xoptM LangExt.PackageImports
when (not pkg_imports) $ addErr packageImportErr
let qual_only = isImportDeclQualified qual_style
-- If there's an error in loadInterface, (e.g. interface
-- file not found) we get lots of spurious errors from 'filterImports'
let imp_mod_name = unLoc loc_imp_mod_name
......@@ -1470,8 +1472,8 @@ warnUnusedImport flag fld_env (L loc decl, used, unused)
, text "from module" <+> quotes pp_mod <+> is_redundant]
pp_herald = text "The" <+> pp_qual <+> text "import of"
pp_qual
| ideclQualified decl = text "qualified"
| otherwise = Outputable.empty
| isImportDeclQualified (ideclQualified decl)= text "qualified"
| otherwise = Outputable.empty
pp_mod = ppr (unLoc (ideclName decl))
is_redundant = text "is redundant"
......
......@@ -1567,7 +1567,7 @@ tcPreludeClashWarn warnFlag name = do
-- Unqualified import?
isUnqualified :: ImportDecl GhcRn -> Bool
isUnqualified = not . ideclQualified
isUnqualified = not . isImportDeclQualified . ideclQualified
-- List of explicitly imported (or hidden) Names from a single import.
-- Nothing -> No explicit imports
......
......@@ -2109,6 +2109,38 @@ data constructor in an import or export list with the keyword
``pattern``, to allow the import or export of a data constructor without
its parent type constructor (see :ref:`patsyn-impexp`).
 
.. _importqualifiedpost:
Writing qualified in postpositive position
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
.. extension:: ImportQualifiedPost
:shortdesc: ``ImportQualifiedPost`` allows the syntax ``import M qualified``
:since: 8.10.1
``ImportQualifiedPost`` allows the syntax ``import M qualified``, that is, to annotate a module as qualified by writing ``qualified`` after the module name.
To import a qualified module usually you must specify ``qualified`` in prepositive position : ``import qualified M``. This often leads to a "hanging indent" (which is automatically inserted by some autoformatters and common in many code bases. For example:
.. code-block:: none
import qualified A
import B
import C
The ``ImportQualifiedPost`` extension allows ``qualified`` to appear in postpositive position : ``import M qualified``. With this extension enabled, one can write:
.. code-block:: none
import A qualified
import B
import C
It is an error if ``qualified`` appears in both pre and postpositive positions.
The warning ``-Wprepositive-qualified-syntax`` (off by default) reports on any occurrences of imports annotated ``qualified`` using prepositive syntax.
.. _block-arguments:
 
More liberal syntax for function arguments
......
......@@ -2649,7 +2649,7 @@ iiSubsumes (IIModule m1) (IIModule m2) = m1==m2
iiSubsumes (IIDecl d1) (IIDecl d2) -- A bit crude
= unLoc (ideclName d1) == unLoc (ideclName d2)
&& ideclAs d1 == ideclAs d2
&& (not (ideclQualified d1) || ideclQualified d2)
&& (not (isImportDeclQualified (ideclQualified d1)) || isImportDeclQualified (ideclQualified d2))
&& (ideclHiding d1 `hidingSubsumes` ideclHiding d2)
where
_ `hidingSubsumes` Just (False,L _ []) = True
......
......@@ -139,4 +139,5 @@ data Extension
| NumericUnderscores
| QuantifiedConstraints
| StarIsType
| ImportQualifiedPost
deriving (Eq, Enum, Show, Generic, Bounded)
......@@ -40,7 +40,8 @@ expectedGhcOnlyExtensions = ["RelaxedLayout",
"AlternativeLayoutRule",
"AlternativeLayoutRuleTransitional",
"EmptyDataDeriving",
"GeneralisedNewtypeDeriving"]
"GeneralisedNewtypeDeriving",
"ImportQualifiedPost"]
expectedCabalOnlyExtensions :: [String]
expectedCabalOnlyExtensions = ["Generics",
......
......@@ -263,6 +263,12 @@ test('mod179', [extra_files(['Mod179_A.hs'])], multimod_compile, ['mod179', '-v0
test('mod180', [extra_files(['Mod180_A.hs', 'Mod180_B.hs'])], multimod_compile_fail, ['mod180', '-v0'])
# Tests for 'ImportQualifiedPost'
test('mod181', normal, compile, [''])
test('mod182', normal, compile_fail, [''])
test('mod183', normal, compile_fail, [''])
test('mod184', normal, compile, ['-Wprepositive-qualified-module'])
test('T1148', normal, compile, [''])
test('T1074', normal, compile, [''])
test('T1074a', normal, compile, [''])
......
{-# LANGUAGE ImportQualifiedPost #-}
-- If 'ImportQualifiedPost' is enabled 'qualified' can appear in
-- postpositive position.
import Prelude qualified
main = Prelude.undefined
-- If 'ImportQualifiedPost' is not enabled 'qualified' can not appear in
-- postpositive position.
import Prelude qualified
main = Prelude.undefined
mod182.hs:5:16: error:
Found ‘qualified’ in postpositive position.
To allow this, enable language extension 'ImportQualifiedPost'
{-# LANGUAGE ImportQualifiedPost #-}
-- 'qualified' can not appear in both pre and postpositive positions.
import qualified Prelude qualified
main = Prelude.undefined
mod183.hs:5:26: Multiple occurences of 'qualified'
{-# LANGUAGE ImportQualifiedPost #-}
-- With '-Wprepositive-qualified-module', a prepositive qualified
-- import should warn.
import qualified Prelude
main = Prelude.undefined
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment