Type-fixing layoutDataDecl

mxxun/ghc-9.2
mrkun 2022-01-30 22:44:54 +03:00
parent b4066c5141
commit ed5bf856a9
2 changed files with 40 additions and 39 deletions

View File

@ -67,8 +67,8 @@ processDefault x = do
briDocByExact briDocByExact
:: ::
-- (ExactPrint.Annotate.Annotate ast) -- (ExactPrint.Annotate.Annotate ast)
Data ast (Data ast, Data an)
=> Located ast => LocatedAn an ast
-> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
briDocByExact ast = do briDocByExact ast = do
-- anns <- mAsk -- anns <- mAsk
@ -86,8 +86,8 @@ briDocByExact ast = do
briDocByExactNoComment briDocByExactNoComment
:: ::
-- (ExactPrint.Annotate.Annotate ast) -- (ExactPrint.Annotate.Annotate ast)
Data ast (Data ast, Data an)
=> Located ast => LocatedAn an ast
-> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
briDocByExactNoComment ast = do briDocByExactNoComment ast = do
-- anns <- mAsk -- anns <- mAsk
@ -477,7 +477,7 @@ docLitS s = allocateNode $ BDFLit $ Text.pack s
docExt docExt
:: ::
-- (ExactPrint.Annotate.Annotate ast) -- (ExactPrint.Annotate.Annotate ast)
Located ast LocatedAn an ast
-- -> ExactPrint.Types.Anns -- -> ExactPrint.Types.Anns
-> Bool -> Bool
-> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
@ -639,15 +639,15 @@ docNodeMoveToKWDP ast kw shouldRestoreIndent bdm =
class DocWrapable a where class DocWrapable a where
docWrapNode :: ( Data.Data.Data ast) docWrapNode :: ( Data.Data.Data ast)
=> Located ast => LocatedAn an ast
-> a -> a
-> a -> a
docWrapNodePrior :: ( Data.Data.Data ast) docWrapNodePrior :: ( Data.Data.Data ast)
=> Located ast => LocatedAn an ast
-> a -> a
-> a -> a
docWrapNodeRest :: ( Data.Data.Data ast) docWrapNodeRest :: ( Data.Data.Data ast)
=> Located ast => LocatedAn an ast
-> a -> a
-> a -> a

View File

@ -20,16 +20,16 @@ import Language.Haskell.Brittany.Internal.Types
layoutDataDecl layoutDataDecl
:: Located (TyClDecl GhcPs) :: LocatedAn an1 (TyClDecl GhcPs)
-> Located RdrName -> LocatedAn an2 RdrName
-> LHsQTyVars GhcPs -> LHsQTyVars GhcPs
-> HsDataDefn GhcPs -> HsDataDefn GhcPs
-> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
layoutDataDecl ltycl name (HsQTvs _ bndrs) defn = case defn of layoutDataDecl ltycl name (HsQTvs _ bndrs) defn = case defn of
-- newtype MyType a b = MyType .. -- newtype MyType a b = MyType ..
HsDataDefn _ext NewType (L _ []) _ctype Nothing [cons] mDerivs -> HsDataDefn _ext NewType _ctxt _ctype Nothing [cons] mDerivs ->
case cons of case cons of
(L _ (ConDeclH98 _ext consName (L _ False) _qvars (Just (L _ [])) details _conDoc)) (L _ (ConDeclH98 _ext consName False _qvars (Just (L _ [])) details _conDoc))
-> docWrapNode ltycl $ do -> docWrapNode ltycl $ do
nameStr <- lrdrNameToTextAnn name nameStr <- lrdrNameToTextAnn name
consNameStr <- lrdrNameToTextAnn consName consNameStr <- lrdrNameToTextAnn consName
@ -54,9 +54,9 @@ layoutDataDecl ltycl name (HsQTvs _ bndrs) defn = case defn of
-- data MyData a b -- data MyData a b
-- (zero constructors) -- (zero constructors)
HsDataDefn _ext DataType (L _ lhsContext) _ctype Nothing [] mDerivs -> HsDataDefn _ext DataType mLhsContext _ctype Nothing [] mDerivs ->
docWrapNode ltycl $ do docWrapNode ltycl $ do
lhsContextDoc <- docSharedWrapper createContextDoc lhsContext lhsContextDoc <- docSharedWrapper createContextDoc mLhsContext
nameStr <- lrdrNameToTextAnn name nameStr <- lrdrNameToTextAnn name
tyVarLine <- return <$> createBndrDoc bndrs tyVarLine <- return <$> createBndrDoc bndrs
createDerivingPar mDerivs $ docSeq createDerivingPar mDerivs $ docSeq
@ -68,11 +68,11 @@ layoutDataDecl ltycl name (HsQTvs _ bndrs) defn = case defn of
-- data MyData = MyData .. -- data MyData = MyData ..
-- data MyData = MyData { .. } -- data MyData = MyData { .. }
HsDataDefn _ext DataType (L _ lhsContext) _ctype Nothing [cons] mDerivs -> HsDataDefn _ext DataType mLhsContext _ctype Nothing [cons] mDerivs ->
case cons of case cons of
(L _ (ConDeclH98 _ext consName (L _ _hasExt) qvars mRhsContext details _conDoc)) (L _ (ConDeclH98 _ext consName _hasExt qvars mRhsContext details _conDoc))
-> docWrapNode ltycl $ do -> docWrapNode ltycl $ do
lhsContextDoc <- docSharedWrapper createContextDoc lhsContext lhsContextDoc <- docSharedWrapper createContextDoc mLhsContext
nameStr <- lrdrNameToTextAnn name nameStr <- lrdrNameToTextAnn name
consNameStr <- lrdrNameToTextAnn consName consNameStr <- lrdrNameToTextAnn consName
tyVarLine <- return <$> createBndrDoc bndrs tyVarLine <- return <$> createBndrDoc bndrs
@ -81,7 +81,7 @@ layoutDataDecl ltycl name (HsQTvs _ bndrs) defn = case defn of
Just x -> Just . pure <$> x Just x -> Just . pure <$> x
rhsContextDocMay <- case mRhsContext of rhsContextDocMay <- case mRhsContext of
Nothing -> pure Nothing Nothing -> pure Nothing
Just (L _ ctxt) -> Just . pure <$> createContextDoc ctxt Just lctxt -> Just . pure <$> createContextDoc (Just lctxt)
rhsDoc <- return <$> createDetailsDoc consNameStr details rhsDoc <- return <$> createDetailsDoc consNameStr details
consDoc <- consDoc <-
fmap pure fmap pure
@ -200,11 +200,12 @@ layoutDataDecl ltycl name (HsQTvs _ bndrs) defn = case defn of
_ -> briDocByExactNoComment ltycl _ -> briDocByExactNoComment ltycl
createContextDoc :: HsContext GhcPs -> ToBriDocM BriDocNumbered createContextDoc :: Maybe (LHsContext GhcPs) -> ToBriDocM BriDocNumbered
createContextDoc [] = docEmpty createContextDoc Nothing = docEmpty
createContextDoc [t] = createContextDoc (Just (L _ lhsContext)) = case lhsContext of
docSeq [layoutType t, docSeparator, docLitS "=>", docSeparator] [] -> docEmpty
createContextDoc (t1 : tR) = do [t] -> docSeq [layoutType t, docSeparator, docLitS "=>", docSeparator]
(t1 : tR) -> do
t1Doc <- docSharedWrapper layoutType t1 t1Doc <- docSharedWrapper layoutType t1
tRDocs <- tR `forM` docSharedWrapper layoutType tRDocs <- tR `forM` docSharedWrapper layoutType
docAlt docAlt