From ed5bf856a9bcbf7428f5942b1b6a4e1d8ba7649a Mon Sep 17 00:00:00 2001 From: mrkun Date: Sun, 30 Jan 2022 22:44:54 +0300 Subject: [PATCH] Type-fixing layoutDataDecl --- .../Brittany/Internal/LayouterBasics.hs | 16 ++--- .../Brittany/Internal/Layouters/DataDecl.hs | 63 ++++++++++--------- 2 files changed, 40 insertions(+), 39 deletions(-) diff --git a/source/library/Language/Haskell/Brittany/Internal/LayouterBasics.hs b/source/library/Language/Haskell/Brittany/Internal/LayouterBasics.hs index 1694eb3..ca32220 100644 --- a/source/library/Language/Haskell/Brittany/Internal/LayouterBasics.hs +++ b/source/library/Language/Haskell/Brittany/Internal/LayouterBasics.hs @@ -67,8 +67,8 @@ processDefault x = do briDocByExact :: -- (ExactPrint.Annotate.Annotate ast) - Data ast - => Located ast + (Data ast, Data an) + => LocatedAn an ast -> ToBriDocM BriDocNumbered briDocByExact ast = do -- anns <- mAsk @@ -86,8 +86,8 @@ briDocByExact ast = do briDocByExactNoComment :: -- (ExactPrint.Annotate.Annotate ast) - Data ast - => Located ast + (Data ast, Data an) + => LocatedAn an ast -> ToBriDocM BriDocNumbered briDocByExactNoComment ast = do -- anns <- mAsk @@ -477,7 +477,7 @@ docLitS s = allocateNode $ BDFLit $ Text.pack s docExt :: -- (ExactPrint.Annotate.Annotate ast) - Located ast + LocatedAn an ast -- -> ExactPrint.Types.Anns -> Bool -> ToBriDocM BriDocNumbered @@ -639,15 +639,15 @@ docNodeMoveToKWDP ast kw shouldRestoreIndent bdm = class DocWrapable a where docWrapNode :: ( Data.Data.Data ast) - => Located ast + => LocatedAn an ast -> a -> a docWrapNodePrior :: ( Data.Data.Data ast) - => Located ast + => LocatedAn an ast -> a -> a docWrapNodeRest :: ( Data.Data.Data ast) - => Located ast + => LocatedAn an ast -> a -> a diff --git a/source/library/Language/Haskell/Brittany/Internal/Layouters/DataDecl.hs b/source/library/Language/Haskell/Brittany/Internal/Layouters/DataDecl.hs index c3df7e8..500444f 100644 --- a/source/library/Language/Haskell/Brittany/Internal/Layouters/DataDecl.hs +++ b/source/library/Language/Haskell/Brittany/Internal/Layouters/DataDecl.hs @@ -20,16 +20,16 @@ import Language.Haskell.Brittany.Internal.Types layoutDataDecl - :: Located (TyClDecl GhcPs) - -> Located RdrName + :: LocatedAn an1 (TyClDecl GhcPs) + -> LocatedAn an2 RdrName -> LHsQTyVars GhcPs -> HsDataDefn GhcPs -> ToBriDocM BriDocNumbered layoutDataDecl ltycl name (HsQTvs _ bndrs) defn = case defn of -- newtype MyType a b = MyType .. - HsDataDefn _ext NewType (L _ []) _ctype Nothing [cons] mDerivs -> + HsDataDefn _ext NewType _ctxt _ctype Nothing [cons] mDerivs -> 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 nameStr <- lrdrNameToTextAnn name consNameStr <- lrdrNameToTextAnn consName @@ -54,9 +54,9 @@ layoutDataDecl ltycl name (HsQTvs _ bndrs) defn = case defn of -- data MyData a b -- (zero constructors) - HsDataDefn _ext DataType (L _ lhsContext) _ctype Nothing [] mDerivs -> + HsDataDefn _ext DataType mLhsContext _ctype Nothing [] mDerivs -> docWrapNode ltycl $ do - lhsContextDoc <- docSharedWrapper createContextDoc lhsContext + lhsContextDoc <- docSharedWrapper createContextDoc mLhsContext nameStr <- lrdrNameToTextAnn name tyVarLine <- return <$> createBndrDoc bndrs createDerivingPar mDerivs $ docSeq @@ -68,11 +68,11 @@ layoutDataDecl ltycl name (HsQTvs _ bndrs) defn = case defn of -- 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 - (L _ (ConDeclH98 _ext consName (L _ _hasExt) qvars mRhsContext details _conDoc)) + (L _ (ConDeclH98 _ext consName _hasExt qvars mRhsContext details _conDoc)) -> docWrapNode ltycl $ do - lhsContextDoc <- docSharedWrapper createContextDoc lhsContext + lhsContextDoc <- docSharedWrapper createContextDoc mLhsContext nameStr <- lrdrNameToTextAnn name consNameStr <- lrdrNameToTextAnn consName tyVarLine <- return <$> createBndrDoc bndrs @@ -81,7 +81,7 @@ layoutDataDecl ltycl name (HsQTvs _ bndrs) defn = case defn of Just x -> Just . pure <$> x rhsContextDocMay <- case mRhsContext of Nothing -> pure Nothing - Just (L _ ctxt) -> Just . pure <$> createContextDoc ctxt + Just lctxt -> Just . pure <$> createContextDoc (Just lctxt) rhsDoc <- return <$> createDetailsDoc consNameStr details consDoc <- fmap pure @@ -200,28 +200,29 @@ layoutDataDecl ltycl name (HsQTvs _ bndrs) defn = case defn of _ -> briDocByExactNoComment ltycl -createContextDoc :: HsContext GhcPs -> ToBriDocM BriDocNumbered -createContextDoc [] = docEmpty -createContextDoc [t] = - docSeq [layoutType t, docSeparator, docLitS "=>", docSeparator] -createContextDoc (t1 : tR) = do - t1Doc <- docSharedWrapper layoutType t1 - tRDocs <- tR `forM` docSharedWrapper layoutType - docAlt - [ docSeq - [ docLitS "(" - , docForceSingleline $ docSeq $ List.intersperse - docCommaSep - (t1Doc : tRDocs) - , docLitS ") =>" - , docSeparator +createContextDoc :: Maybe (LHsContext GhcPs) -> ToBriDocM BriDocNumbered +createContextDoc Nothing = docEmpty +createContextDoc (Just (L _ lhsContext)) = case lhsContext of + [] -> docEmpty + [t] -> docSeq [layoutType t, docSeparator, docLitS "=>", docSeparator] + (t1 : tR) -> do + t1Doc <- docSharedWrapper layoutType t1 + tRDocs <- tR `forM` docSharedWrapper layoutType + docAlt + [ docSeq + [ docLitS "(" + , docForceSingleline $ docSeq $ List.intersperse + docCommaSep + (t1Doc : tRDocs) + , docLitS ") =>" + , docSeparator + ] + , docLines $ join + [ [docSeq [docLitS "(", docSeparator, t1Doc]] + , tRDocs <&> \tRDoc -> docSeq [docLitS ",", docSeparator, tRDoc] + , [docLitS ") =>", docSeparator] + ] ] - , docLines $ join - [ [docSeq [docLitS "(", docSeparator, t1Doc]] - , tRDocs <&> \tRDoc -> docSeq [docLitS ",", docSeparator, tRDoc] - , [docLitS ") =>", docSeparator] - ] - ] createBndrDoc :: [LHsTyVarBndr flag GhcPs] -> ToBriDocM BriDocNumbered createBndrDoc bs = do