Skip to content

feat: add support for ImportQualifiedPost extension #477

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

Open
wants to merge 1 commit into
base: master
Choose a base branch
from
Open

feat: add support for ImportQualifiedPost extension #477

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
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
45 changes: 37 additions & 8 deletions src/Language/Haskell/Exts/ExactPrint.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down
2 changes: 2 additions & 0 deletions src/Language/Haskell/Exts/Extension.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -375,6 +375,8 @@ data KnownExtension =
-- > import "network" Network.Socket
| PackageImports

| ImportQualifiedPost

| LambdaCase

-- | [GHC &#xa7; 7.3.20] Allow case expressions with no alternatives.
Expand Down
13 changes: 9 additions & 4 deletions src/Language/Haskell/Exts/InternalParser.ly
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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]) }
Expand All @@ -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 ;
Expand Down
4 changes: 4 additions & 0 deletions tests/examples/ImportQualifiedPost.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,4 @@
{-# LANGUAGE ImportQualifiedPost #-}
module ImportQualifiedPost where

import Data.List qualified as L
1 change: 1 addition & 0 deletions tests/examples/ImportQualifiedPost.hs.exactprinter.golden
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
Match
89 changes: 89 additions & 0 deletions tests/examples/ImportQualifiedPost.hs.parser.golden
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -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
}
]
[]
, []
)
1 change: 1 addition & 0 deletions tests/examples/ImportQualifiedPost.hs.prettyparser.golden
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
Match
3 changes: 3 additions & 0 deletions tests/examples/ImportQualifiedPost.hs.prettyprinter.golden
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,3 @@
{-# LANGUAGE ImportQualifiedPost #-}
module ImportQualifiedPost where
import qualified Data.List as L