From 39db791bf31a90931589ccb5df2ef7b2c3da9443 Mon Sep 17 00:00:00 2001 From: Alexander Esgen Date: Tue, 8 Aug 2023 19:34:03 +0200 Subject: [PATCH] Remove usage of `head`/`tail` (deprecated in GHC 9.8) Main occurrence is the operator tree code. This commit changes OpBranches [OpTree ty op] [op] to OpBranches (NonEmpty (OpTree ty op)) [op] such that the calls to `head`/`tail`/`last` can then be replaced by pattern matching on `:|` or by using the total replacements from `Data.List.NonEmpty`. Still, we need to call `NE.fromList` twice. `OverloadedLists` is only used in the tests; as it is otherwise too easy to accidentally write `[] :: NonEmpty a` without any warning. Alternatives to this commit are: - Just do the absolute minimal changes required to silence the warnings (ie basically inline `head`/`tail`). - Rewrite the operator tree code even further (maybe using more precise types) such that the `NE.fromList` are not necessary anymore. --- src/Ormolu/Printer/Meat/Declaration/OpTree.hs | 30 ++++++-------- src/Ormolu/Printer/Meat/Declaration/Value.hs | 10 ++--- src/Ormolu/Printer/Meat/Type.hs | 2 +- src/Ormolu/Printer/Operators.hs | 41 +++++++++++-------- tests/Ormolu/OpTreeSpec.hs | 1 + 5 files changed, 41 insertions(+), 43 deletions(-) diff --git a/src/Ormolu/Printer/Meat/Declaration/OpTree.hs b/src/Ormolu/Printer/Meat/Declaration/OpTree.hs index 0d53f0f..c3f46ed 100644 --- a/src/Ormolu/Printer/Meat/Declaration/OpTree.hs +++ b/src/Ormolu/Printer/Meat/Declaration/OpTree.hs @@ -15,6 +15,8 @@ module Ormolu.Printer.Meat.Declaration.OpTree where import Data.Functor ((<&>)) +import Data.List.NonEmpty (NonEmpty (..)) +import Data.List.NonEmpty qualified as NE import GHC.Hs import GHC.Types.Fixity import GHC.Types.Name (occNameString) @@ -81,7 +83,7 @@ opBranchBraceStyle placement = -- | Convert a 'LHsExpr' containing an operator tree to the 'OpTree' -- intermediate representation. exprOpTree :: LHsExpr GhcPs -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) -exprOpTree (L _ (OpApp _ x op y)) = OpBranches [exprOpTree x, exprOpTree y] [op] +exprOpTree (L _ (OpApp _ x op y)) = BinaryOpBranches (exprOpTree x) op (exprOpTree y) exprOpTree n = OpNode n -- | Print an operator tree where leaves are values. @@ -93,17 +95,15 @@ p_exprOpTree :: OpTree (LHsExpr GhcPs) (OpInfo (LHsExpr GhcPs)) -> R () p_exprOpTree s (OpNode x) = located x (p_hsExpr' NotApplicand s) -p_exprOpTree s t@(OpBranches exprs ops) = do - let firstExpr = head exprs - otherExprs = tail exprs - placement = +p_exprOpTree s t@(OpBranches exprs@(firstExpr :| otherExprs) ops) = do + let placement = opBranchPlacement exprPlacement firstExpr (last otherExprs) rightMostNode = \case n@(OpNode _) -> n - OpBranches exprs'' _ -> rightMostNode (last exprs'') + OpBranches exprs'' _ -> rightMostNode (NE.last exprs'') isDoBlock = \case OpNode (L _ (HsDo _ ctx _)) -> case ctx of DoExpr _ -> True @@ -127,7 +127,7 @@ p_exprOpTree s t@(OpBranches exprs ops) = do && not (isDoBlock $ rightMostNode prevExpr) -- If all operators at the current level match the conditions to be -- trailing, then put them in a trailing position - isTrailing = all couldBeTrailing $ zip exprs ops + isTrailing = all couldBeTrailing $ zip (NE.toList exprs) ops ub <- if isTrailing then return useBraces else opBranchBraceStyle placement let p_x = ub $ p_exprOpTree s firstExpr putOpsExprs prevExpr (opi : ops') (expr : exprs') = do @@ -171,7 +171,7 @@ p_exprOpTree s t@(OpBranches exprs ops) = do cmdOpTree :: LHsCmdTop GhcPs -> OpTree (LHsCmdTop GhcPs) (LHsExpr GhcPs) cmdOpTree = \case (L _ (HsCmdTop _ (L _ (HsCmdArrForm _ op Infix _ [x, y])))) -> - OpBranches [cmdOpTree x, cmdOpTree y] [op] + BinaryOpBranches (cmdOpTree x) op (cmdOpTree y) n -> OpNode n -- | Print an operator tree where leaves are commands. @@ -183,10 +183,8 @@ p_cmdOpTree :: OpTree (LHsCmdTop GhcPs) (OpInfo (LHsExpr GhcPs)) -> R () p_cmdOpTree s (OpNode x) = located x (p_hsCmdTop s) -p_cmdOpTree s t@(OpBranches exprs ops) = do - let firstExpr = head exprs - otherExprs = tail exprs - placement = +p_cmdOpTree s t@(OpBranches (firstExpr :| otherExprs) ops) = do + let placement = opBranchPlacement cmdTopPlacement firstExpr @@ -218,7 +216,7 @@ tyOpPlacement = \case -- intermediate representation. tyOpTree :: LHsType GhcPs -> OpTree (LHsType GhcPs) (LocatedN RdrName) tyOpTree (L _ (HsOpTy _ _ l op r)) = - OpBranches [tyOpTree l, tyOpTree r] [op] + BinaryOpBranches (tyOpTree l) op (tyOpTree r) tyOpTree n = OpNode n -- | Print an operator tree where leaves are types. @@ -228,10 +226,8 @@ p_tyOpTree :: OpTree (LHsType GhcPs) (OpInfo (LocatedN RdrName)) -> R () p_tyOpTree (OpNode n) = located n p_hsType -p_tyOpTree t@(OpBranches exprs ops) = do - let firstExpr = head exprs - otherExprs = tail exprs - placement = +p_tyOpTree t@(OpBranches (firstExpr :| otherExprs) ops) = do + let placement = opBranchPlacement tyOpPlacement firstExpr diff --git a/src/Ormolu/Printer/Meat/Declaration/Value.hs b/src/Ormolu/Printer/Meat/Declaration/Value.hs index a0507b8..c0cdc04 100644 --- a/src/Ormolu/Printer/Meat/Declaration/Value.hs +++ b/src/Ormolu/Printer/Meat/Declaration/Value.hs @@ -347,7 +347,7 @@ p_hsCmd' isApp s = \case inci (sequence_ (intersperse breakpoint (located' (p_hsCmdTop N) <$> cmds))) HsCmdArrForm _ form Infix _ [left, right] -> do modFixityMap <- askModuleFixityMap - let opTree = OpBranches [cmdOpTree left, cmdOpTree right] [form] + let opTree = BinaryOpBranches (cmdOpTree left) form (cmdOpTree right) p_cmdOpTree s (reassociateOpTree (getOpName . unLoc) modFixityMap opTree) @@ -678,7 +678,7 @@ p_hsExpr' isApp s = \case located (hswc_body a) p_hsType OpApp _ x op y -> do modFixityMap <- askModuleFixityMap - let opTree = OpBranches [exprOpTree x, exprOpTree y] [op] + let opTree = BinaryOpBranches (exprOpTree x) op (exprOpTree y) p_exprOpTree s (reassociateOpTree (getOpName . unLoc) modFixityMap opTree) @@ -1221,11 +1221,7 @@ p_stringLit src = -- Attaches previous and next items to each list element zipPrevNext :: [a] -> [(Maybe a, a, Maybe a)] zipPrevNext xs = - let z = - zip - (zip (Nothing : map Just xs) xs) - (map Just (tail xs) ++ repeat Nothing) - in map (\((p, x), n) -> (p, x, n)) z + zip3 (Nothing : map Just xs) xs (map Just (drop 1 xs) ++ [Nothing]) orig (_, x, _) = x ---------------------------------------------------------------------------- diff --git a/src/Ormolu/Printer/Meat/Type.hs b/src/Ormolu/Printer/Meat/Type.hs index e6e7b5b..818f60e 100644 --- a/src/Ormolu/Printer/Meat/Type.hs +++ b/src/Ormolu/Printer/Meat/Type.hs @@ -111,7 +111,7 @@ p_hsType' multilineArgs = \case sep (space >> txt "|" >> breakpoint) (sitcc . located' p_hsType) xs HsOpTy _ _ x op y -> do modFixityMap <- askModuleFixityMap - let opTree = OpBranches [tyOpTree x, tyOpTree y] [op] + let opTree = BinaryOpBranches (tyOpTree x) op (tyOpTree y) p_tyOpTree (reassociateOpTree (Just . unLoc) modFixityMap opTree) HsParTy _ t -> diff --git a/src/Ormolu/Printer/Operators.hs b/src/Ormolu/Printer/Operators.hs index 362a330..6f881db 100644 --- a/src/Ormolu/Printer/Operators.hs +++ b/src/Ormolu/Printer/Operators.hs @@ -1,9 +1,11 @@ {-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE PatternSynonyms #-} -- | This module helps handle operator chains composed of different -- operators that may have different precedence and fixities. module Ormolu.Printer.Operators ( OpTree (..), + pattern BinaryOpBranches, OpInfo (..), opTreeLoc, reassociateOpTree, @@ -11,6 +13,7 @@ module Ormolu.Printer.Operators ) where +import Data.List.NonEmpty (NonEmpty (..)) import Data.List.NonEmpty qualified as NE import GHC.Types.Name.Reader import GHC.Types.SrcLoc @@ -31,9 +34,12 @@ data OpTree ty op | -- | A subtree of operator application(s); the invariant is: @length -- exprs == length ops + 1@. @OpBranches [x, y, z] [op1, op2]@ -- represents the expression @x op1 y op2 z@. - OpBranches [OpTree ty op] [op] + OpBranches (NonEmpty (OpTree ty op)) [op] deriving (Eq, Show) +pattern BinaryOpBranches :: OpTree ty op -> op -> OpTree ty op -> OpTree ty op +pattern BinaryOpBranches x op y = OpBranches (x :| [y]) [op] + -- | Wrapper for an operator, carrying information about its name and -- fixity. data OpInfo op = OpInfo @@ -78,7 +84,7 @@ compareOp opTreeLoc :: (HasSrcSpan l) => OpTree (GenLocated l a) b -> SrcSpan opTreeLoc (OpNode n) = getLoc' n opTreeLoc (OpBranches exprs _) = - combineSrcSpans' . NE.fromList . fmap opTreeLoc $ exprs + combineSrcSpans' . fmap opTreeLoc $ exprs -- | Re-associate an 'OpTree' taking into account precedence of operators. -- Users are expected to first construct an initial 'OpTree', then @@ -129,11 +135,11 @@ makeFlatOpTree (OpBranches exprs ops) = OpBranches rExprs rOps where makeFlatOpTree' expr = case makeFlatOpTree expr of - OpNode n -> ([OpNode n], []) + OpNode n -> (NE.singleton (OpNode n), []) OpBranches noptExprs noptOps -> (noptExprs, noptOps) flattenedSubTrees = makeFlatOpTree' <$> exprs - rExprs = concatMap fst flattenedSubTrees - rOps = concat $ interleave (snd <$> flattenedSubTrees) (pure <$> ops) + rExprs = fst =<< flattenedSubTrees + rOps = concat $ interleave (snd <$> NE.toList flattenedSubTrees) (pure <$> ops) interleave (x : xs) (y : ys) = x : y : interleave xs ys interleave [] ys = ys interleave xs [] = xs @@ -239,7 +245,7 @@ reassociateFlatOpTree tree@(OpBranches noptExprs noptOps) = -- [ex0 op0 ex1 op1 ex2 op2 ex3 op3 ex4 op4 ex5 op5 ex6 op6 ex7] -- into -- [ex0 op0 [ex1 op1 ex2] op2 [ex3 op3 ex4 op4 ex5] op5 [ex6 op6 ex7]] - splitTree nExprs nOps indices = go nExprs nOps indices 0 [] [] [] [] + splitTree nExprs nOps indices = go (NE.toList nExprs) nOps indices 0 [] [] [] [] where go :: -- Remaining exprs to look up @@ -267,15 +273,15 @@ reassociateFlatOpTree tree@(OpBranches noptExprs noptOps) = -- expr in the subExprs bag, so we build a subtree (if necessary) -- with sub-bags, add the node/subtree to the result bag, and then -- emit the result tree - let resExpr = buildFromSub subExprs subOps - in OpBranches (reverse (resExpr : resExprs)) (reverse resOps) + let resExpr = buildFromSub (NE.fromList subExprs) subOps + in OpBranches (NE.reverse (resExpr :| resExprs)) (reverse resOps) go (x : xs) (o : os) (idx : idxs) i subExprs subOps resExprs resOps | i == idx = -- The op we are looking at is one on which we need to split. -- So we build a subtree from the sub-bags and the current -- expr, append it to the result exprs, and continue with -- cleared sub-bags - let resExpr = buildFromSub (x : subExprs) subOps + let resExpr = buildFromSub (x :| subExprs) subOps in go xs os idxs (i + 1) [] [] (resExpr : resExprs) (o : resOps) go (x : xs) ops idxs i subExprs subOps resExprs resOps = -- Either there is no op left, or the op we are looking at is not @@ -288,7 +294,7 @@ reassociateFlatOpTree tree@(OpBranches noptExprs noptOps) = -- [ex0 op0 ex1 op1 ex2 op2 ex3 op3 ex4 op4 ex5 op5 ex6 op6 ex7] -- into -- [[ex0 op0 ex1 op1 ex2] op2 ex3 op3 [ex4 op4 ex5] op5 ex6 op6 ex7] - groupTree nExprs nOps indices = go nExprs nOps indices 0 [] [] [] [] + groupTree nExprs nOps indices = go (NE.toList nExprs) nOps indices 0 [] [] [] [] where go :: -- remaining exprs to look up @@ -316,11 +322,10 @@ reassociateFlatOpTree tree@(OpBranches noptExprs noptOps) = -- empty. If it is not, we build a subtree (if necessary) with -- sub-bags and add the resulting node/subtree to the result bag. -- In any case, we then emit the result tree - let resExprs' = - if null subExprs - then resExprs - else buildFromSub subExprs subOps : resExprs - in OpBranches (reverse resExprs') (reverse resOps) + let resExprs' = case NE.nonEmpty subExprs of + Nothing -> NE.fromList resExprs + Just subExprs' -> buildFromSub subExprs' subOps :| resExprs + in OpBranches (NE.reverse resExprs') (reverse resOps) go (x : xs) (o : os) (idx : idxs) i subExprs subOps resExprs resOps | i == idx = -- The op we are looking at is one on which we need to group. @@ -333,7 +338,7 @@ reassociateFlatOpTree tree@(OpBranches noptExprs noptOps) = -- the current expr, to form a subtree which is then added to the -- result bag. let (ops', resOps') = moveOneIfPossible ops resOps - resExpr = buildFromSub (x : subExprs) subOps + resExpr = buildFromSub (x :| subExprs) subOps in go xs ops' idxs (i + 1) [] [] (resExpr : resExprs) resOps' go (x : xs) ops idxs i [] subOps resExprs resOps = -- Either there is no op left, or the op we are looking at is not @@ -349,8 +354,8 @@ reassociateFlatOpTree tree@(OpBranches noptExprs noptOps) = buildFromSub subExprs subOps = reassociateFlatOpTree $ case subExprs of -- Do not build a subtree when the potential subtree would have -- 1 expr(s) and 0 op(s) - [x] -> x - _ -> OpBranches (reverse subExprs) (reverse subOps) + x :| [] -> x + _ -> OpBranches (NE.reverse subExprs) (reverse subOps) -- | Indicate if an operator has @'InfixR' 0@ fixity. We special-case this -- class of operators because they often have, like ('$'), a specific diff --git a/tests/Ormolu/OpTreeSpec.hs b/tests/Ormolu/OpTreeSpec.hs index fd66eeb..3df9c06 100644 --- a/tests/Ormolu/OpTreeSpec.hs +++ b/tests/Ormolu/OpTreeSpec.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-} module Ormolu.OpTreeSpec (spec) where