Support for -XExplicitNamespaces and -XPatternSynonyms

Properly round-trip export items of the forms "type OPERATOR"
or "pattern SYNONYM"

fixes #158
pull/160/head
Lennart Spitzner 2018-07-04 21:21:22 +02:00
parent 0b40dd7c32
commit ab389fe66f
2 changed files with 43 additions and 24 deletions

View File

@ -66,3 +66,17 @@ foo = do
b <- g a
return (a, b)
###############################################################################
## ExplicitNamespaces + PatternSynonyms
#test explicitnamespaces_patternsynonyms export
{-# LANGUAGE ExplicitNamespaces #-}
{-# LANGUAGE PatternSynonyms #-}
module Test (type (++), (++), pattern Foo) where
#test explicitnamespaces_patternsynonyms import
{-# LANGUAGE ExplicitNamespaces #-}
{-# LANGUAGE PatternSynonyms #-}
import Test ( type (++)
, (++)
, pattern Foo
)

View File

@ -39,46 +39,51 @@ prepareName = id
layoutIE :: ToBriDoc IE
layoutIE lie@(L _ ie) = docWrapNode lie $ case ie of
IEVar _ -> ien
IEThingAbs _ -> ien
IEThingAll _ -> docSeq [ien, docLit $ Text.pack "(..)"]
IEThingWith _ (IEWildcard _) _ _ -> docSeq [ien, docLit $ Text.pack "(..)"]
IEVar x -> layoutWrapped x
IEThingAbs x -> layoutWrapped x
IEThingAll _ -> docSeq [ienDoc, docLit $ Text.pack "(..)"]
IEThingWith _ (IEWildcard _) _ _ ->
docSeq [ienDoc, docLit $ Text.pack "(..)"]
IEThingWith _ _ ns _ -> do
hasComments <- hasAnyCommentsBelow lie
runFilteredAlternative $ do
addAlternativeCond (not hasComments)
$ docSeq
$ [ien, docLit $ Text.pack "("]
$ [ienDoc, docLit $ Text.pack "("]
++ intersperse docCommaSep (map nameDoc ns)
++ [docParenR]
addAlternative
$ docAddBaseY BrIndentRegular
$ docPar ien (layoutItems (splitFirstLast ns))
addAlternative $ docAddBaseY BrIndentRegular $ docPar
ienDoc
(layoutItems (splitFirstLast ns))
where
nameDoc = (docLit =<<) . lrdrNameToTextAnn . prepareName
layoutItem n = docSeq [docCommaSep, docWrapNode n $ nameDoc n]
layoutItems FirstLastEmpty =
docSetBaseY $
docLines [docSeq [docParenLSep, docWrapNodeRest lie docEmpty]
,docParenR
]
layoutItems (FirstLastSingleton n) =
docSetBaseY $ docLines
[docSeq [docParenLSep, docWrapNodeRest lie $ nameDoc n], docParenR]
layoutItems (FirstLast n1 nMs nN) =
docSetBaseY $ docLines $
[docSeq [docParenLSep, docWrapNode n1 $ nameDoc n1]]
++ map layoutItem nMs
++ [ docSeq [docCommaSep, docWrapNodeRest lie $ nameDoc nN]
, docParenR
]
layoutItems FirstLastEmpty = docSetBaseY $ docLines
[docSeq [docParenLSep, docWrapNodeRest lie docEmpty], docParenR]
layoutItems (FirstLastSingleton n) = docSetBaseY $ docLines
[docSeq [docParenLSep, docWrapNodeRest lie $ nameDoc n], docParenR]
layoutItems (FirstLast n1 nMs nN) =
docSetBaseY
$ docLines
$ [docSeq [docParenLSep, docWrapNode n1 $ nameDoc n1]]
++ map layoutItem nMs
++ [docSeq [docCommaSep, docWrapNodeRest lie $ nameDoc nN], docParenR]
IEModuleContents n -> docSeq
[ docLit $ Text.pack "module"
, docSeparator
, docLit . Text.pack . moduleNameString $ unLoc n
]
_ -> docEmpty
where ien = docLit =<< lrdrNameToTextAnn (ieName <$> lie)
where
ienDoc = docLit =<< lrdrNameToTextAnn (ieName <$> lie)
layoutWrapped = \case
L _ (IEName n) -> docLit =<< lrdrNameToTextAnn n
L _ (IEPattern n) -> do
name <- lrdrNameToTextAnn n
docLit $ Text.pack "pattern " <> name
L _ (IEType n) -> do
name <- lrdrNameToTextAnn n
docLit $ Text.pack "type " <> name
-- Helper function to deal with Located lists of LIEs.
-- In particular this will also associate documentation