-- Copyright (c) 2020, Shayne Fletcher. All rights reserved.
-- SPDX-License-Identifier: BSD-3-Clause.
--
-- Adapted from (1) https://github.com/mpickering/apply-refact.git and
-- (2) https://gitlab.haskell.org/ghc/ghc ('compiler/renamer/RnTypes.hs').

{-# LANGUAGE CPP #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE TupleSections #-}
#include "ghclib_api.h"

module Language.Haskell.GhclibParserEx.Fixity(
    applyFixities
  , fixitiesFromModule
  , preludeFixities, baseFixities
  , infixr_, infixl_, infix_, fixity
  ) where

#if defined (GHCLIB_API_811)
import GHC.Hs
import GHC.Types.Basic
import GHC.Types.Name.Reader
import GHC.Types.Name
import GHC.Types.SrcLoc
#elif defined (GHCLIB_API_810)
import GHC.Hs
import BasicTypes
import RdrName
import OccName
import SrcLoc
#else
import HsSyn
import BasicTypes
import RdrName
import OccName
import SrcLoc
#endif
import Data.Maybe
import Data.Data hiding (Fixity)
import Data.Generics.Uniplate.Data

#if defined (GHCLIB_API_811) || defined (GHCLIB_API_810)
noExt :: NoExtField
noExt :: NoExtField
noExt = NoExtField
noExtField
#endif

-- | Rearrange a parse tree to account for fixities.
applyFixities :: Data a => [(String, Fixity)] -> a -> a
applyFixities :: [(String, Fixity)] -> a -> a
applyFixities fixities :: [(String, Fixity)]
fixities m :: a
m =
  let m' :: a
m'  = (LHsExpr GhcPs -> LHsExpr GhcPs) -> a -> a
forall from to. Biplate from to => (to -> to) -> from -> from
transformBi ([(String, Fixity)] -> LHsExpr GhcPs -> LHsExpr GhcPs
expFix [(String, Fixity)]
fixities) a
m
      m'' :: a
m'' = (Located (Pat GhcPs) -> Located (Pat GhcPs)) -> a -> a
forall from to. Biplate from to => (to -> to) -> from -> from
transformBi ([(String, Fixity)] -> LPat GhcPs -> LPat GhcPs
patFix [(String, Fixity)]
fixities) a
m'
  in a
m''

expFix :: [(String, Fixity)] -> LHsExpr GhcPs -> LHsExpr GhcPs
expFix :: [(String, Fixity)] -> LHsExpr GhcPs -> LHsExpr GhcPs
expFix fixities :: [(String, Fixity)]
fixities (L loc :: SrcSpan
loc (OpApp _ l :: LHsExpr GhcPs
l op :: LHsExpr GhcPs
op r :: LHsExpr GhcPs
r)) =
  [(String, Fixity)]
-> SrcSpan
-> LHsExpr GhcPs
-> LHsExpr GhcPs
-> Fixity
-> LHsExpr GhcPs
-> LHsExpr GhcPs
mkOpApp ([(String, Fixity)] -> [(String, Fixity)]
getFixities [(String, Fixity)]
fixities) SrcSpan
loc LHsExpr GhcPs
l LHsExpr GhcPs
op ([(String, Fixity)] -> LHsExpr GhcPs -> Fixity
findFixity ([(String, Fixity)] -> [(String, Fixity)]
getFixities [(String, Fixity)]
fixities) LHsExpr GhcPs
op) LHsExpr GhcPs
r
expFix _ e :: LHsExpr GhcPs
e = LHsExpr GhcPs
e

-- LPat and Pat have gone through a lot of churn. See
-- https://gitlab.haskell.org/ghc/ghc/merge_requests/1925 for details.
patFix :: [(String, Fixity)] -> LPat GhcPs -> LPat GhcPs
#if defined (GHCLIB_API_811)
patFix fixities (L loc (ConPat _ op (InfixCon pat1 pat2))) =
  L loc (mkConOpPat (getFixities fixities) op (findFixity' (getFixities fixities) op) pat1 pat2)
#elif defined (GHCLIB_API_810)
patFix :: [(String, Fixity)] -> LPat GhcPs -> LPat GhcPs
patFix fixities :: [(String, Fixity)]
fixities (L loc (ConPatIn op (InfixCon pat1 pat2))) =
  SrcSpan -> Pat GhcPs -> Located (Pat GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc ([(String, Fixity)]
-> Located RdrName
-> Fixity
-> LPat GhcPs
-> LPat GhcPs
-> Pat GhcPs
mkConOpPat ([(String, Fixity)] -> [(String, Fixity)]
getFixities [(String, Fixity)]
fixities) Located (IdP GhcPs)
Located RdrName
op ([(String, Fixity)] -> Located RdrName -> Fixity
findFixity' ([(String, Fixity)] -> [(String, Fixity)]
getFixities [(String, Fixity)]
fixities) Located (IdP GhcPs)
Located RdrName
op) LPat GhcPs
pat1 LPat GhcPs
pat2)
#else
patFix fixities (dL -> L _ (ConPatIn op (InfixCon pat1 pat2))) =
  mkConOpPat (getFixities fixities) op (findFixity' (getFixities fixities) op) pat1 pat2
#endif
patFix _ p :: LPat GhcPs
p = LPat GhcPs
p

mkConOpPat ::
  [(String, Fixity)]
  -> Located RdrName -> Fixity
  -> LPat GhcPs -> LPat GhcPs
  -> Pat GhcPs
#if defined (GHCLIB_API_811)
mkConOpPat fs op2 fix2 p1@(L loc (ConPat _ op1 (InfixCon p11 p12))) p2
#elif defined (GHCLIB_API_810)
mkConOpPat :: [(String, Fixity)]
-> Located RdrName
-> Fixity
-> LPat GhcPs
-> LPat GhcPs
-> Pat GhcPs
mkConOpPat fs :: [(String, Fixity)]
fs op2 :: Located RdrName
op2 fix2 :: Fixity
fix2 p1 :: LPat GhcPs
p1@(L loc (ConPatIn op1 (InfixCon p11 p12))) p2 :: LPat GhcPs
p2
#else
mkConOpPat fs op2 fix2 p1@(dL->L loc (ConPatIn op1 (InfixCon p11 p12))) p2
#endif
#if defined (GHCLIB_API_811)
  | nofix_error = ConPat noExtField op2 (InfixCon p1 p2)
#else
  | Bool
nofix_error = Located (IdP GhcPs) -> HsConPatDetails GhcPs -> Pat GhcPs
forall p. Located (IdP p) -> HsConPatDetails p -> Pat p
ConPatIn Located (IdP GhcPs)
Located RdrName
op2 (Located (Pat GhcPs)
-> Located (Pat GhcPs)
-> HsConDetails
     (Located (Pat GhcPs)) (HsRecFields GhcPs (Located (Pat GhcPs)))
forall arg rec. arg -> arg -> HsConDetails arg rec
InfixCon LPat GhcPs
Located (Pat GhcPs)
p1 LPat GhcPs
Located (Pat GhcPs)
p2)
#endif
#if defined (GHCLIB_API_811)
  | associate_right = ConPat noExtField op1 (InfixCon p11 (L loc (mkConOpPat fs op2 fix2 p12 p2)))
#elif defined (GHCLIB_API_810)
  | Bool
associate_right = Located (IdP GhcPs) -> HsConPatDetails GhcPs -> Pat GhcPs
forall p. Located (IdP p) -> HsConPatDetails p -> Pat p
ConPatIn Located (IdP GhcPs)
op1 (Located (Pat GhcPs)
-> Located (Pat GhcPs)
-> HsConDetails
     (Located (Pat GhcPs)) (HsRecFields GhcPs (Located (Pat GhcPs)))
forall arg rec. arg -> arg -> HsConDetails arg rec
InfixCon LPat GhcPs
Located (Pat GhcPs)
p11 (SrcSpan -> Pat GhcPs -> Located (Pat GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc ([(String, Fixity)]
-> Located RdrName
-> Fixity
-> LPat GhcPs
-> LPat GhcPs
-> Pat GhcPs
mkConOpPat [(String, Fixity)]
fs Located RdrName
op2 Fixity
fix2 LPat GhcPs
p12 LPat GhcPs
p2)))
#else
  | associate_right = ConPatIn op1 (InfixCon p11 (cL loc (mkConOpPat fs op2 fix2 p12 p2)))
#endif
#if defined (GHCLIB_API_811)
  | otherwise = ConPat noExtField op2 (InfixCon p1 p2)
#else
  | Bool
otherwise = Located (IdP GhcPs) -> HsConPatDetails GhcPs -> Pat GhcPs
forall p. Located (IdP p) -> HsConPatDetails p -> Pat p
ConPatIn Located (IdP GhcPs)
Located RdrName
op2 (Located (Pat GhcPs)
-> Located (Pat GhcPs)
-> HsConDetails
     (Located (Pat GhcPs)) (HsRecFields GhcPs (Located (Pat GhcPs)))
forall arg rec. arg -> arg -> HsConDetails arg rec
InfixCon LPat GhcPs
Located (Pat GhcPs)
p1 LPat GhcPs
Located (Pat GhcPs)
p2)
#endif
  where
    fix1 :: Fixity
fix1 = [(String, Fixity)] -> Located RdrName -> Fixity
findFixity' [(String, Fixity)]
fs Located (IdP GhcPs)
Located RdrName
op1
    (nofix_error :: Bool
nofix_error, associate_right :: Bool
associate_right) = Fixity -> Fixity -> (Bool, Bool)
compareFixity Fixity
fix1 Fixity
fix2
#if defined (GHCLIB_API_811)
mkConOpPat _ op _ p1 p2 = ConPat noExtField op (InfixCon p1 p2)
#else
mkConOpPat _ op :: Located RdrName
op _ p1 :: LPat GhcPs
p1 p2 :: LPat GhcPs
p2 = Located (IdP GhcPs) -> HsConPatDetails GhcPs -> Pat GhcPs
forall p. Located (IdP p) -> HsConPatDetails p -> Pat p
ConPatIn Located (IdP GhcPs)
Located RdrName
op (Located (Pat GhcPs)
-> Located (Pat GhcPs)
-> HsConDetails
     (Located (Pat GhcPs)) (HsRecFields GhcPs (Located (Pat GhcPs)))
forall arg rec. arg -> arg -> HsConDetails arg rec
InfixCon LPat GhcPs
Located (Pat GhcPs)
p1 LPat GhcPs
Located (Pat GhcPs)
p2)
#endif

mkOpApp ::
  [(String, Fixity)]
  -> SrcSpan
  -> LHsExpr GhcPs -- Left operand; already rearrange.
  -> LHsExpr GhcPs -> Fixity -- Operator and fixity.
  -> LHsExpr GhcPs -- Right operand (not an OpApp, but might be a NegApp).
  -> LHsExpr GhcPs
--      (e11 `op1` e12) `op2` e2
mkOpApp :: [(String, Fixity)]
-> SrcSpan
-> LHsExpr GhcPs
-> LHsExpr GhcPs
-> Fixity
-> LHsExpr GhcPs
-> LHsExpr GhcPs
mkOpApp fs :: [(String, Fixity)]
fs loc :: SrcSpan
loc e1 :: LHsExpr GhcPs
e1@(L _ (OpApp x1 :: XOpApp GhcPs
x1 e11 :: LHsExpr GhcPs
e11 op1 :: LHsExpr GhcPs
op1 e12 :: LHsExpr GhcPs
e12)) op2 :: LHsExpr GhcPs
op2 fix2 :: Fixity
fix2 e2 :: LHsExpr GhcPs
e2
  | Bool
nofix_error = SrcSpan -> HsExpr GhcPs -> LHsExpr GhcPs
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc (XOpApp GhcPs
-> LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p.
XOpApp p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
OpApp NoExtField
XOpApp GhcPs
noExt LHsExpr GhcPs
e1 LHsExpr GhcPs
op2 LHsExpr GhcPs
e2)
  | Bool
associate_right = SrcSpan -> HsExpr GhcPs -> LHsExpr GhcPs
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc (XOpApp GhcPs
-> LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p.
XOpApp p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
OpApp XOpApp GhcPs
x1 LHsExpr GhcPs
e11 LHsExpr GhcPs
op1 ([(String, Fixity)]
-> SrcSpan
-> LHsExpr GhcPs
-> LHsExpr GhcPs
-> Fixity
-> LHsExpr GhcPs
-> LHsExpr GhcPs
mkOpApp [(String, Fixity)]
fs SrcSpan
loc' LHsExpr GhcPs
e12 LHsExpr GhcPs
op2 Fixity
fix2 LHsExpr GhcPs
e2 ))
  where
    loc' :: SrcSpan
loc'= LHsExpr GhcPs -> LHsExpr GhcPs -> SrcSpan
forall a b. (HasSrcSpan a, HasSrcSpan b) => a -> b -> SrcSpan
combineLocs LHsExpr GhcPs
e12 LHsExpr GhcPs
e2
    fix1 :: Fixity
fix1 = [(String, Fixity)] -> LHsExpr GhcPs -> Fixity
findFixity [(String, Fixity)]
fs LHsExpr GhcPs
op1
    (nofix_error :: Bool
nofix_error, associate_right :: Bool
associate_right) = Fixity -> Fixity -> (Bool, Bool)
compareFixity Fixity
fix1 Fixity
fix2
--      (- neg_arg) `op` e2
mkOpApp fs :: [(String, Fixity)]
fs loc :: SrcSpan
loc e1 :: LHsExpr GhcPs
e1@(L _ (NegApp _ neg_arg :: LHsExpr GhcPs
neg_arg neg_name :: SyntaxExpr GhcPs
neg_name)) op2 :: LHsExpr GhcPs
op2 fix2 :: Fixity
fix2 e2 :: LHsExpr GhcPs
e2
  | Bool
nofix_error = SrcSpan -> HsExpr GhcPs -> LHsExpr GhcPs
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc (XOpApp GhcPs
-> LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p.
XOpApp p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
OpApp NoExtField
XOpApp GhcPs
noExt LHsExpr GhcPs
e1 LHsExpr GhcPs
op2 LHsExpr GhcPs
e2)
  | Bool
associate_right = SrcSpan -> HsExpr GhcPs -> LHsExpr GhcPs
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc (XNegApp GhcPs -> LHsExpr GhcPs -> SyntaxExpr GhcPs -> HsExpr GhcPs
forall p. XNegApp p -> LHsExpr p -> SyntaxExpr p -> HsExpr p
NegApp NoExtField
XNegApp GhcPs
noExt ([(String, Fixity)]
-> SrcSpan
-> LHsExpr GhcPs
-> LHsExpr GhcPs
-> Fixity
-> LHsExpr GhcPs
-> LHsExpr GhcPs
mkOpApp [(String, Fixity)]
fs SrcSpan
loc' LHsExpr GhcPs
neg_arg LHsExpr GhcPs
op2 Fixity
fix2 LHsExpr GhcPs
e2) SyntaxExpr GhcPs
neg_name)
  where
    loc' :: SrcSpan
loc' = LHsExpr GhcPs -> LHsExpr GhcPs -> SrcSpan
forall a b. (HasSrcSpan a, HasSrcSpan b) => a -> b -> SrcSpan
combineLocs LHsExpr GhcPs
neg_arg LHsExpr GhcPs
e2
    (nofix_error :: Bool
nofix_error, associate_right :: Bool
associate_right) = Fixity -> Fixity -> (Bool, Bool)
compareFixity Fixity
negateFixity Fixity
fix2
--      e1 `op` - neg_arg
mkOpApp _ loc :: SrcSpan
loc e1 :: LHsExpr GhcPs
e1 op1 :: LHsExpr GhcPs
op1 fix1 :: Fixity
fix1 e2 :: LHsExpr GhcPs
e2@(L _ NegApp {}) -- NegApp can occur on the right.
  | Bool -> Bool
not Bool
associate_right  = SrcSpan -> HsExpr GhcPs -> LHsExpr GhcPs
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc (XOpApp GhcPs
-> LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p.
XOpApp p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
OpApp NoExtField
XOpApp GhcPs
noExt LHsExpr GhcPs
e1 LHsExpr GhcPs
op1 LHsExpr GhcPs
e2)-- We *want* right association.
  where
    (_, associate_right :: Bool
associate_right) = Fixity -> Fixity -> (Bool, Bool)
compareFixity Fixity
fix1 Fixity
negateFixity
 --     Default case, no rearrangment.
mkOpApp _ loc :: SrcSpan
loc e1 :: LHsExpr GhcPs
e1 op :: LHsExpr GhcPs
op _fix :: Fixity
_fix e2 :: LHsExpr GhcPs
e2 = SrcSpan -> HsExpr GhcPs -> LHsExpr GhcPs
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc (XOpApp GhcPs
-> LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p.
XOpApp p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
OpApp NoExtField
XOpApp GhcPs
noExt LHsExpr GhcPs
e1 LHsExpr GhcPs
op LHsExpr GhcPs
e2)

getIdent :: LHsExpr GhcPs -> String
getIdent :: LHsExpr GhcPs -> String
getIdent (LHsExpr GhcPs -> SrcSpanLess (LHsExpr GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc -> HsVar _ (L _ n)) = OccName -> String
occNameString (OccName -> String) -> (RdrName -> OccName) -> RdrName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrName -> OccName
rdrNameOcc (RdrName -> String) -> RdrName -> String
forall a b. (a -> b) -> a -> b
$ IdP GhcPs
RdrName
n
getIdent _ = String -> String
forall a. HasCallStack => String -> a
error "Must be HsVar"

-- If there are no fixities, give 'baseFixities'.
getFixities :: [(String, Fixity)] -> [(String, Fixity)]
getFixities :: [(String, Fixity)] -> [(String, Fixity)]
getFixities fixities :: [(String, Fixity)]
fixities = if [(String, Fixity)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, Fixity)]
fixities then [(String, Fixity)]
baseFixities else [(String, Fixity)]
fixities

findFixity :: [(String, Fixity)] -> LHsExpr GhcPs -> Fixity
findFixity :: [(String, Fixity)] -> LHsExpr GhcPs -> Fixity
findFixity fs :: [(String, Fixity)]
fs r :: LHsExpr GhcPs
r = [(String, Fixity)] -> String -> Fixity
askFix [(String, Fixity)]
fs (LHsExpr GhcPs -> String
getIdent LHsExpr GhcPs
r) -- Expressions.

findFixity' :: [(String, Fixity)] -> Located RdrName -> Fixity
findFixity' :: [(String, Fixity)] -> Located RdrName -> Fixity
findFixity' fs :: [(String, Fixity)]
fs r :: Located RdrName
r = [(String, Fixity)] -> String -> Fixity
askFix [(String, Fixity)]
fs (OccName -> String
occNameString (OccName -> String)
-> (Located RdrName -> OccName) -> Located RdrName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrName -> OccName
rdrNameOcc (RdrName -> OccName)
-> (Located RdrName -> RdrName) -> Located RdrName -> OccName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located RdrName -> RdrName
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (Located RdrName -> String) -> Located RdrName -> String
forall a b. (a -> b) -> a -> b
$ Located RdrName
r) -- Patterns.

askFix :: [(String, Fixity)] -> String -> Fixity
askFix :: [(String, Fixity)] -> String -> Fixity
askFix xs :: [(String, Fixity)]
xs = \k :: String
k -> Fixity -> String -> [(String, Fixity)] -> Fixity
forall a a. Eq a => a -> a -> [(a, a)] -> a
lookupWithDefault Fixity
defaultFixity String
k [(String, Fixity)]
xs
  where lookupWithDefault :: a -> a -> [(a, a)] -> a
lookupWithDefault def_v :: a
def_v k :: a
k mp1 :: [(a, a)]
mp1 = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
def_v (Maybe a -> a) -> Maybe a -> a
forall a b. (a -> b) -> a -> b
$ a -> [(a, a)] -> Maybe a
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup a
k [(a, a)]
mp1

-- All fixities defined in the Prelude.
preludeFixities :: [(String, Fixity)]
preludeFixities :: [(String, Fixity)]
preludeFixities = [[(String, Fixity)]] -> [(String, Fixity)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ Int -> [String] -> [(String, Fixity)]
infixr_ 9  ["."]
    , Int -> [String] -> [(String, Fixity)]
infixl_ 9  ["!!"]
    , Int -> [String] -> [(String, Fixity)]
infixr_ 8  ["^","^^","**"]
    , Int -> [String] -> [(String, Fixity)]
infixl_ 7  ["*","/","quot","rem","div","mod",":%","%"]
    , Int -> [String] -> [(String, Fixity)]
infixl_ 6  ["+","-"]
    , Int -> [String] -> [(String, Fixity)]
infixr_ 5  [":","++"]
    , Int -> [String] -> [(String, Fixity)]
infix_  4  ["==","/=","<","<=",">=",">","elem","notElem"]
    , Int -> [String] -> [(String, Fixity)]
infixr_ 3  ["&&"]
    , Int -> [String] -> [(String, Fixity)]
infixr_ 2  ["||"]
    , Int -> [String] -> [(String, Fixity)]
infixl_ 1  [">>",">>="]
    , Int -> [String] -> [(String, Fixity)]
infixr_ 1  ["=<<"]
    , Int -> [String] -> [(String, Fixity)]
infixr_ 0  ["$","$!","seq"]
    ]

-- All fixities defined in the base package. Note that the @+++@
-- operator appears in both Control.Arrows and
-- Text.ParserCombinators.ReadP. The listed precedence for @+++@ in
-- this list is that of Control.Arrows.
baseFixities :: [(String, Fixity)]
baseFixities :: [(String, Fixity)]
baseFixities = [(String, Fixity)]
preludeFixities [(String, Fixity)] -> [(String, Fixity)] -> [(String, Fixity)]
forall a. [a] -> [a] -> [a]
++ [[(String, Fixity)]] -> [(String, Fixity)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ Int -> [String] -> [(String, Fixity)]
infixr_ 9 ["Compose"]
    , Int -> [String] -> [(String, Fixity)]
infixl_ 9 ["!","//","!:"]
    , Int -> [String] -> [(String, Fixity)]
infixl_ 8 ["shift","rotate","shiftL","shiftR","rotateL","rotateR"]
    , Int -> [String] -> [(String, Fixity)]
infixl_ 7 [".&."]
    , Int -> [String] -> [(String, Fixity)]
infixl_ 6 ["xor"]
    , Int -> [String] -> [(String, Fixity)]
infix_  6 [":+"]
    , Int -> [String] -> [(String, Fixity)]
infixr_ 6 ["<>"]
    , Int -> [String] -> [(String, Fixity)]
infixl_ 5 [".|."]
    , Int -> [String] -> [(String, Fixity)]
infixr_ 5 ["+:+","<++","<+>","<|"] -- Fixity conflict for +++ between ReadP and Arrow.
    , Int -> [String] -> [(String, Fixity)]
infix_  5 ["\\\\"]
    , Int -> [String] -> [(String, Fixity)]
infixl_ 4 ["<$>","<$","$>","<*>","<*","*>","<**>","<$!>"]
    , Int -> [String] -> [(String, Fixity)]
infix_  4 ["elemP","notElemP",":~:", ":~~:"]
    , Int -> [String] -> [(String, Fixity)]
infixl_ 3 ["<|>"]
    , Int -> [String] -> [(String, Fixity)]
infixr_ 3 ["&&&","***"]
    , Int -> [String] -> [(String, Fixity)]
infixr_ 2 ["+++","|||"]
    , Int -> [String] -> [(String, Fixity)]
infixr_ 1 ["<=<",">=>",">>>","<<<","^<<","<<^","^>>",">>^"]
    , Int -> [String] -> [(String, Fixity)]
infixl_ 0 ["on"]
    , Int -> [String] -> [(String, Fixity)]
infixr_ 0 ["par","pseq"]
    ]

infixr_, infixl_, infix_ :: Int -> [String] -> [(String,Fixity)]
infixr_ :: Int -> [String] -> [(String, Fixity)]
infixr_ = FixityDirection -> Int -> [String] -> [(String, Fixity)]
fixity FixityDirection
InfixR
infixl_ :: Int -> [String] -> [(String, Fixity)]
infixl_ = FixityDirection -> Int -> [String] -> [(String, Fixity)]
fixity FixityDirection
InfixL
infix_ :: Int -> [String] -> [(String, Fixity)]
infix_  = FixityDirection -> Int -> [String] -> [(String, Fixity)]
fixity FixityDirection
InfixN

fixity :: FixityDirection -> Int -> [String] -> [(String, Fixity)]
fixity :: FixityDirection -> Int -> [String] -> [(String, Fixity)]
fixity a :: FixityDirection
a p :: Int
p = (String -> (String, Fixity)) -> [String] -> [(String, Fixity)]
forall a b. (a -> b) -> [a] -> [b]
map (,SourceText -> Int -> FixityDirection -> Fixity
Fixity (String -> SourceText
SourceText "") Int
p FixityDirection
a)

#if defined (GHCLIB_API_811)
fixitiesFromModule :: Located HsModule -> [(String, Fixity)]
#else
fixitiesFromModule :: Located (HsModule GhcPs) -> [(String, Fixity)]
#endif
#if defined(GHCLIB_API_811)
fixitiesFromModule (L _ (HsModule _ _ _ _ decls _ _)) = concatMap f decls
#else
fixitiesFromModule :: Located (HsModule GhcPs) -> [(String, Fixity)]
fixitiesFromModule (L _ (HsModule _ _ _ decls :: [LHsDecl GhcPs]
decls _ _)) = (LHsDecl GhcPs -> [(String, Fixity)])
-> [LHsDecl GhcPs] -> [(String, Fixity)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap LHsDecl GhcPs -> [(String, Fixity)]
f [LHsDecl GhcPs]
decls
#endif
  where
    f :: LHsDecl GhcPs -> [(String, Fixity)]
    f :: LHsDecl GhcPs -> [(String, Fixity)]
f (L _ (SigD _ (FixSig _ (FixitySig _ ops :: [Located (IdP GhcPs)]
ops (Fixity _ p :: Int
p dir :: FixityDirection
dir))))) =
          FixityDirection -> Int -> [String] -> [(String, Fixity)]
fixity FixityDirection
dir Int
p ((Located RdrName -> String) -> [Located RdrName] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (OccName -> String
occNameString(OccName -> String)
-> (Located RdrName -> OccName) -> Located RdrName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrName -> OccName
rdrNameOcc (RdrName -> OccName)
-> (Located RdrName -> RdrName) -> Located RdrName -> OccName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located RdrName -> RdrName
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) [Located (IdP GhcPs)]
[Located RdrName]
ops)
    f _ = []