{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | This module helps handle operator chains composed of different
-- operators that may have different precedence and fixities.
module Ormolu.Printer.Operators
  ( OpTree (..),
    opTreeLoc,
    reassociateOpTree,
  )
where

import BasicTypes (Fixity (..), SourceText (NoSourceText), compareFixity, defaultFixity)
import Data.Function (on)
import Data.List
import Data.Maybe (fromMaybe, mapMaybe)
import Data.Ord (Down (Down), comparing)
import GHC
import OccName (mkVarOcc)
import Ormolu.Utils (unSrcSpan)
import RdrName (mkRdrUnqual)
import SrcLoc (combineSrcSpans)

-- | Intermediate representation of operator trees. It has two type
-- parameters: @ty@ is the type of sub-expressions, while @op@ is the type
-- of operators.
data OpTree ty op
  = OpNode ty
  | OpBranch
      (OpTree ty op)
      op
      (OpTree ty op)

-- | Return combined 'SrcSpan's of all elements in this 'OpTree'.
opTreeLoc :: OpTree (Located a) b -> SrcSpan
opTreeLoc :: OpTree (Located a) b -> SrcSpan
opTreeLoc (OpNode (L l :: SrcSpan
l _)) = SrcSpan
l
opTreeLoc (OpBranch l :: OpTree (Located a) b
l _ r :: OpTree (Located a) b
r) = SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans (OpTree (Located a) b -> SrcSpan
forall a b. OpTree (Located a) b -> SrcSpan
opTreeLoc OpTree (Located a) b
l) (OpTree (Located a) b -> SrcSpan
forall a b. OpTree (Located a) b -> SrcSpan
opTreeLoc OpTree (Located a) b
r)

-- | Re-associate an 'OpTree' taking into account automagically inferred
-- relative precedence of operators. Users are expected to first construct
-- an initial 'OpTree', then re-associate it using this function before
-- printing.
reassociateOpTree ::
  -- | How to get name of an operator
  (op -> Maybe RdrName) ->
  -- | Original 'OpTree'
  OpTree (Located ty) (Located op) ->
  -- | Re-associated 'OpTree'
  OpTree (Located ty) (Located op)
reassociateOpTree :: (op -> Maybe RdrName)
-> OpTree (Located ty) (Located op)
-> OpTree (Located ty) (Located op)
reassociateOpTree getOpName :: op -> Maybe RdrName
getOpName opTree :: OpTree (Located ty) (Located op)
opTree =
  [(RdrName, Fixity)]
-> (Located op -> Maybe RdrName)
-> OpTree (Located ty) (Located op)
-> OpTree (Located ty) (Located op)
forall ty op.
[(RdrName, Fixity)]
-> (op -> Maybe RdrName) -> OpTree ty op -> OpTree ty op
reassociateOpTreeWith
    ((op -> Maybe RdrName)
-> OpTree (Located ty) (Located op) -> [(RdrName, Fixity)]
forall ty op.
(op -> Maybe RdrName)
-> OpTree (Located ty) (Located op) -> [(RdrName, Fixity)]
buildFixityMap op -> Maybe RdrName
getOpName OpTree (Located ty) (Located op)
normOpTree)
    (op -> Maybe RdrName
getOpName (op -> Maybe RdrName)
-> (Located op -> op) -> Located op -> Maybe RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located op -> op
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc)
    OpTree (Located ty) (Located op)
normOpTree
  where
    normOpTree :: OpTree (Located ty) (Located op)
normOpTree = OpTree (Located ty) (Located op)
-> OpTree (Located ty) (Located op)
forall ty op. OpTree ty op -> OpTree ty op
normalizeOpTree OpTree (Located ty) (Located op)
opTree

-- | Re-associate an 'OpTree' given the map with operator fixities.
reassociateOpTreeWith ::
  forall ty op.
  -- | Fixity map for operators
  [(RdrName, Fixity)] ->
  -- | How to get the name of an operator
  (op -> Maybe RdrName) ->
  -- | Original 'OpTree'
  OpTree ty op ->
  -- | Re-associated 'OpTree'
  OpTree ty op
reassociateOpTreeWith :: [(RdrName, Fixity)]
-> (op -> Maybe RdrName) -> OpTree ty op -> OpTree ty op
reassociateOpTreeWith fixityMap :: [(RdrName, Fixity)]
fixityMap getOpName :: op -> Maybe RdrName
getOpName = OpTree ty op -> OpTree ty op
go
  where
    fixityOf :: op -> Fixity
    fixityOf :: op -> Fixity
fixityOf op :: op
op = Fixity -> Maybe Fixity -> Fixity
forall a. a -> Maybe a -> a
fromMaybe Fixity
defaultFixity (Maybe Fixity -> Fixity) -> Maybe Fixity -> Fixity
forall a b. (a -> b) -> a -> b
$ do
      RdrName
opName <- op -> Maybe RdrName
getOpName op
op
      RdrName -> [(RdrName, Fixity)] -> Maybe Fixity
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup RdrName
opName [(RdrName, Fixity)]
fixityMap
    -- Here, left branch is already associated and the root alongside with
    -- the right branch is right-associated. This function picks up one item
    -- from the right and inserts it correctly to the left.
    --
    -- Also, we are using the 'compareFixity' function which returns if the
    -- expression should associate to right.
    go :: OpTree ty op -> OpTree ty op
    -- base cases
    go :: OpTree ty op -> OpTree ty op
go t :: OpTree ty op
t@(OpNode _) = OpTree ty op
t
    go t :: OpTree ty op
t@(OpBranch (OpNode _) _ (OpNode _)) = OpTree ty op
t
    -- shift one operator to the left at the beginning
    go (OpBranch l :: OpTree ty op
l@(OpNode _) op :: op
op (OpBranch l' :: OpTree ty op
l' op' :: op
op' r' :: OpTree ty op
r')) =
      OpTree ty op -> OpTree ty op
go (OpTree ty op -> op -> OpTree ty op -> OpTree ty op
forall ty op. OpTree ty op -> op -> OpTree ty op -> OpTree ty op
OpBranch (OpTree ty op -> op -> OpTree ty op -> OpTree ty op
forall ty op. OpTree ty op -> op -> OpTree ty op -> OpTree ty op
OpBranch OpTree ty op
l op
op OpTree ty op
l') op
op' OpTree ty op
r')
    -- at the last operator, place the operator and don't recurse
    go (OpBranch (OpBranch l :: OpTree ty op
l op :: op
op r :: OpTree ty op
r) op' :: op
op' r' :: OpTree ty op
r'@(OpNode _)) =
      if (Bool, Bool) -> Bool
forall a b. (a, b) -> b
snd ((Bool, Bool) -> Bool) -> (Bool, Bool) -> Bool
forall a b. (a -> b) -> a -> b
$ Fixity -> Fixity -> (Bool, Bool)
compareFixity (op -> Fixity
fixityOf op
op) (op -> Fixity
fixityOf op
op')
        then OpTree ty op -> op -> OpTree ty op -> OpTree ty op
forall ty op. OpTree ty op -> op -> OpTree ty op -> OpTree ty op
OpBranch OpTree ty op
l op
op (OpTree ty op -> OpTree ty op
go (OpTree ty op -> OpTree ty op) -> OpTree ty op -> OpTree ty op
forall a b. (a -> b) -> a -> b
$ OpTree ty op -> op -> OpTree ty op -> OpTree ty op
forall ty op. OpTree ty op -> op -> OpTree ty op -> OpTree ty op
OpBranch OpTree ty op
r op
op' OpTree ty op
r')
        else OpTree ty op -> op -> OpTree ty op -> OpTree ty op
forall ty op. OpTree ty op -> op -> OpTree ty op -> OpTree ty op
OpBranch (OpTree ty op -> op -> OpTree ty op -> OpTree ty op
forall ty op. OpTree ty op -> op -> OpTree ty op -> OpTree ty op
OpBranch OpTree ty op
l op
op OpTree ty op
r) op
op' OpTree ty op
r'
    -- else, shift one operator to left and recurse.
    go (OpBranch (OpBranch l :: OpTree ty op
l op :: op
op r :: OpTree ty op
r) op' :: op
op' (OpBranch l' :: OpTree ty op
l' op'' :: op
op'' r' :: OpTree ty op
r')) =
      if (Bool, Bool) -> Bool
forall a b. (a, b) -> b
snd ((Bool, Bool) -> Bool) -> (Bool, Bool) -> Bool
forall a b. (a -> b) -> a -> b
$ Fixity -> Fixity -> (Bool, Bool)
compareFixity (op -> Fixity
fixityOf op
op) (op -> Fixity
fixityOf op
op')
        then OpTree ty op -> OpTree ty op
go (OpTree ty op -> OpTree ty op) -> OpTree ty op -> OpTree ty op
forall a b. (a -> b) -> a -> b
$ OpTree ty op -> op -> OpTree ty op -> OpTree ty op
forall ty op. OpTree ty op -> op -> OpTree ty op -> OpTree ty op
OpBranch (OpTree ty op -> op -> OpTree ty op -> OpTree ty op
forall ty op. OpTree ty op -> op -> OpTree ty op -> OpTree ty op
OpBranch OpTree ty op
l op
op (OpTree ty op -> OpTree ty op
go (OpTree ty op -> OpTree ty op) -> OpTree ty op -> OpTree ty op
forall a b. (a -> b) -> a -> b
$ OpTree ty op -> op -> OpTree ty op -> OpTree ty op
forall ty op. OpTree ty op -> op -> OpTree ty op -> OpTree ty op
OpBranch OpTree ty op
r op
op' OpTree ty op
l')) op
op'' OpTree ty op
r'
        else OpTree ty op -> OpTree ty op
go (OpTree ty op -> OpTree ty op) -> OpTree ty op -> OpTree ty op
forall a b. (a -> b) -> a -> b
$ OpTree ty op -> op -> OpTree ty op -> OpTree ty op
forall ty op. OpTree ty op -> op -> OpTree ty op -> OpTree ty op
OpBranch (OpTree ty op -> op -> OpTree ty op -> OpTree ty op
forall ty op. OpTree ty op -> op -> OpTree ty op -> OpTree ty op
OpBranch (OpTree ty op -> op -> OpTree ty op -> OpTree ty op
forall ty op. OpTree ty op -> op -> OpTree ty op -> OpTree ty op
OpBranch OpTree ty op
l op
op OpTree ty op
r) op
op' OpTree ty op
l') op
op'' OpTree ty op
r'

-- | Build a map of inferred 'Fixity's from an 'OpTree'.
buildFixityMap ::
  forall ty op.
  -- | How to get the name of an operator
  (op -> Maybe RdrName) ->
  -- | Operator tree
  OpTree (Located ty) (Located op) ->
  -- | Fixity map
  [(RdrName, Fixity)]
buildFixityMap :: (op -> Maybe RdrName)
-> OpTree (Located ty) (Located op) -> [(RdrName, Fixity)]
buildFixityMap getOpName :: op -> Maybe RdrName
getOpName opTree :: OpTree (Located ty) (Located op)
opTree =
  ((Int, [(RdrName, Double)]) -> [(RdrName, Fixity)])
-> [(Int, [(RdrName, Double)])] -> [(RdrName, Fixity)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(i :: Int
i, ns :: [(RdrName, Double)]
ns) -> ((RdrName, Double) -> (RdrName, Fixity))
-> [(RdrName, Double)] -> [(RdrName, Fixity)]
forall a b. (a -> b) -> [a] -> [b]
map (\(n :: RdrName
n, _) -> (RdrName
n, Int -> FixityDirection -> Fixity
fixity Int
i FixityDirection
InfixL)) [(RdrName, Double)]
ns)
    ([(Int, [(RdrName, Double)])] -> [(RdrName, Fixity)])
-> ([(RdrName, Double)] -> [(Int, [(RdrName, Double)])])
-> [(RdrName, Double)]
-> [(RdrName, Fixity)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [[(RdrName, Double)]] -> [(Int, [(RdrName, Double)])]
forall a b. [a] -> [b] -> [(a, b)]
zip [0 ..]
    ([[(RdrName, Double)]] -> [(Int, [(RdrName, Double)])])
-> ([(RdrName, Double)] -> [[(RdrName, Double)]])
-> [(RdrName, Double)]
-> [(Int, [(RdrName, Double)])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((RdrName, Double) -> (RdrName, Double) -> Bool)
-> [(RdrName, Double)] -> [[(RdrName, Double)]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (Double -> Double -> Double -> Bool
doubleWithinEps 0.00001 (Double -> Double -> Bool)
-> ((RdrName, Double) -> Double)
-> (RdrName, Double)
-> (RdrName, Double)
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (RdrName, Double) -> Double
forall a b. (a, b) -> b
snd)
    ([(RdrName, Double)] -> [[(RdrName, Double)]])
-> ([(RdrName, Double)] -> [(RdrName, Double)])
-> [(RdrName, Double)]
-> [[(RdrName, Double)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(RdrName, Double)]
overrides [(RdrName, Double)] -> [(RdrName, Double)] -> [(RdrName, Double)]
forall a. [a] -> [a] -> [a]
++)
    ([(RdrName, Double)] -> [(RdrName, Double)])
-> ([(RdrName, Double)] -> [(RdrName, Double)])
-> [(RdrName, Double)]
-> [(RdrName, Double)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(RdrName, Double)] -> [(RdrName, Double)]
modeScores
    ([(RdrName, Double)] -> [(RdrName, Fixity)])
-> [(RdrName, Double)] -> [(RdrName, Fixity)]
forall a b. (a -> b) -> a -> b
$ OpTree (Located ty) (Located op) -> [(RdrName, Double)]
score OpTree (Located ty) (Located op)
opTree
  where
    -- Add a special case for ($), since it is pretty unlikely for someone
    -- to override it.
    overrides :: [(RdrName, Double)]
    overrides :: [(RdrName, Double)]
overrides =
      [ (OccName -> RdrName
mkRdrUnqual (OccName -> RdrName) -> OccName -> RdrName
forall a b. (a -> b) -> a -> b
$ String -> OccName
mkVarOcc "$", -1)
      ]
    -- Assign scores to operators based on their location in the source.
    score :: OpTree (Located ty) (Located op) -> [(RdrName, Double)]
    score :: OpTree (Located ty) (Located op) -> [(RdrName, Double)]
score (OpNode _) = []
    score (OpBranch l :: OpTree (Located ty) (Located op)
l o :: Located op
o r :: OpTree (Located ty) (Located op)
r) = [(RdrName, Double)]
-> Maybe [(RdrName, Double)] -> [(RdrName, Double)]
forall a. a -> Maybe a -> a
fromMaybe (OpTree (Located ty) (Located op) -> [(RdrName, Double)]
score OpTree (Located ty) (Located op)
r) (Maybe [(RdrName, Double)] -> [(RdrName, Double)])
-> Maybe [(RdrName, Double)] -> [(RdrName, Double)]
forall a b. (a -> b) -> a -> b
$ do
      -- If we fail to get any of these, 'defaultFixity' will be used by
      -- 'reassociateOpTreeWith'.
      Int
le <- RealSrcSpan -> Int
srcSpanEndLine (RealSrcSpan -> Int) -> Maybe RealSrcSpan -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SrcSpan -> Maybe RealSrcSpan
unSrcSpan (OpTree (Located ty) (Located op) -> SrcSpan
forall a b. OpTree (Located a) b -> SrcSpan
opTreeLoc OpTree (Located ty) (Located op)
l) -- left end
      Int
ob <- RealSrcSpan -> Int
srcSpanStartLine (RealSrcSpan -> Int) -> Maybe RealSrcSpan -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SrcSpan -> Maybe RealSrcSpan
unSrcSpan (Located op -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc Located op
o) -- operator begin
      Int
oe <- RealSrcSpan -> Int
srcSpanEndLine (RealSrcSpan -> Int) -> Maybe RealSrcSpan -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SrcSpan -> Maybe RealSrcSpan
unSrcSpan (Located op -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc Located op
o) -- operator end
      Int
rb <- RealSrcSpan -> Int
srcSpanStartLine (RealSrcSpan -> Int) -> Maybe RealSrcSpan -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SrcSpan -> Maybe RealSrcSpan
unSrcSpan (OpTree (Located ty) (Located op) -> SrcSpan
forall a b. OpTree (Located a) b -> SrcSpan
opTreeLoc OpTree (Located ty) (Located op)
r) -- right begin
      Int
oc <- RealSrcSpan -> Int
srcSpanStartCol (RealSrcSpan -> Int) -> Maybe RealSrcSpan -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SrcSpan -> Maybe RealSrcSpan
unSrcSpan (Located op -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc Located op
o) -- operator column
      RdrName
opName <- op -> Maybe RdrName
getOpName (Located op -> SrcSpanLess (Located op)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located op
o)
      let s :: Double
s
            | Int
le Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
ob =
              -- if the operator is in the beginning of a line, assign
              -- a score relative to its column within range [0, 1).
              Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
oc Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
maxCol Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)
            | Int
oe Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
rb =
              -- if the operator is in the end of the line, assign the
              -- score 1.
              1
            | Bool
otherwise =
              2 -- otherwise, assign a high score.
      [(RdrName, Double)] -> Maybe [(RdrName, Double)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(RdrName, Double)] -> Maybe [(RdrName, Double)])
-> [(RdrName, Double)] -> Maybe [(RdrName, Double)]
forall a b. (a -> b) -> a -> b
$ (RdrName
opName, Double
s) (RdrName, Double) -> [(RdrName, Double)] -> [(RdrName, Double)]
forall a. a -> [a] -> [a]
: OpTree (Located ty) (Located op) -> [(RdrName, Double)]
score OpTree (Located ty) (Located op)
r
    -- Pick the most common score per 'RdrName'.
    modeScores :: [(RdrName, Double)] -> [(RdrName, Double)]
    modeScores :: [(RdrName, Double)] -> [(RdrName, Double)]
modeScores =
      ((RdrName, Double) -> Double)
-> [(RdrName, Double)] -> [(RdrName, Double)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (RdrName, Double) -> Double
forall a b. (a, b) -> b
snd
        ([(RdrName, Double)] -> [(RdrName, Double)])
-> ([(RdrName, Double)] -> [(RdrName, Double)])
-> [(RdrName, Double)]
-> [(RdrName, Double)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(RdrName, Double)] -> Maybe (RdrName, Double))
-> [[(RdrName, Double)]] -> [(RdrName, Double)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
          ( \case
              [] -> Maybe (RdrName, Double)
forall a. Maybe a
Nothing
              xs :: [(RdrName, Double)]
xs@((n :: RdrName
n, _) : _) -> (RdrName, Double) -> Maybe (RdrName, Double)
forall a. a -> Maybe a
Just (RdrName
n, [Double] -> Double
mode ([Double] -> Double) -> [Double] -> Double
forall a b. (a -> b) -> a -> b
$ ((RdrName, Double) -> Double) -> [(RdrName, Double)] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (RdrName, Double) -> Double
forall a b. (a, b) -> b
snd [(RdrName, Double)]
xs)
          )
        ([[(RdrName, Double)]] -> [(RdrName, Double)])
-> ([(RdrName, Double)] -> [[(RdrName, Double)]])
-> [(RdrName, Double)]
-> [(RdrName, Double)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((RdrName, Double) -> (RdrName, Double) -> Bool)
-> [(RdrName, Double)] -> [[(RdrName, Double)]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (RdrName -> RdrName -> Bool
forall a. Eq a => a -> a -> Bool
(==) (RdrName -> RdrName -> Bool)
-> ((RdrName, Double) -> RdrName)
-> (RdrName, Double)
-> (RdrName, Double)
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (RdrName, Double) -> RdrName
forall a b. (a, b) -> a
fst)
        ([(RdrName, Double)] -> [[(RdrName, Double)]])
-> ([(RdrName, Double)] -> [(RdrName, Double)])
-> [(RdrName, Double)]
-> [[(RdrName, Double)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(RdrName, Double)] -> [(RdrName, Double)]
forall a. Ord a => [a] -> [a]
sort
    -- Return the most common number, leaning to the smaller
    -- one in case of a tie.
    mode :: [Double] -> Double
    mode :: [Double] -> Double
mode =
      [Double] -> Double
forall a. [a] -> a
head
        ([Double] -> Double)
-> ([Double] -> [Double]) -> [Double] -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Double] -> [Double] -> Ordering) -> [[Double]] -> [Double]
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
minimumBy (([Double] -> Down Int) -> [Double] -> [Double] -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Int -> Down Int
forall a. a -> Down a
Down (Int -> Down Int) -> ([Double] -> Int) -> [Double] -> Down Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Double] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length))
        ([[Double]] -> [Double])
-> ([Double] -> [[Double]]) -> [Double] -> [Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Double -> Bool) -> [Double] -> [[Double]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (Double -> Double -> Double -> Bool
doubleWithinEps 0.0001)
        ([Double] -> [[Double]])
-> ([Double] -> [Double]) -> [Double] -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Double] -> [Double]
forall a. Ord a => [a] -> [a]
sort
    -- The start column of the rightmost operator.
    maxCol :: Int
maxCol = OpTree (Located ty) (Located op) -> Int
forall l e e. OpTree (GenLocated l e) (GenLocated SrcSpan e) -> Int
go OpTree (Located ty) (Located op)
opTree
      where
        go :: OpTree (GenLocated l e) (GenLocated SrcSpan e) -> Int
go (OpNode (L _ _)) = 0
        go (OpBranch l :: OpTree (GenLocated l e) (GenLocated SrcSpan e)
l (L o :: SrcSpan
o _) r :: OpTree (GenLocated l e) (GenLocated SrcSpan e)
r) =
          [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum
            [ OpTree (GenLocated l e) (GenLocated SrcSpan e) -> Int
go OpTree (GenLocated l e) (GenLocated SrcSpan e)
l,
              Int -> (RealSrcSpan -> Int) -> Maybe RealSrcSpan -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe 0 RealSrcSpan -> Int
srcSpanStartCol (SrcSpan -> Maybe RealSrcSpan
unSrcSpan SrcSpan
o),
              OpTree (GenLocated l e) (GenLocated SrcSpan e) -> Int
go OpTree (GenLocated l e) (GenLocated SrcSpan e)
r
            ]

----------------------------------------------------------------------------
-- Helpers

-- | Convert an 'OpTree' to with all operators having the same fixity and
-- associativity (left infix).
normalizeOpTree :: OpTree ty op -> OpTree ty op
normalizeOpTree :: OpTree ty op -> OpTree ty op
normalizeOpTree (OpNode n :: ty
n) =
  ty -> OpTree ty op
forall ty op. ty -> OpTree ty op
OpNode ty
n
normalizeOpTree (OpBranch (OpNode l :: ty
l) lop :: op
lop r :: OpTree ty op
r) =
  OpTree ty op -> op -> OpTree ty op -> OpTree ty op
forall ty op. OpTree ty op -> op -> OpTree ty op -> OpTree ty op
OpBranch (ty -> OpTree ty op
forall ty op. ty -> OpTree ty op
OpNode ty
l) op
lop (OpTree ty op -> OpTree ty op
forall ty op. OpTree ty op -> OpTree ty op
normalizeOpTree OpTree ty op
r)
normalizeOpTree (OpBranch (OpBranch l' :: OpTree ty op
l' lop' :: op
lop' r' :: OpTree ty op
r') lop :: op
lop r :: OpTree ty op
r) =
  OpTree ty op -> OpTree ty op
forall ty op. OpTree ty op -> OpTree ty op
normalizeOpTree (OpTree ty op -> op -> OpTree ty op -> OpTree ty op
forall ty op. OpTree ty op -> op -> OpTree ty op -> OpTree ty op
OpBranch OpTree ty op
l' op
lop' (OpTree ty op -> op -> OpTree ty op -> OpTree ty op
forall ty op. OpTree ty op -> op -> OpTree ty op -> OpTree ty op
OpBranch OpTree ty op
r' op
lop OpTree ty op
r))

fixity :: Int -> FixityDirection -> Fixity
fixity :: Int -> FixityDirection -> Fixity
fixity = SourceText -> Int -> FixityDirection -> Fixity
Fixity SourceText
NoSourceText

doubleWithinEps :: Double -> Double -> Double -> Bool
doubleWithinEps :: Double -> Double -> Double -> Bool
doubleWithinEps eps :: Double
eps a :: Double
a b :: Double
b = Double -> Double
forall a. Num a => a -> a
abs (Double
a Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
b) Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
eps