Fix ghc version compat

imports-sorted
Lennart Spitzner 2020-04-07 15:18:27 +02:00
parent 0b4a027976
commit 5bf6d4a859
2 changed files with 48 additions and 4 deletions

View File

@ -168,11 +168,19 @@ layoutAnnAndSepLLIEs shouldSort llies@(L _ lies) = do
-- (because I don't know what a wildcard means if it is not already a -- (because I don't know what a wildcard means if it is not already a
-- IEThingAll). -- IEThingAll).
isProperIEThing :: LIE GhcPs -> Bool isProperIEThing :: LIE GhcPs -> Bool
#if MIN_VERSION_ghc(8,6,0) /* 8.6+ */
isProperIEThing = \case isProperIEThing = \case
L _ (IEThingAbs _ _wn) -> True L _ (IEThingAbs _ _wn) -> True
L _ (IEThingAll _ _wn) -> True L _ (IEThingAll _ _wn) -> True
L _ (IEThingWith _ _wn NoIEWildcard _ _) -> True L _ (IEThingWith _ _wn NoIEWildcard _ _) -> True
_ -> False _ -> False
#else /* 8.0 8.2 8.4 */
isProperIEThing = \case
L _ (IEThingAbs _wn) -> True
L _ (IEThingAll _wn) -> True
L _ (IEThingWith _wn NoIEWildcard _ _) -> True
_ -> False
#endif
isIEVar :: LIE GhcPs -> Bool isIEVar :: LIE GhcPs -> Bool
isIEVar = \case isIEVar = \case
L _ IEVar{} -> True L _ IEVar{} -> True
@ -183,6 +191,7 @@ layoutAnnAndSepLLIEs shouldSort llies@(L _ lies) = do
thingFolder _ l2@(L _ IEThingAll{}) = l2 thingFolder _ l2@(L _ IEThingAll{}) = l2
thingFolder l1 ( L _ IEThingAbs{}) = l1 thingFolder l1 ( L _ IEThingAbs{}) = l1
thingFolder (L _ IEThingAbs{}) l2 = l2 thingFolder (L _ IEThingAbs{}) l2 = l2
#if MIN_VERSION_ghc(8,6,0) /* 8.6+ */
thingFolder (L l (IEThingWith x wn _ consItems1 fieldLbls1)) (L _ (IEThingWith _ _ _ consItems2 fieldLbls2)) thingFolder (L l (IEThingWith x wn _ consItems1 fieldLbls1)) (L _ (IEThingWith _ _ _ consItems2 fieldLbls2))
= L = L
l l
@ -192,6 +201,16 @@ layoutAnnAndSepLLIEs shouldSort llies@(L _ lies) = do
(consItems1 ++ consItems2) (consItems1 ++ consItems2)
(fieldLbls1 ++ fieldLbls2) (fieldLbls1 ++ fieldLbls2)
) )
#else /* 8.0 8.2 8.4 */
thingFolder (L l (IEThingWith wn _ consItems1 fieldLbls1)) (L _ (IEThingWith _ _ consItems2 fieldLbls2))
= L
l
(IEThingWith wn
NoIEWildcard
(consItems1 ++ consItems2)
(fieldLbls1 ++ fieldLbls2)
)
#endif
thingFolder _ _ = thingFolder _ _ =
error "thingFolder should be exhaustive because we have a guard above" error "thingFolder should be exhaustive because we have a guard above"
@ -234,15 +253,21 @@ layoutLLIEs enableSingleline shouldSort llies = do
-- | Returns a "fingerprint string", not a full text representation, nor even -- | Returns a "fingerprint string", not a full text representation, nor even
-- a source code representation of this syntax node. -- a source code representation of this syntax node.
-- Used for sorting, not for printing the formatter's output source code. -- Used for sorting, not for printing the formatter's output source code.
#if MIN_VERSION_ghc(8,2,0)
wrappedNameToText :: LIEWrappedName RdrName -> Text wrappedNameToText :: LIEWrappedName RdrName -> Text
wrappedNameToText = \case wrappedNameToText = \case
L _ (IEName n) -> lrdrNameToText n L _ (IEName n) -> lrdrNameToText n
L _ (IEPattern n) -> lrdrNameToText n L _ (IEPattern n) -> lrdrNameToText n
L _ (IEType n) -> lrdrNameToText n L _ (IEType n) -> lrdrNameToText n
#else
wrappedNameToText :: Located RdrName -> Text
wrappedNameToText = lrdrNameToText
#endif
-- | Returns a "fingerprint string", not a full text representation, nor even -- | Returns a "fingerprint string", not a full text representation, nor even
-- a source code representation of this syntax node. -- a source code representation of this syntax node.
-- Used for sorting, not for printing the formatter's output source code. -- Used for sorting, not for printing the formatter's output source code.
lieToText :: LIE GhcPs -> Text lieToText :: LIE GhcPs -> Text
#if MIN_VERSION_ghc(8,6,0) /* 8.6+ */
lieToText = \case lieToText = \case
L _ (IEVar _ wn ) -> wrappedNameToText wn L _ (IEVar _ wn ) -> wrappedNameToText wn
L _ (IEThingAbs _ wn ) -> wrappedNameToText wn L _ (IEThingAbs _ wn ) -> wrappedNameToText wn
@ -256,6 +281,20 @@ lieToText = \case
L _ (IEDoc _ _ ) -> Text.pack "@IEDoc" L _ (IEDoc _ _ ) -> Text.pack "@IEDoc"
L _ (IEDocNamed _ _ ) -> Text.pack "@IEDocNamed" L _ (IEDocNamed _ _ ) -> Text.pack "@IEDocNamed"
L _ (XIE _ ) -> Text.pack "@XIE" L _ (XIE _ ) -> Text.pack "@XIE"
#else /* 8.0 8.2 8.4 */
lieToText = \case
L _ (IEVar wn ) -> wrappedNameToText wn
L _ (IEThingAbs wn ) -> wrappedNameToText wn
L _ (IEThingAll wn ) -> wrappedNameToText wn
L _ (IEThingWith wn _ _ _) -> wrappedNameToText wn
-- TODO: These _may_ appear in exports!
-- Need to check, and either put them at the top (for module) or do some
-- other clever thing.
L _ (IEModuleContents n ) -> moduleNameToText n
L _ (IEGroup _ _ ) -> Text.pack "@IEGroup"
L _ (IEDoc _ ) -> Text.pack "@IEDoc"
L _ (IEDocNamed _ ) -> Text.pack "@IEDocNamed"
#endif
where where
moduleNameToText :: Located ModuleName -> Text moduleNameToText :: Located ModuleName -> Text
moduleNameToText (L _ name) = Text.pack ("@IEModuleContents" ++ moduleNameString name) moduleNameToText (L _ name) = Text.pack ("@IEModuleContents" ++ moduleNameString name)

View File

@ -18,7 +18,12 @@ import FieldLabel
import qualified FastString import qualified FastString
import BasicTypes import BasicTypes
import Language.Haskell.GHC.ExactPrint as ExactPrint import Language.Haskell.GHC.ExactPrint as ExactPrint
import Language.Haskell.GHC.ExactPrint.Types as ExactPrint.Types import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint.Types
import Language.Haskell.GHC.ExactPrint.Types
( DeltaPos(..)
, deltaRow
, commentContents
)
import Language.Haskell.Brittany.Internal.Utils import Language.Haskell.Brittany.Internal.Utils
@ -91,7 +96,7 @@ instance Show CommentedImport where
data ImportStatementRecord = ImportStatementRecord data ImportStatementRecord = ImportStatementRecord
{ commentsBefore :: [(Comment, DeltaPos)] { commentsBefore :: [(Comment, DeltaPos)]
, commentsAfter :: [(Comment, DeltaPos)] , commentsAfter :: [(Comment, DeltaPos)]
, importStatement :: ImportDecl HsSyn.GhcPs , importStatement :: ImportDecl GhcPs
} }
instance Show ImportStatementRecord where instance Show ImportStatementRecord where
@ -99,7 +104,7 @@ instance Show ImportStatementRecord where
(length $ commentsAfter r) (length $ commentsAfter r)
transformToCommentedImport transformToCommentedImport
:: [LImportDecl HsSyn.GhcPs] -> ToBriDocM [CommentedImport] :: [LImportDecl GhcPs] -> ToBriDocM [CommentedImport]
transformToCommentedImport is = do transformToCommentedImport is = do
nodeWithAnnotations <- is `forM` \i@(L _ rawImport) -> do nodeWithAnnotations <- is `forM` \i@(L _ rawImport) -> do
annotionMay <- astAnn i annotionMay <- astAnn i
@ -109,7 +114,7 @@ transformToCommentedImport is = do
replicate (y - 1) EmptyLine ++ [IndependentComment (c, DP (1, x))] replicate (y - 1) EmptyLine ++ [IndependentComment (c, DP (1, x))]
accumF accumF
:: [(Comment, DeltaPos)] :: [(Comment, DeltaPos)]
-> (Maybe Annotation, ImportDecl HsSyn.GhcPs) -> (Maybe Annotation, ImportDecl GhcPs)
-> ([(Comment, DeltaPos)], [CommentedImport]) -> ([(Comment, DeltaPos)], [CommentedImport])
accumF accConnectedComm (annMay, decl) = case annMay of accumF accConnectedComm (annMay, decl) = case annMay of
Nothing -> Nothing ->