From 934ec9bf06fc87b14cd80b5b7c6610ba5cba0c64 Mon Sep 17 00:00:00 2001 From: ncaq Date: Sat, 12 Apr 2025 20:22:33 +0900 Subject: [PATCH] feat: add support for `ImportQualifiedPost` extension I add support for the `ImportQualifiedPost` extension to fix parse errors that occur when processing code that uses this GHC extension. The extension enables writing import statements with `qualified` keyword after the module name (e.g., `import Data.List qualified as L` instead of the traditional `import qualified Data.List as L`). Motivation === When tools like the [sandwich](https://github.com/codedownio/sandwich/) test framework process Haskell code that uses the `ImportQualifiedPost` extension, haskell-src-exts was unable to parse these imports correctly, resulting in errors. This implementation allows code using this extension to be properly parsed and processed by tools that depend on haskell-src-exts. Changes === - Added `ImportQualifiedPost` to the list of known extensions in `Extension.hs` - Updated the parser grammar to support post-qualified imports by adding a new `optqualified_post` rule - Modified the `ExactPrint` module to correctly handle post-qualified imports by determining the position of the `qualified` keyword based on source locations - Added test cases with golden files to verify correct parsing and exact printing Known Issue === The pretty printer still converts post-qualified imports back to pre-qualified form (e.g., `import qualified Data.List as L`) because the `ImportDecl` data structure only stores whether an import is qualified or not, but not whether the qualification is pre or post. This is a limitation of the current API design. Future improvements could involve modifying the `ImportDecl` data structure to explicitly track qualification style, but this would require API changes and is out of scope for this implementation. --- src/Language/Haskell/Exts/ExactPrint.hs | 45 ++++++++-- src/Language/Haskell/Exts/Extension.hs | 2 + src/Language/Haskell/Exts/InternalParser.ly | 13 ++- tests/examples/ImportQualifiedPost.hs | 4 + ...ImportQualifiedPost.hs.exactprinter.golden | 1 + .../ImportQualifiedPost.hs.parser.golden | 89 +++++++++++++++++++ ...ImportQualifiedPost.hs.prettyparser.golden | 1 + ...mportQualifiedPost.hs.prettyprinter.golden | 3 + 8 files changed, 146 insertions(+), 12 deletions(-) create mode 100644 tests/examples/ImportQualifiedPost.hs create mode 100644 tests/examples/ImportQualifiedPost.hs.exactprinter.golden create mode 100644 tests/examples/ImportQualifiedPost.hs.parser.golden create mode 100644 tests/examples/ImportQualifiedPost.hs.prettyparser.golden create mode 100644 tests/examples/ImportQualifiedPost.hs.prettyprinter.golden diff --git a/src/Language/Haskell/Exts/ExactPrint.hs b/src/Language/Haskell/Exts/ExactPrint.hs index bf3b1e70..0dcbee61 100644 --- a/src/Language/Haskell/Exts/ExactPrint.hs +++ b/src/Language/Haskell/Exts/ExactPrint.hs @@ -414,13 +414,18 @@ instance ExactP ImportDecl where return pts' _ -> errorEP "ExactP: ImportDecl is given too few srcInfoPoints" else return pts1 - pts3 <- if qf then - case pts2 of - x:pts' -> do + + -- Try to determine if qualified is post-positioned only if we have enough points + let isPostQual = (qf && not (null pts2)) && safeIsPostQualified pts2 + + pts3 <- if qf && not isPostQual then + case pts2 of + x:pts' -> do printStringAt (pos x) "qualified" return pts' - _ -> errorEP "ExactP: ImportDecl is given too few srcInfoPoints" + _ -> errorEP "ExactP: ImportDecl is given too few srcInfoPoints" else return pts2 + pts4 <- case mpkg of Just pkg -> case pts3 of @@ -429,20 +434,44 @@ instance ExactP ImportDecl where return pts' _ -> errorEP "ExactP: ImportDecl is given too few srcInfoPoints" _ -> return pts3 + exactPC mn - _ <- case mas of - Just as -> + + -- Only try post-qualified if we determined it's actually post-qualified + pts5 <- if qf && isPostQual then case pts4 of x:pts' -> do + printStringAt (pos x) "qualified" + return pts' + _ -> errorEP "ExactP: ImportDecl is given too few srcInfoPoints" + else return pts4 + + _ <- case mas of + Just as -> + case pts5 of + x:pts' -> do printStringAt (pos x) "as" exactPC as return pts' - _ -> errorEP "ExactP: ImportDecl is given too few srcInfoPoints" - _ -> return pts4 + _ -> errorEP "ExactP: ImportDecl is given too few srcInfoPoints" + _ -> return pts5 + case mispecs of Nothing -> return () Just ispecs -> exactPC ispecs _ -> errorEP "ExactP: ImportDecl is given too few srcInfoPoints" + where safeIsPostQualified pts = + case pts of + (p:_) -> + let modSpan = srcInfoSpan (ann mn) + -- Only consider it post-qualified if we have valid spans to compare + in ((isValidSpan modSpan && isValidSpan p) && + (srcSpanEnd modSpan <= srcSpanStart p)) + _ -> False + where + isValidSpan s = + srcSpanStartLine s > 0 && srcSpanEndLine s > 0 && + srcSpanStartColumn s >= 0 && srcSpanEndColumn s >= 0 instance ExactP Module where exactP mdl = case mdl of diff --git a/src/Language/Haskell/Exts/Extension.hs b/src/Language/Haskell/Exts/Extension.hs index 70c56922..dbb47ae1 100644 --- a/src/Language/Haskell/Exts/Extension.hs +++ b/src/Language/Haskell/Exts/Extension.hs @@ -375,6 +375,8 @@ data KnownExtension = -- > import "network" Network.Socket | PackageImports + | ImportQualifiedPost + | LambdaCase -- | [GHC § 7.3.20] Allow case expressions with no alternatives. diff --git a/src/Language/Haskell/Exts/InternalParser.ly b/src/Language/Haskell/Exts/InternalParser.ly index 523b8ef9..58256edd 100644 --- a/src/Language/Haskell/Exts/InternalParser.ly +++ b/src/Language/Haskell/Exts/InternalParser.ly @@ -465,10 +465,10 @@ Import Declarations > | impdecl { ([$1],[]) } > impdecl :: { ImportDecl L } -> : 'import' optsrc optsafe optqualified maybepkg modid maybeas maybeimpspec -> { let { (mmn,ss,ml) = $7 ; -> l = nIS $1 <++> ann $6 <+?> ml <+?> (fmap ann) $8 <** ($1:snd $2 ++ snd $3 ++ snd $4 ++ snd $5 ++ ss)} -> in ImportDecl l $6 (fst $4) (fst $2) (fst $3) (fst $5) mmn $8 } +> : 'import' optsrc optsafe optqualified maybepkg modid optqualified_post maybeas maybeimpspec +> { let { (mmn,ss,ml) = $8 ; +> l = nIS $1 <++> ann $6 <+?> ml <+?> (fmap ann) $9 <** ($1:snd $2 ++ snd $3 ++ snd $4 ++ snd $5 ++ snd $7 ++ ss)} +> in ImportDecl l $6 (fst $4 || fst $7) (fst $2) (fst $3) (fst $5) mmn $9 } > optsrc :: { (Bool,[S]) } > : '{-# SOURCE' '#-}' { (True,[$1,$2]) } @@ -483,6 +483,11 @@ Import Declarations > : 'qualified' { (True,[$1]) } > | {- empty -} { (False, []) } +> optqualified_post :: { (Bool,[S]) } +> : 'qualified' {% do { checkEnabled ImportQualifiedPost; +> return (True,[$1]) } } +> | {- empty -} { (False, []) } + Requires the PackageImports extension enabled. > maybepkg :: { (Maybe String,[S]) } > : STRING {% do { checkEnabled PackageImports ; diff --git a/tests/examples/ImportQualifiedPost.hs b/tests/examples/ImportQualifiedPost.hs new file mode 100644 index 00000000..c7d825e7 --- /dev/null +++ b/tests/examples/ImportQualifiedPost.hs @@ -0,0 +1,4 @@ +{-# LANGUAGE ImportQualifiedPost #-} +module ImportQualifiedPost where + +import Data.List qualified as L diff --git a/tests/examples/ImportQualifiedPost.hs.exactprinter.golden b/tests/examples/ImportQualifiedPost.hs.exactprinter.golden new file mode 100644 index 00000000..1796dc27 --- /dev/null +++ b/tests/examples/ImportQualifiedPost.hs.exactprinter.golden @@ -0,0 +1 @@ +Match diff --git a/tests/examples/ImportQualifiedPost.hs.parser.golden b/tests/examples/ImportQualifiedPost.hs.parser.golden new file mode 100644 index 00000000..07000b81 --- /dev/null +++ b/tests/examples/ImportQualifiedPost.hs.parser.golden @@ -0,0 +1,89 @@ +ParseOk + ( Module + SrcSpanInfo + { srcInfoSpan = + SrcSpan "tests/examples/ImportQualifiedPost.hs" 1 1 5 1 + , srcInfoPoints = + [ SrcSpan "tests/examples/ImportQualifiedPost.hs" 1 1 1 1 + , SrcSpan "tests/examples/ImportQualifiedPost.hs" 2 1 2 1 + , SrcSpan "tests/examples/ImportQualifiedPost.hs" 2 1 2 1 + , SrcSpan "tests/examples/ImportQualifiedPost.hs" 4 1 4 1 + , SrcSpan "tests/examples/ImportQualifiedPost.hs" 5 1 5 1 + , SrcSpan "tests/examples/ImportQualifiedPost.hs" 5 1 5 1 + ] + } + (Just + (ModuleHead + SrcSpanInfo + { srcInfoSpan = + SrcSpan "tests/examples/ImportQualifiedPost.hs" 2 1 2 33 + , srcInfoPoints = + [ SrcSpan "tests/examples/ImportQualifiedPost.hs" 2 1 2 7 + , SrcSpan "tests/examples/ImportQualifiedPost.hs" 2 28 2 33 + ] + } + (ModuleName + SrcSpanInfo + { srcInfoSpan = + SrcSpan "tests/examples/ImportQualifiedPost.hs" 2 8 2 27 + , srcInfoPoints = [] + } + "ImportQualifiedPost") + Nothing + Nothing)) + [ LanguagePragma + SrcSpanInfo + { srcInfoSpan = + SrcSpan "tests/examples/ImportQualifiedPost.hs" 1 1 1 37 + , srcInfoPoints = + [ SrcSpan "tests/examples/ImportQualifiedPost.hs" 1 1 1 13 + , SrcSpan "tests/examples/ImportQualifiedPost.hs" 1 34 1 37 + ] + } + [ Ident + SrcSpanInfo + { srcInfoSpan = + SrcSpan "tests/examples/ImportQualifiedPost.hs" 1 14 1 33 + , srcInfoPoints = [] + } + "ImportQualifiedPost" + ] + ] + [ ImportDecl + { importAnn = + SrcSpanInfo + { srcInfoSpan = + SrcSpan "tests/examples/ImportQualifiedPost.hs" 4 1 4 32 + , srcInfoPoints = + [ SrcSpan "tests/examples/ImportQualifiedPost.hs" 4 1 4 7 + , SrcSpan "tests/examples/ImportQualifiedPost.hs" 4 18 4 27 + , SrcSpan "tests/examples/ImportQualifiedPost.hs" 4 28 4 30 + ] + } + , importModule = + ModuleName + SrcSpanInfo + { srcInfoSpan = + SrcSpan "tests/examples/ImportQualifiedPost.hs" 4 8 4 17 + , srcInfoPoints = [] + } + "Data.List" + , importQualified = True + , importSrc = False + , importSafe = False + , importPkg = Nothing + , importAs = + Just + (ModuleName + SrcSpanInfo + { srcInfoSpan = + SrcSpan "tests/examples/ImportQualifiedPost.hs" 4 31 4 32 + , srcInfoPoints = [] + } + "L") + , importSpecs = Nothing + } + ] + [] + , [] + ) diff --git a/tests/examples/ImportQualifiedPost.hs.prettyparser.golden b/tests/examples/ImportQualifiedPost.hs.prettyparser.golden new file mode 100644 index 00000000..1796dc27 --- /dev/null +++ b/tests/examples/ImportQualifiedPost.hs.prettyparser.golden @@ -0,0 +1 @@ +Match diff --git a/tests/examples/ImportQualifiedPost.hs.prettyprinter.golden b/tests/examples/ImportQualifiedPost.hs.prettyprinter.golden new file mode 100644 index 00000000..4d03ab5b --- /dev/null +++ b/tests/examples/ImportQualifiedPost.hs.prettyprinter.golden @@ -0,0 +1,3 @@ +{-# LANGUAGE ImportQualifiedPost #-} +module ImportQualifiedPost where +import qualified Data.List as L