Skip to content

[POC] Support qualified module renamings #7303

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Draft
wants to merge 3 commits into
base: master
Choose a base branch
from
Draft

[POC] Support qualified module renamings #7303

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
895388c
Support qualified module renamings
ezyang Feb 24, 2021
23859e3
Fix the unit tests
ezyang Feb 25, 2021
2258fa5
one more test file fix
ezyang Feb 25, 2021
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
21 changes: 20 additions & 1 deletion Cabal-described/src/Distribution/Described.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -414,10 +414,28 @@ instance Described ForeignLibType where
describe _ = REUnion ["native-shared","native-static"]

instance Described IncludeRenaming where
describe _ = mr <> REOpt (RESpaces <> "requires" <> RESpaces1 <> mr)
-- Unfortunately, we can't directly use ModuleRenaming, as
-- there is some ambiguity in the grammar that we can't express
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Is this an expressivity problem of a framework, or is there an actual ambiguity in the grammar? I might sound like a SPJ, but can you write down the BNF-grammar then (assuming there is munching lexer, so without need to worry about spaces?)

Copy link
Collaborator

@phadej phadej Feb 25, 2021 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Note, these regexes are virtually only documentation of backpack field syntax (re: #4761).

And while mixin syntax definition in https://cabal.readthedocs.io/en/3.4/buildinfo-fields-reference.html is technically correct, it goes beyond what I'd consider "human understandable".

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Is this an expressivity problem of a framework, or is there an actual ambiguity in the grammar?

Ooh, I used a bad turn of phrase here. Ambiguity isn't the right word.

First, here is the EBNF you requested:

IncludeRenaming ::= ModuleRenaming { "requires" ModuleRenaming }
ModuleRenaming ::=
    (* empty *)
  | "(" Renaming ")"
  | "hiding" "(" ModuleList ")"
  | "qualified" ModuleName

RenamingList ::=
    Renaming
  | Renaming "," RenamingList

Renaming ::=
    ModuleName
  | ModuleName "as" ModuleName

ModuleList ::=
    ModuleName
  | ModuleName "," ModuleList

OK, now to explain the problem here. The problem I am having with Distribution.Described lies solely in whitespace handling, as I mentioned in #7303 (comment) The problem is that it is only valid to omit the space before requires (RESpaces) if you didn't select the "qualified" production in ModuleRenaming. If you assume that everything is tokenized beforehand, the problem disappears because M.Nrequires will properly tokenize as a single module name, while )requires will tokenize as two tokens.

Note, these regexes are virtually only documentation of backpack field syntax (re: #4761).

Yes, no excuse for this. I guess now is a good time to nail that issue :)

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

@phadej Backpack docs exist and landed!

-- compositionally with regular expressions
describe _ = REUnion
[ reEps
, "requires" <> RESpaces1 <> mr
, nonempty_mr <> REOpt (RESpaces1 <> "requires" <> RESpaces1 <> mr)
]
where
mr = describe (Proxy :: Proxy ModuleRenaming)

nonempty_mr = REUnion
[ "hiding" <> RESpaces <> bp (REMunch reSpacedComma mn)
, "qualified" <> RESpaces1 <> mn
, bp (REMunch reSpacedComma entry)
]
where
bp r = "(" <> RESpaces <> r <> RESpaces <> ")"
mn = RENamed "module-name" $ describe (Proxy :: Proxy ModuleName)

entry = mn <> REOpt (RESpaces1 <> "as" <> RESpaces1 <> mn)

instance Described Language where
describe _ = REUnion ["Haskell98", "Haskell2010"]

Expand Down Expand Up @@ -448,6 +466,7 @@ instance Described ModuleRenaming where
describe _ = REUnion
[ reEps
, "hiding" <> RESpaces <> bp (REMunch reSpacedComma mn)
, "qualified" <> RESpaces1 <> mn
, bp (REMunch reSpacedComma entry)
]
where
Expand Down
4 changes: 2 additions & 2 deletions Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -24,7 +24,7 @@ tests = testGroup "Distribution.Utils.Structured"
, testCase "SPDX.License" $ structureHash (Proxy :: Proxy License) @?= md5FromInteger 0xd3d4a09f517f9f75bc3d16370d5a853a
-- The difference is in encoding of newtypes
#if MIN_VERSION_base(4,7,0)
, testCase "GenericPackageDescription" $ structureHash (Proxy :: Proxy GenericPackageDescription) @?= md5FromInteger 0x1e02ad776ad91e10d644d1ead8927205
, testCase "LocalBuildInfo" $ structureHash (Proxy :: Proxy LocalBuildInfo) @?= md5FromInteger 0x06bf760ed08809b56b165f72d485b9c5
, testCase "GenericPackageDescription" $ structureHash (Proxy :: Proxy GenericPackageDescription) @?= md5FromInteger 0xf3a898a586312623fe123876e53f346c
, testCase "LocalBuildInfo" $ structureHash (Proxy :: Proxy LocalBuildInfo) @?= md5FromInteger 0xeff1b7556bd8b832eae5bd8d8a33019c
#endif
]
13 changes: 13 additions & 0 deletions Cabal/src/Distribution/Backpack/UnifyM.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -487,6 +487,13 @@ convertInclude ci@(ComponentInclude {
req_rename_list <-
case req_rns of
DefaultRenaming -> return []
QualifiedRenaming _ -> do
-- TODO: support this for requires (req_rename_list
-- is a bad representation for this, alas, need
-- a bigger refactor here)
addErr $ text "Unsupported syntax" <+>
quotes (text "requires qualified (...)")
return []
HidingRenaming _ -> do
-- Not valid here for requires!
addErr $ text "Unsupported syntax" <+>
Expand Down Expand Up @@ -561,6 +568,12 @@ convertInclude ci@(ComponentInclude {
(pre_prov_scope, prov_rns') <-
case prov_rns of
DefaultRenaming -> return (Map.toList provs, prov_rns)
QualifiedRenaming prefix ->
let prov_scope0 = [ (prefix `joinModuleName` k,v) | (k,v) <- Map.toList provs ]
prov_rns0 = [ (k, prefix `joinModuleName` k) | (k,_) <- Map.toList provs ]
-- GHC doesn't understand qualification, so return
-- the expanded version
in return (prov_scope0, ModuleRenaming prov_rns0)
HidingRenaming hides ->
let hides_set = Set.fromList hides
in let r = [ (k,v)
Expand Down
7 changes: 7 additions & 0 deletions Cabal/src/Distribution/ModuleName.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -18,6 +18,7 @@ module Distribution.ModuleName (
fromString,
fromComponents,
components,
joinModuleName,
toFilePath,
main,
-- * Internal
Expand All @@ -44,6 +45,12 @@ newtype ModuleName = ModuleName ShortText
unModuleName :: ModuleName -> String
unModuleName (ModuleName s) = fromShortText s

-- Guaranteed to be valid by invariants on the initial module
-- names (in particular, empty module name is not valid)
joinModuleName :: ModuleName -> ModuleName -> ModuleName
joinModuleName a b =
ModuleName (toShortText (unModuleName a ++ "." ++ unModuleName b))

instance Binary ModuleName
instance Structured ModuleName

Expand Down
16 changes: 15 additions & 1 deletion Cabal/src/Distribution/Types/ModuleRenaming.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -41,6 +41,11 @@ data ModuleRenaming
-- | Hiding renaming, e.g., @hiding (A, B)@, bringing all
-- exported modules into scope except the hidden ones.
| HidingRenaming [ModuleName]
-- | Qualified renaming, @(qualified P)@, brining all
-- exported modules into scope with P prefix. So if M
-- was provided by the package, it is now in scope as
-- P.M
| QualifiedRenaming ModuleName
deriving (Show, Read, Eq, Ord, Typeable, Data, Generic)

-- | Interpret a 'ModuleRenaming' as a partial map from 'ModuleName'
Expand All @@ -54,6 +59,8 @@ interpModuleRenaming (ModuleRenaming rns) =
interpModuleRenaming (HidingRenaming hs) =
let s = Set.fromList hs
in \k -> if k `Set.member` s then Nothing else Just k
interpModuleRenaming (QualifiedRenaming prefix) =
\k -> Just (prefix `joinModuleName` k)

-- | The default renaming, if something is specified in @build-depends@
-- only.
Expand All @@ -79,6 +86,8 @@ instance Pretty ModuleRenaming where
pretty DefaultRenaming = mempty
pretty (HidingRenaming hides)
= text "hiding" <+> parens (hsep (punctuate comma (map pretty hides)))
pretty (QualifiedRenaming prefix)
= text "qualified" <+> pretty prefix
pretty (ModuleRenaming rns)
= parens . hsep $ punctuate comma (map dispEntry rns)
where dispEntry (orig, new)
Expand Down Expand Up @@ -109,7 +118,7 @@ moduleRenamingParsec
-> m ModuleRenaming
moduleRenamingParsec bp mn =
-- NB: try not necessary as the first token is obvious
P.choice [ parseRename, parseHiding, return DefaultRenaming ]
P.choice [ parseRename, parseHiding, parseQualified, return DefaultRenaming ]
where
cma = P.char ',' >> P.spaces
parseRename = do
Expand All @@ -121,6 +130,11 @@ moduleRenamingParsec bp mn =
P.spaces -- space isn't strictly required as next is an open paren
hides <- bp (P.sepBy mn cma)
return (HidingRenaming hides)
parseQualified = do
_ <- P.string "qualified"
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This is wrong. It would allow qualifiedBlabla

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

some day I will remember that Cabal's parser doesn't actually have a lexer stage before hand 🤣

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Nor parsec has auto-try. (But Described generative tests should catch that)

P.skipSpaces1 -- no parenthesis after, space required
prefix <- mn
return (QualifiedRenaming prefix)
parseList =
P.sepBy parseEntry cma
parseEntry = do
Expand Down
2 changes: 2 additions & 0 deletions cabal-testsuite/PackageTests/Backpack/QualifiedIncludes/A.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
module A where
import Prefix.Quxbaz
19 changes: 19 additions & 0 deletions cabal-testsuite/PackageTests/Backpack/QualifiedIncludes/QualifiedIncludes.cabal
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,19 @@
name: QualifiedIncludes
version: 0.1.0.0
license: BSD3
author: Edward Z. Yang
maintainer: [email protected]
build-type: Simple
cabal-version: 2.0

library impl
build-depends: base
exposed-modules: Foobar, Quxbaz
hs-source-dirs: impl
default-language: Haskell2010

library good
build-depends: base, impl
mixins: impl qualified Prefix
exposed-modules: A
default-language: Haskell2010
1 change: 1 addition & 0 deletions cabal-testsuite/PackageTests/Backpack/QualifiedIncludes/impl/Foobar.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
module Foobar where
1 change: 1 addition & 0 deletions cabal-testsuite/PackageTests/Backpack/QualifiedIncludes/impl/Quxbaz.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
module Quxbaz where
7 changes: 7 additions & 0 deletions cabal-testsuite/PackageTests/Backpack/QualifiedIncludes/setup.cabal.out
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,7 @@
# Setup configure
Configuring QualifiedIncludes-0.1.0.0...
# Setup build
Preprocessing library 'impl' for QualifiedIncludes-0.1.0.0..
Building library 'impl' for QualifiedIncludes-0.1.0.0..
Preprocessing library 'good' for QualifiedIncludes-0.1.0.0..
Building library 'good' for QualifiedIncludes-0.1.0.0..
7 changes: 7 additions & 0 deletions cabal-testsuite/PackageTests/Backpack/QualifiedIncludes/setup.out
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,7 @@
# Setup configure
Configuring QualifiedIncludes-0.1.0.0...
# Setup build
Preprocessing library 'impl' for QualifiedIncludes-0.1.0.0..
Building library 'impl' for QualifiedIncludes-0.1.0.0..
Preprocessing library 'good' for QualifiedIncludes-0.1.0.0..
Building library 'good' for QualifiedIncludes-0.1.0.0..
6 changes: 6 additions & 0 deletions cabal-testsuite/PackageTests/Backpack/QualifiedIncludes/setup.test.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,6 @@
import Test.Cabal.Prelude
main = setupAndCabalTest $ do
skipUnlessGhcVersion ">= 8.1"
setup "configure" []
setup "build" []
return ()