hexagoxel
/
brittany
1
0
Fork 0
Code Issues 117 Pull Requests 5 Packages Projects Releases 5 Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
src-literatetests/14-extensions.blt
View File

@ -66,3 +66,17 @@ foo = do
b <- g a b <- g a
return (a, b) 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
)

47
src/Language/Haskell/Brittany/Internal/Layouters/IE.hs
View File

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