Upgrade IE to LocatedAn
parent
648d4a0459
commit
05bcc7571a
|
@ -246,14 +246,14 @@ extractRestComments ann =
|
||||||
-- | True if there are any comments that are
|
-- | True if there are any comments that are
|
||||||
-- a) connected to any node below (in AST sense) the given node AND
|
-- a) connected to any node below (in AST sense) the given node AND
|
||||||
-- b) after (in source code order) the node.
|
-- b) after (in source code order) the node.
|
||||||
hasAnyCommentsBelow :: Data ast => GHC.Located ast -> ToBriDocM Bool
|
hasAnyCommentsBelow :: Data ast => GHC.LocatedAn an ast -> ToBriDocM Bool
|
||||||
hasAnyCommentsBelow ast@(L l _) =
|
hasAnyCommentsBelow ast@(L l _) =
|
||||||
List.any (\(c, _) -> {-ExactPrint.commentIdentifier-} undefined c > ExactPrint.Utils.rs l)
|
List.any (\(c, _) -> {-ExactPrint.commentIdentifier c > ExactPrint.Utils.rs l-} undefined)
|
||||||
<$> astConnectedComments ast
|
<$> astConnectedComments ast
|
||||||
|
|
||||||
hasCommentsBetween
|
hasCommentsBetween
|
||||||
:: Data ast
|
:: Data ast
|
||||||
=> GHC.Located ast
|
=> GHC.LocatedAn an ast
|
||||||
-> AnnKeywordId
|
-> AnnKeywordId
|
||||||
-> AnnKeywordId
|
-> AnnKeywordId
|
||||||
-> ToBriDocM Bool
|
-> ToBriDocM Bool
|
||||||
|
@ -273,12 +273,12 @@ hasCommentsBetween ast leftKey rightKey = do
|
||||||
|
|
||||||
-- | True if there are any comments that are connected to any node below (in AST
|
-- | True if there are any comments that are connected to any node below (in AST
|
||||||
-- sense) the given node
|
-- sense) the given node
|
||||||
hasAnyCommentsConnected :: Data ast => GHC.Located ast -> ToBriDocM Bool
|
hasAnyCommentsConnected :: Data ast => GHC.LocatedAn an ast -> ToBriDocM Bool
|
||||||
hasAnyCommentsConnected ast = not . null <$> astConnectedComments ast
|
hasAnyCommentsConnected ast = not . null <$> astConnectedComments ast
|
||||||
|
|
||||||
-- | True if there are any regular comments connected to any node below (in AST
|
-- | True if there are any regular comments connected to any node below (in AST
|
||||||
-- sense) the given node
|
-- sense) the given node
|
||||||
hasAnyRegularCommentsConnected :: Data ast => GHC.Located ast -> ToBriDocM Bool
|
hasAnyRegularCommentsConnected :: Data ast => GHC.LocatedAn an ast -> ToBriDocM Bool
|
||||||
hasAnyRegularCommentsConnected ast =
|
hasAnyRegularCommentsConnected ast =
|
||||||
any {-isRegularComment-} undefined <$> astConnectedComments ast
|
any {-isRegularComment-} undefined <$> astConnectedComments ast
|
||||||
|
|
||||||
|
@ -299,7 +299,7 @@ type Comment = ()
|
||||||
|
|
||||||
astConnectedComments
|
astConnectedComments
|
||||||
:: Data ast
|
:: Data ast
|
||||||
=> GHC.Located ast
|
=> GHC.LocatedAn an ast
|
||||||
-> ToBriDocM [(Comment, DeltaPos)]
|
-> ToBriDocM [(Comment, DeltaPos)]
|
||||||
astConnectedComments ast = do
|
astConnectedComments ast = do
|
||||||
undefined
|
undefined
|
||||||
|
|
|
@ -7,7 +7,7 @@ import Language.Haskell.Brittany.Internal.Types
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
layoutExpr :: ToBriDoc HsExpr
|
layoutExpr :: ToBriDoc an HsExpr
|
||||||
|
|
||||||
-- layoutStmt :: ToBriDoc' (StmtLR GhcPs GhcPs (LHsExpr GhcPs))
|
-- layoutStmt :: ToBriDoc' (StmtLR GhcPs GhcPs (LHsExpr GhcPs))
|
||||||
|
|
||||||
|
|
|
@ -23,17 +23,17 @@ import Language.Haskell.Brittany.Internal.Utils
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
prepareName :: LIEWrappedName name -> Located name
|
prepareName :: LIEWrappedName name -> LocatedN name
|
||||||
prepareName = ieLWrappedName
|
prepareName = ieLWrappedName
|
||||||
|
|
||||||
layoutIE :: ToBriDoc IE
|
layoutIE :: ToBriDoc an IE
|
||||||
layoutIE lie@(L _ ie) = docWrapNode lie $ case ie of
|
layoutIE lie@(L _ ie) = docWrapNode lie $ case ie of
|
||||||
IEVar _ x -> layoutWrapped lie x
|
IEVar _ x -> layoutWrapped lie x
|
||||||
IEThingAbs _ x -> layoutWrapped lie x
|
IEThingAbs _ x -> layoutWrapped lie x
|
||||||
IEThingAll _ x -> docSeq [layoutWrapped lie x, docLit $ Text.pack "(..)"]
|
IEThingAll _ x -> docSeq [layoutWrapped lie x, docLit $ Text.pack "(..)"]
|
||||||
IEThingWith _ x (IEWildcard _) _ _ ->
|
IEThingWith _ x (IEWildcard _) _ ->
|
||||||
docSeq [layoutWrapped lie x, docLit $ Text.pack "(..)"]
|
docSeq [layoutWrapped lie x, docLit $ Text.pack "(..)"]
|
||||||
IEThingWith _ x _ ns _ -> do
|
IEThingWith _ x _ ns -> do
|
||||||
hasComments <- orM
|
hasComments <- orM
|
||||||
(hasCommentsBetween lie AnnOpenP AnnCloseP
|
(hasCommentsBetween lie AnnOpenP AnnCloseP
|
||||||
: hasAnyCommentsBelow x
|
: hasAnyCommentsBelow x
|
||||||
|
@ -78,10 +78,10 @@ layoutIE lie@(L _ ie) = docWrapNode lie $ case ie of
|
||||||
where
|
where
|
||||||
layoutWrapped _ = \case
|
layoutWrapped _ = \case
|
||||||
L _ (IEName n) -> docLit =<< lrdrNameToTextAnn n
|
L _ (IEName n) -> docLit =<< lrdrNameToTextAnn n
|
||||||
L _ (IEPattern n) -> do
|
L _ (IEPattern _ n) -> do
|
||||||
name <- lrdrNameToTextAnn n
|
name <- lrdrNameToTextAnn n
|
||||||
docLit $ Text.pack "pattern " <> name
|
docLit $ Text.pack "pattern " <> name
|
||||||
L _ (IEType n) -> do
|
L _ (IEType _ n) -> do
|
||||||
name <- lrdrNameToTextAnn n
|
name <- lrdrNameToTextAnn n
|
||||||
docLit $ Text.pack "type " <> name
|
docLit $ Text.pack "type " <> name
|
||||||
|
|
||||||
|
@ -95,7 +95,7 @@ data SortItemsFlag = ShouldSortItems | KeepItemsUnsorted
|
||||||
-- left to the caller since that is context sensitive
|
-- left to the caller since that is context sensitive
|
||||||
layoutAnnAndSepLLIEs
|
layoutAnnAndSepLLIEs
|
||||||
:: SortItemsFlag
|
:: SortItemsFlag
|
||||||
-> Located [LIE GhcPs]
|
-> LocatedAn an [LIE GhcPs]
|
||||||
-> ToBriDocM [ToBriDocM BriDocNumbered]
|
-> ToBriDocM [ToBriDocM BriDocNumbered]
|
||||||
layoutAnnAndSepLLIEs shouldSort llies@(L _ lies) = do
|
layoutAnnAndSepLLIEs shouldSort llies@(L _ lies) = do
|
||||||
let makeIENode ie = docSeq [docCommaSep, ie]
|
let makeIENode ie = docSeq [docCommaSep, ie]
|
||||||
|
@ -131,7 +131,7 @@ layoutAnnAndSepLLIEs shouldSort llies@(L _ lies) = do
|
||||||
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
|
||||||
isIEVar :: LIE GhcPs -> Bool
|
isIEVar :: LIE GhcPs -> Bool
|
||||||
isIEVar = \case
|
isIEVar = \case
|
||||||
|
@ -143,7 +143,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
|
||||||
thingFolder (L l (IEThingWith x wn _ consItems1 fieldLbls1)) (L _ (IEThingWith _ _ _ consItems2 fieldLbls2))
|
thingFolder (L l (IEThingWith x wn _ consItems1)) (L _ (IEThingWith _ _ _ consItems2))
|
||||||
= L
|
= L
|
||||||
l
|
l
|
||||||
(IEThingWith
|
(IEThingWith
|
||||||
|
@ -151,7 +151,6 @@ layoutAnnAndSepLLIEs shouldSort llies@(L _ lies) = do
|
||||||
wn
|
wn
|
||||||
NoIEWildcard
|
NoIEWildcard
|
||||||
(consItems1 ++ consItems2)
|
(consItems1 ++ consItems2)
|
||||||
(fieldLbls1 ++ fieldLbls2)
|
|
||||||
)
|
)
|
||||||
thingFolder _ _ =
|
thingFolder _ _ =
|
||||||
error "thingFolder should be exhaustive because we have a guard above"
|
error "thingFolder should be exhaustive because we have a guard above"
|
||||||
|
@ -171,7 +170,7 @@ layoutAnnAndSepLLIEs shouldSort llies@(L _ lies) = do
|
||||||
-- ( -- a comment
|
-- ( -- a comment
|
||||||
-- )
|
-- )
|
||||||
layoutLLIEs
|
layoutLLIEs
|
||||||
:: Bool -> SortItemsFlag -> Located [LIE GhcPs] -> ToBriDocM BriDocNumbered
|
:: Bool -> SortItemsFlag -> LocatedAn an [LIE GhcPs] -> ToBriDocM BriDocNumbered
|
||||||
layoutLLIEs enableSingleline shouldSort llies = do
|
layoutLLIEs enableSingleline shouldSort llies = do
|
||||||
ieDs <- layoutAnnAndSepLLIEs shouldSort llies
|
ieDs <- layoutAnnAndSepLLIEs shouldSort llies
|
||||||
hasComments <- hasAnyCommentsBelow llies
|
hasComments <- hasAnyCommentsBelow llies
|
||||||
|
@ -199,8 +198,8 @@ layoutLLIEs enableSingleline shouldSort llies = do
|
||||||
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
|
||||||
|
|
||||||
-- | 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.
|
||||||
|
@ -210,7 +209,7 @@ lieToText = \case
|
||||||
L _ (IEVar _ wn) -> wrappedNameToText wn
|
L _ (IEVar _ wn) -> wrappedNameToText wn
|
||||||
L _ (IEThingAbs _ wn) -> wrappedNameToText wn
|
L _ (IEThingAbs _ wn) -> wrappedNameToText wn
|
||||||
L _ (IEThingAll _ wn) -> wrappedNameToText wn
|
L _ (IEThingAll _ wn) -> wrappedNameToText wn
|
||||||
L _ (IEThingWith _ wn _ _ _) -> wrappedNameToText wn
|
L _ (IEThingWith _ wn _ _) -> wrappedNameToText wn
|
||||||
-- TODO: These _may_ appear in exports!
|
-- TODO: These _may_ appear in exports!
|
||||||
-- Need to check, and either put them at the top (for module) or do some
|
-- Need to check, and either put them at the top (for module) or do some
|
||||||
-- other clever thing.
|
-- other clever thing.
|
||||||
|
@ -219,6 +218,6 @@ lieToText = \case
|
||||||
L _ IEDoc{} -> Text.pack "@IEDoc"
|
L _ IEDoc{} -> Text.pack "@IEDoc"
|
||||||
L _ IEDocNamed{} -> Text.pack "@IEDocNamed"
|
L _ IEDocNamed{} -> Text.pack "@IEDocNamed"
|
||||||
where
|
where
|
||||||
moduleNameToText :: Located ModuleName -> Text
|
moduleNameToText :: LocatedAn an ModuleName -> Text
|
||||||
moduleNameToText (L _ name) =
|
moduleNameToText (L _ name) =
|
||||||
Text.pack ("@IEModuleContents" ++ moduleNameString name)
|
Text.pack ("@IEModuleContents" ++ moduleNameString name)
|
||||||
|
|
Loading…
Reference in New Issue