From 16a89cdfeb8289d62f7558fca8e7188abd6b208d Mon Sep 17 00:00:00 2001 From: mrkun Date: Sat, 12 Feb 2022 17:44:54 +0300 Subject: [PATCH] Fix Expr --- .../Brittany/Internal/Layouters/Expr.hs | 62 +++++++++++-------- .../Brittany/Internal/Layouters/Expr.hs-boot | 4 +- 2 files changed, 38 insertions(+), 28 deletions(-) diff --git a/source/library/Language/Haskell/Brittany/Internal/Layouters/Expr.hs b/source/library/Language/Haskell/Brittany/Internal/Layouters/Expr.hs index 138a748..8808b10 100644 --- a/source/library/Language/Haskell/Brittany/Internal/Layouters/Expr.hs +++ b/source/library/Language/Haskell/Brittany/Internal/Layouters/Expr.hs @@ -8,12 +8,13 @@ import qualified Data.Data import qualified Data.Semigroup as Semigroup import qualified Data.Sequence as Seq import qualified Data.Text as Text -import GHC (AnnKeywordId(..), GenLocated(L), RdrName(..), SrcSpan) +import GHC (GenLocated(L), RdrName(..)) import qualified GHC.Data.FastString as FastString import GHC.Hs import qualified GHC.OldList as List import GHC.Types.Basic import GHC.Types.Name +import GHC.Types.SourceText import Language.Haskell.Brittany.Internal.Config.Types import Language.Haskell.Brittany.Internal.LayouterBasics import Language.Haskell.Brittany.Internal.Layouters.Decl @@ -27,7 +28,7 @@ import Language.Haskell.Brittany.Internal.Utils -layoutExpr :: ToBriDoc HsExpr +layoutExpr :: ToBriDoc AnnListItem HsExpr layoutExpr lexpr@(L _ expr) = do indentPolicy <- mAsk <&> _conf_layout .> _lconfig_indentPolicy .> confUnpack let allowFreeIndent = indentPolicy == IndentPolicyFree @@ -38,7 +39,7 @@ layoutExpr lexpr@(L _ expr) = do HsRecFld{} -> do -- TODO briDocByExactInlineOnly "HsRecFld" lexpr - HsOverLabel _ext _reboundFromLabel name -> + HsOverLabel _ext name -> let label = FastString.unpackFS name in docLit . Text.pack $ '#' : label HsIPVar _ext (HsIPName name) -> let label = FastString.unpackFS name in docLit . Text.pack $ '?' : label @@ -49,7 +50,7 @@ layoutExpr lexpr@(L _ expr) = do HsLam _ (MG _ (L _ [lmatch@(L _ match)]) _) | pats <- m_pats match , GRHSs _ [lgrhs] llocals <- m_grhss match - , L _ EmptyLocalBinds{} <- llocals + , EmptyLocalBinds{} <- llocals , L _ (GRHS _ [] body) <- lgrhs -> do patDocs <- zip (True : repeat False) pats `forM` \(isFirst, p) -> @@ -86,7 +87,7 @@ layoutExpr lexpr@(L _ expr) = do [ docLit $ Text.pack "\\" , docWrapNode lmatch $ docForceSingleline funcPatternPartLine , appSep $ docLit $ Text.pack "->" - , docWrapNode lgrhs $ docForceSingleline bodyDoc + , docWrapNode (reLocA lgrhs) $ docForceSingleline bodyDoc ] -- double line , docSetParSpacing $ docAddBaseY BrIndentRegular $ docPar @@ -97,13 +98,13 @@ layoutExpr lexpr@(L _ expr) = do , docLit $ Text.pack "->" ] ) - (docWrapNode lgrhs $ docForceSingleline bodyDoc) + (docWrapNode (reLocA lgrhs) $ docForceSingleline bodyDoc) -- wrapped par spacing , docSetParSpacing $ docSeq [ docLit $ Text.pack "\\" , docWrapNode lmatch $ docForceSingleline funcPatternPartLine , appSep $ docLit $ Text.pack "->" - , docWrapNode lgrhs $ docForceParSpacing bodyDoc + , docWrapNode (reLocA lgrhs) $ docForceParSpacing bodyDoc ] -- conservative , docSetParSpacing $ docAddBaseY BrIndentRegular $ docPar @@ -114,7 +115,7 @@ layoutExpr lexpr@(L _ expr) = do , docLit $ Text.pack "->" ] ) - (docWrapNode lgrhs $ docNonBottomSpacing bodyDoc) + (docWrapNode (reLocA lgrhs) $ docNonBottomSpacing bodyDoc) ] HsLam{} -> unknownNodeError "HsLam too complex" lexpr HsLamCase _ (MG _ (L _ []) _) -> do @@ -378,14 +379,14 @@ layoutExpr lexpr@(L _ expr) = do ExplicitTuple _ args boxity -> do let argExprs = args <&> \arg -> case arg of - (L _ (Present _ e)) -> (arg, Just e) - (L _ (Missing NoExtField)) -> (arg, Nothing) + (Present _ e) -> (arg, Just e) + (Missing _) -> (arg, Nothing) argDocs <- forM argExprs $ docSharedWrapper $ \(arg, exprM) -> - docWrapNode arg $ maybe docEmpty layoutExpr exprM + docWrapNode (noLocA arg) $ maybe docEmpty layoutExpr exprM hasComments <- orM (hasCommentsBetween lexpr AnnOpenP AnnCloseP - : map hasAnyCommentsBelow args + : map (hasAnyCommentsBelow . noLocA) args ) let (openLit, closeLit) = case boxity of @@ -758,7 +759,7 @@ layoutExpr lexpr@(L _ expr) = do _ -> do -- TODO unknownNodeError "HsDo{} unknown stmtCtx" lexpr - ExplicitList _ _ elems@(_ : _) -> do + ExplicitList _ elems@(_ : _) -> do elemDocs <- elems `forM` docSharedWrapper layoutExpr hasComments <- hasAnyCommentsBelow lexpr case splitFirstLast elemDocs of @@ -800,12 +801,12 @@ layoutExpr lexpr@(L _ expr) = do [docCommaSep, docNodeAnnKW lexpr (Just AnnOpenS) eN] end = docLit $ Text.pack "]" in docSetBaseY $ docLines $ [start] ++ linesM ++ [lineN] ++ [end] - ExplicitList _ _ [] -> docLit $ Text.pack "[]" + ExplicitList _ [] -> docLit $ Text.pack "[]" RecordCon _ lname fields -> case fields of HsRecFields fs Nothing -> do let nameDoc = docWrapNode lname $ docLit $ lrdrNameToText lname rFs <- - fs `forM` \lfield@(L _ (HsRecField (L _ fieldOcc) rFExpr pun)) -> do + fs `forM` \lfield@(L _ (HsRecField _ (L _ fieldOcc) rFExpr pun)) -> do let FieldOcc _ lnameF = fieldOcc rFExpDoc <- if pun then return Nothing @@ -818,7 +819,7 @@ layoutExpr lexpr@(L _ expr) = do HsRecFields fs@(_ : _) (Just (L _ dotdoti)) | dotdoti == length fs -> do let nameDoc = docWrapNode lname $ docLit $ lrdrNameToText lname fieldDocs <- - fs `forM` \fieldl@(L _ (HsRecField (L _ fieldOcc) fExpr pun)) -> do + fs `forM` \fieldl@(L _ (HsRecField _ (L _ fieldOcc) fExpr pun)) -> do let FieldOcc _ lnameF = fieldOcc fExpDoc <- if pun then return Nothing @@ -826,10 +827,10 @@ layoutExpr lexpr@(L _ expr) = do return (fieldl, lrdrNameToText lnameF, fExpDoc) recordExpression True indentPolicy lexpr nameDoc fieldDocs _ -> unknownNodeError "RecordCon with puns" lexpr - RecordUpd _ rExpr fields -> do + RecordUpd _ rExpr (Left fields) -> do rExprDoc <- docSharedWrapper layoutExpr rExpr rFs <- - fields `forM` \lfield@(L _ (HsRecField (L _ ambName) rFExpr pun)) -> do + fields `forM` \lfield@(L _ (HsRecField _ (L _ ambName) rFExpr pun)) -> do rFExpDoc <- if pun then return Nothing else Just <$> docSharedWrapper layoutExpr rFExpr @@ -837,7 +838,11 @@ layoutExpr lexpr@(L _ expr) = do Unambiguous _ n -> (lfield, lrdrNameToText n, rFExpDoc) Ambiguous _ n -> (lfield, lrdrNameToText n, rFExpDoc) recordExpression False indentPolicy lexpr rExprDoc rFs - ExprWithTySig _ exp1 (HsWC _ (HsIB _ typ1)) -> do + RecordUpd _ _rExpr (Right _projections) -> do + -- TODO + briDocByExactInlineOnly "RecordUpd _ _ (Right _projections)" lexpr + + ExprWithTySig _ exp1 (HsWC _ (L _ (HsSig _ _ typ1))) -> do expDoc <- docSharedWrapper layoutExpr exp1 typDoc <- docSharedWrapper layoutType typ1 docSeq [appSep expDoc, appSep $ docLit $ Text.pack "::", typDoc] @@ -925,14 +930,21 @@ layoutExpr lexpr@(L _ expr) = do HsPragE{} -> do -- TODO briDocByExactInlineOnly "HsPragE{}" lexpr + HsGetField{} -> do + -- TODO + briDocByExactInlineOnly "HsGetField{}" lexpr + HsProjection{} -> do + -- TODO + briDocByExactInlineOnly "HsProjection{}" lexpr + recordExpression :: (Data.Data.Data lExpr, Data.Data.Data name) => Bool -> IndentPolicy - -> GenLocated SrcSpan lExpr + -> LocatedAn an1 lExpr -> ToBriDocM BriDocNumbered - -> [ ( GenLocated SrcSpan name + -> [ ( LocatedAn an2 name , Text , Maybe (ToBriDocM BriDocNumbered) ) @@ -1073,14 +1085,14 @@ litBriDoc = \case HsInt64Prim (SourceText t) _i -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ show i HsWord64Prim (SourceText t) _i -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ show i HsInteger (SourceText t) _i _type -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ show i - HsRat _ (FL (SourceText t) _ _) _type -> BDFLit $ Text.pack t - HsFloatPrim _ (FL (SourceText t) _ _) -> BDFLit $ Text.pack t - HsDoublePrim _ (FL (SourceText t) _ _) -> BDFLit $ Text.pack t + HsRat _ (FL (SourceText t) _ _ _ _) _type -> BDFLit $ Text.pack t + HsFloatPrim _ (FL (SourceText t) _ _ _ _) -> BDFLit $ Text.pack t + HsDoublePrim _ (FL (SourceText t) _ _ _ _) -> BDFLit $ Text.pack t _ -> error "litBriDoc: literal with no SourceText" overLitValBriDoc :: OverLitVal -> BriDocFInt overLitValBriDoc = \case HsIntegral (IL (SourceText t) _ _) -> BDFLit $ Text.pack t - HsFractional (FL (SourceText t) _ _) -> BDFLit $ Text.pack t + HsFractional (FL (SourceText t) _ _ _ _) -> BDFLit $ Text.pack t HsIsString (SourceText t) _ -> BDFLit $ Text.pack t _ -> error "overLitValBriDoc: literal with no SourceText" diff --git a/source/library/Language/Haskell/Brittany/Internal/Layouters/Expr.hs-boot b/source/library/Language/Haskell/Brittany/Internal/Layouters/Expr.hs-boot index 93f9286..0ffc39e 100644 --- a/source/library/Language/Haskell/Brittany/Internal/Layouters/Expr.hs-boot +++ b/source/library/Language/Haskell/Brittany/Internal/Layouters/Expr.hs-boot @@ -7,9 +7,7 @@ import Language.Haskell.Brittany.Internal.Types -layoutExpr :: ToBriDoc an HsExpr - --- layoutStmt :: ToBriDoc' (StmtLR GhcPs GhcPs (LHsExpr GhcPs)) +layoutExpr :: ToBriDoc AnnListItem HsExpr litBriDoc :: HsLit GhcPs -> BriDocFInt