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

@@ -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

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
 
 ----------------------------------------------------------------------------

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 ->

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

tests/Ormolu/OpTreeSpec.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 module Ormolu.OpTreeSpec (spec) where