Finish Decl

mxxun/ghc-9.2
mrkun 2022-01-31 03:07:53 +03:00
parent e6a38550a0
commit 0fca61a8e3
2 changed files with 22 additions and 22 deletions

View File

@ -208,7 +208,7 @@ lrdrNameToTextAnnTypeEqualityIsSpecialAndRespectTick
, MonadMultiReader Config m , MonadMultiReader Config m
-- , MonadMultiReader (Map AnnKey Annotation) m -- , MonadMultiReader (Map AnnKey Annotation) m
) )
=> Located ast => LocatedAn an ast
-> LocatedAn an RdrName -> LocatedAn an RdrName
-> m Text -> m Text
lrdrNameToTextAnnTypeEqualityIsSpecialAndRespectTick ast1 ast2 = do lrdrNameToTextAnnTypeEqualityIsSpecialAndRespectTick ast1 ast2 = do
@ -309,13 +309,13 @@ hasAnyCommentsPrior ast = {-astAnn-} undefined ast <&> \case
Just _ {-(ExactPrint.Types.Ann _ priors _ _ _ _)-} -> not $ null priors Just _ {-(ExactPrint.Types.Ann _ priors _ _ _ _)-} -> not $ null priors
where priors = [undefined] where priors = [undefined]
hasAnyRegularCommentsRest :: Data ast => GHC.Located ast -> ToBriDocM Bool hasAnyRegularCommentsRest :: Data ast => GHC.LocatedAn an ast -> ToBriDocM Bool
hasAnyRegularCommentsRest ast = {-astAnn-} undefined ast <&> \case hasAnyRegularCommentsRest ast = {-astAnn-} undefined ast <&> \case
Nothing -> False Nothing -> False
Just ann -> undefined -- any isRegularComment (extractRestComments ann) Just ann -> undefined -- any isRegularComment (extractRestComments ann)
hasAnnKeywordComment hasAnnKeywordComment
:: Data ast => GHC.Located ast -> AnnKeywordId -> ToBriDocM Bool :: Data ast => GHC.LocatedAn an ast -> AnnKeywordId -> ToBriDocM Bool
hasAnnKeywordComment ast annKeyword = {-astAnn-} undefined ast <&> \case hasAnnKeywordComment ast annKeyword = {-astAnn-} undefined ast <&> \case
Nothing -> False Nothing -> False
Just ann -> any hasK ({-extractAllComments-} thing ann) Just ann -> any hasK ({-extractAllComments-} thing ann)
@ -328,7 +328,7 @@ hasAnnKeyword
-- , MonadMultiReader (Map AnnKey Annotation) m -- , MonadMultiReader (Map AnnKey Annotation) m
, Functor m , Functor m
) )
=> Located a => LocatedAn an a
-> AnnKeywordId -> AnnKeywordId
-> m Bool -> m Bool
hasAnnKeyword ast annKeyword = {-astAnn-} astAnn' ast <&> \case hasAnnKeyword ast annKeyword = {-astAnn-} astAnn' ast <&> \case

View File

@ -193,7 +193,7 @@ layoutIPBind lipbind@(L _ bind) = case bind of
data BagBindOrSig = BagBind (LHsBindLR GhcPs GhcPs) data BagBindOrSig = BagBind (LHsBindLR GhcPs GhcPs)
| BagSig (LSig GhcPs) | BagSig (LSig GhcPs)
bindOrSigtoSrcSpan :: BagBindOrSig -> SrcSpan bindOrSigtoSrcSpan :: BagBindOrSig -> SrcSpanAnnA
bindOrSigtoSrcSpan (BagBind (L l _)) = l bindOrSigtoSrcSpan (BagBind (L l _)) = l
bindOrSigtoSrcSpan (BagSig (L l _)) = l bindOrSigtoSrcSpan (BagSig (L l _)) = l
@ -210,7 +210,7 @@ layoutLocalBinds binds = case binds of
unordered = unordered =
[ BagBind b | b <- Data.Foldable.toList bindlrs ] [ BagBind b | b <- Data.Foldable.toList bindlrs ]
++ [ BagSig s | s <- sigs ] ++ [ BagSig s | s <- sigs ]
ordered = List.sortOn (ExactPrint.rs . bindOrSigtoSrcSpan) unordered ordered = List.sortOn (la2r . bindOrSigtoSrcSpan) unordered
docs <- docWrapNode (noLocA binds) $ join <$> ordered `forM` \case docs <- docWrapNode (noLocA binds) $ join <$> ordered `forM` \case
BagBind b -> either id return <$> layoutBind b BagBind b -> either id return <$> layoutBind b
BagSig s -> return <$> layoutSig s BagSig s -> return <$> layoutSig s
@ -226,7 +226,7 @@ layoutGrhs
:: LGRHS GhcPs (LHsExpr GhcPs) :: LGRHS GhcPs (LHsExpr GhcPs)
-> ToBriDocM ([BriDocNumbered], BriDocNumbered, LHsExpr GhcPs) -> ToBriDocM ([BriDocNumbered], BriDocNumbered, LHsExpr GhcPs)
layoutGrhs lgrhs@(L _ (GRHS _ guards body)) = do layoutGrhs lgrhs@(L _ (GRHS _ guards body)) = do
guardDocs <- docWrapNode lgrhs $ layoutStmt `mapM` guards guardDocs <- docWrapNode (reLocA lgrhs) $ layoutStmt `mapM` guards
bodyDoc <- layoutExpr body bodyDoc <- layoutExpr body
return (guardDocs, bodyDoc, body) return (guardDocs, bodyDoc, body)
@ -275,7 +275,7 @@ layoutPatternBind funId binderDoc lmatch@(L _ match) = do
$ (List.intersperse docSeparator $ docForceSingleline <$> ps) $ (List.intersperse docSeparator $ docForceSingleline <$> ps)
clauseDocs <- docWrapNodeRest lmatch $ layoutGrhs `mapM` grhss clauseDocs <- docWrapNodeRest lmatch $ layoutGrhs `mapM` grhss
mWhereDocs <- layoutLocalBinds whereBinds mWhereDocs <- layoutLocalBinds whereBinds
let mWhereArg = mWhereDocs <&> (,) (mkAnnKey lmatch) let mWhereArg = mWhereDocs <&> (,) ({-mkAnnKey-} undefined lmatch)
let alignmentToken = if null pats then Nothing else funId let alignmentToken = if null pats then Nothing else funId
hasComments <- hasAnyCommentsBelow lmatch hasComments <- hasAnyCommentsBelow lmatch
layoutPatternBindFinal layoutPatternBindFinal
@ -678,7 +678,7 @@ layoutLPatSyn name (InfixCon left right) = do
docSeq . fmap (appSep . docLit) $ [leftDoc, docName, rightDoc] docSeq . fmap (appSep . docLit) $ [leftDoc, docName, rightDoc]
layoutLPatSyn name (RecCon recArgs) = do layoutLPatSyn name (RecCon recArgs) = do
docName <- lrdrNameToTextAnn name docName <- lrdrNameToTextAnn name
args <- mapM (lrdrNameToTextAnn . recordPatSynSelectorId) recArgs args <- mapM (lrdrNameToTextAnn . rdrNameFieldOcc . recordPatSynField) recArgs
docSeq docSeq
. fmap docLit . fmap docLit
$ [docName, Text.pack " { "] $ [docName, Text.pack " { "]
@ -700,7 +700,7 @@ layoutPatSynWhere hs = case hs of
-- TyClDecl -- TyClDecl
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
layoutTyCl :: ToBriDoc an TyClDecl layoutTyCl :: Data.Data.Data an => ToBriDoc an TyClDecl
layoutTyCl ltycl@(L _loc tycl) = case tycl of layoutTyCl ltycl@(L _loc tycl) = case tycl of
SynDecl _ name vars fixity typ -> do SynDecl _ name vars fixity typ -> do
let let
@ -721,7 +721,7 @@ layoutTyCl ltycl@(L _loc tycl) = case tycl of
layoutSynDecl layoutSynDecl
:: Bool :: Bool
-> (ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered) -> (ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered)
-> LocatedAn an (IdP GhcPs) -> LIdP GhcPs
-> [LHsTyVarBndr () GhcPs] -> [LHsTyVarBndr () GhcPs]
-> LHsType GhcPs -> LHsType GhcPs
-> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
@ -789,8 +789,8 @@ layoutTyFamInstDecl
-> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
layoutTyFamInstDecl inClass outerNode tfid = do layoutTyFamInstDecl inClass outerNode tfid = do
let let
FamEqn _ name bndrsMay pats _fixity typ = L_body $ tfid_eqn tfid FamEqn _ name bndrs pats _fixity typ = tfid_eqn tfid
-- bndrsMay isJust e.g. with -- bndrs isJust e.g. with
-- type instance forall a . MyType (Maybe a) = Either () a -- type instance forall a . MyType (Maybe a) = Either () a
innerNode = outerNode innerNode = outerNode
docWrapNodePrior outerNode $ do docWrapNodePrior outerNode $ do
@ -811,7 +811,7 @@ layoutTyFamInstDecl inClass outerNode tfid = do
docWrapNode innerNode docWrapNode innerNode
. docSeq . docSeq
$ [appSep instanceDoc] $ [appSep instanceDoc]
++ [ makeForallDoc foralls | Just foralls <- [bndrsMay] ] ++ [ makeForallDoc foralls | HsOuterExplicit _ foralls <- [bndrs] ]
++ [ docParenL | needsParens ] ++ [ docParenL | needsParens ]
++ [appSep $ docWrapNode name $ docLit nameStr] ++ [appSep $ docWrapNode name $ docLit nameStr]
++ intersperse docSeparator (layoutHsTyPats pats) ++ intersperse docSeparator (layoutHsTyPats pats)
@ -843,7 +843,7 @@ layoutHsTyPats pats = pats <&> \case
-- Layout signatures and bindings using the corresponding layouters from the -- Layout signatures and bindings using the corresponding layouters from the
-- top-level. Layout the instance head, type family instances, and data family -- top-level. Layout the instance head, type family instances, and data family
-- instances using ExactPrint. -- instances using ExactPrint.
layoutClsInst :: ToBriDoc an ClsInstDecl layoutClsInst :: Data.Data.Data an => ToBriDoc an ClsInstDecl
layoutClsInst lcid@(L _ cid) = docLines layoutClsInst lcid@(L _ cid) = docLines
[ layoutInstanceHead [ layoutInstanceHead
, docEnsureIndent BrIndentRegular , docEnsureIndent BrIndentRegular
@ -873,18 +873,18 @@ layoutClsInst lcid@(L _ cid) = docLines
-- | Like 'docLines', but sorts the lines based on location -- | Like 'docLines', but sorts the lines based on location
docSortedLines docSortedLines
:: [ToBriDocM (Located BriDocNumbered)] -> ToBriDocM BriDocNumbered :: [ToBriDocM (LocatedAn an BriDocNumbered)] -> ToBriDocM BriDocNumbered
docSortedLines l = docSortedLines l =
allocateNode allocateNode
. BDFLines . BDFLines
. fmap unLoc . fmap unLoc
. List.sortOn (ExactPrint.rs . getLoc) . List.sortOn (realSrcSpan . getLocA)
=<< sequence l =<< sequence l
layoutAndLocateSig :: ToBriDocC an (Sig GhcPs) (Located BriDocNumbered) layoutAndLocateSig :: ToBriDocC AnnListItem (Sig GhcPs) (LocatedA BriDocNumbered)
layoutAndLocateSig lsig@(L loc _) = L loc <$> layoutSig lsig layoutAndLocateSig lsig@(L loc _) = L loc <$> layoutSig lsig
layoutAndLocateBind :: ToBriDocC an (HsBind GhcPs) (Located BriDocNumbered) layoutAndLocateBind :: ToBriDocC an (HsBind GhcPs) (LocatedAn an BriDocNumbered)
layoutAndLocateBind lbind@(L loc _) = layoutAndLocateBind lbind@(L loc _) =
L loc <$> (joinBinds =<< layoutBind lbind) L loc <$> (joinBinds =<< layoutBind lbind)
@ -895,17 +895,17 @@ layoutClsInst lcid@(L _ cid) = docLines
Right n -> return n Right n -> return n
layoutAndLocateTyFamInsts layoutAndLocateTyFamInsts
:: ToBriDocC an (TyFamInstDecl GhcPs) (Located BriDocNumbered) :: ToBriDocC an (TyFamInstDecl GhcPs) (LocatedAn an BriDocNumbered)
layoutAndLocateTyFamInsts ltfid@(L loc tfid) = layoutAndLocateTyFamInsts ltfid@(L loc tfid) =
L loc <$> layoutTyFamInstDecl True ltfid tfid L loc <$> layoutTyFamInstDecl True ltfid tfid
layoutAndLocateDataFamInsts layoutAndLocateDataFamInsts
:: ToBriDocC an (DataFamInstDecl GhcPs) (Located BriDocNumbered) :: Data.Data.Data an => ToBriDocC an (DataFamInstDecl GhcPs) (LocatedAn an BriDocNumbered)
layoutAndLocateDataFamInsts ldfid@(L loc _) = layoutAndLocateDataFamInsts ldfid@(L loc _) =
L loc <$> layoutDataFamInstDecl ldfid L loc <$> layoutDataFamInstDecl ldfid
-- | Send to ExactPrint then remove unecessary whitespace -- | Send to ExactPrint then remove unecessary whitespace
layoutDataFamInstDecl :: ToBriDoc an DataFamInstDecl layoutDataFamInstDecl :: Data.Data.Data an => ToBriDoc an DataFamInstDecl
layoutDataFamInstDecl ldfid = layoutDataFamInstDecl ldfid =
fmap stripWhitespace <$> briDocByExactNoComment ldfid fmap stripWhitespace <$> briDocByExactNoComment ldfid