-- 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_HEAD) || defined(GHCLIB_API_902) || defined (GHCLIB_API_900)
import GHC.Hs
#if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_902)
import GHC.Types.Fixity
import GHC.Types.SourceText
#else
import GHC.Types.Basic
#endif
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_900) || 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 [(String, Fixity)]
fixities 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 [(String, Fixity)]
fixities (L SrcSpan
loc (OpApp XOpApp GhcPs
_ LHsExpr GhcPs
l LHsExpr GhcPs
op 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 [(String, Fixity)]
_ 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_HEAD) || defined(GHCLIB_API_902) || defined (GHCLIB_API_900)
patFix :: [(String, Fixity)] -> LPat GhcPs -> LPat GhcPs
patFix [(String, Fixity)]
fixities (L loc (ConPat _ 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 (ConLikeP GhcPs)
Located RdrName
op ([(String, Fixity)] -> Located RdrName -> Fixity
findFixity' ([(String, Fixity)] -> [(String, Fixity)]
getFixities [(String, Fixity)]
fixities) Located (ConLikeP GhcPs)
Located RdrName
op) LPat GhcPs
pat1 LPat GhcPs
pat2)
#elif defined (GHCLIB_API_810)
patFix fixities (L loc (ConPatIn op (InfixCon pat1 pat2))) =
  L loc (mkConOpPat (getFixities fixities) op (findFixity' (getFixities fixities) op) pat1 pat2)
#else
patFix fixities (dL -> L _ (ConPatIn op (InfixCon pat1 pat2))) =
  mkConOpPat (getFixities fixities) op (findFixity' (getFixities fixities) op) pat1 pat2
#endif
patFix [(String, Fixity)]
_ LPat GhcPs
p = LPat GhcPs
p

mkConOpPat ::
  [(String, Fixity)]
#if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_902)
  -> LocatedN RdrName
#else
  -> Located RdrName
#endif
  -> Fixity
  -> LPat GhcPs -> LPat GhcPs
  -> Pat GhcPs
#if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_902) || defined (GHCLIB_API_900)
mkConOpPat :: [(String, Fixity)]
-> Located RdrName
-> Fixity
-> LPat GhcPs
-> LPat GhcPs
-> Pat GhcPs
mkConOpPat [(String, Fixity)]
fs Located RdrName
op2 Fixity
fix2 p1 :: LPat GhcPs
p1@(L loc (ConPat _ op1 (InfixCon p11 p12))) LPat GhcPs
p2
#elif defined (GHCLIB_API_810)
mkConOpPat fs op2 fix2 p1@(L loc (ConPatIn op1 (InfixCon p11 p12))) p2
#else
mkConOpPat fs op2 fix2 p1@(dL->L loc (ConPatIn op1 (InfixCon p11 p12))) p2
#endif
#if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_902)
  | nofix_error = ConPat noAnn op2 (InfixCon p1 p2)
#elif defined (GHCLIB_API_900)
  | Bool
nofix_error = XConPat GhcPs
-> Located (ConLikeP GhcPs) -> HsConPatDetails GhcPs -> Pat GhcPs
forall p.
XConPat p -> Located (ConLikeP p) -> HsConPatDetails p -> Pat p
ConPat NoExtField
XConPat GhcPs
noExtField Located (ConLikeP 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)
#else
  | nofix_error = ConPatIn op2 (InfixCon p1 p2)
#endif
#if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_902)
  | associate_right = ConPat noAnn op1 (InfixCon p11 (L loc (mkConOpPat fs op2 fix2 p12 p2)))
#elif defined (GHCLIB_API_900)
  | Bool
associate_right = XConPat GhcPs
-> Located (ConLikeP GhcPs) -> HsConPatDetails GhcPs -> Pat GhcPs
forall p.
XConPat p -> Located (ConLikeP p) -> HsConPatDetails p -> Pat p
ConPat NoExtField
XConPat GhcPs
noExtField Located (ConLikeP 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)))
#elif defined (GHCLIB_API_810)
  | associate_right = ConPatIn op1 (InfixCon p11 (L loc (mkConOpPat fs op2 fix2 p12 p2)))
#else
  | associate_right = ConPatIn op1 (InfixCon p11 (cL loc (mkConOpPat fs op2 fix2 p12 p2)))
#endif
#if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_902)
  | otherwise = ConPat noAnn op2 (InfixCon p1 p2)
#elif defined (GHCLIB_API_900)
  | Bool
otherwise = XConPat GhcPs
-> Located (ConLikeP GhcPs) -> HsConPatDetails GhcPs -> Pat GhcPs
forall p.
XConPat p -> Located (ConLikeP p) -> HsConPatDetails p -> Pat p
ConPat NoExtField
XConPat GhcPs
noExtField Located (ConLikeP 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)
#else
  | otherwise = ConPatIn op2 (InfixCon p1 p2)
#endif
  where
    fix1 :: Fixity
fix1 = [(String, Fixity)] -> Located RdrName -> Fixity
findFixity' [(String, Fixity)]
fs Located (ConLikeP GhcPs)
Located RdrName
op1
    (Bool
nofix_error, Bool
associate_right) = Fixity -> Fixity -> (Bool, Bool)
compareFixity Fixity
fix1 Fixity
fix2
#if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_902)
mkConOpPat _ op _ p1 p2 = ConPat noAnn op (InfixCon p1 p2)
#elif defined (GHCLIB_API_900)
mkConOpPat [(String, Fixity)]
_ Located RdrName
op Fixity
_ LPat GhcPs
p1 LPat GhcPs
p2 = XConPat GhcPs
-> Located (ConLikeP GhcPs) -> HsConPatDetails GhcPs -> Pat GhcPs
forall p.
XConPat p -> Located (ConLikeP p) -> HsConPatDetails p -> Pat p
ConPat NoExtField
XConPat GhcPs
noExtField Located (ConLikeP 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)
#else
mkConOpPat _ op _ p1 p2 = ConPatIn op (InfixCon p1 p2)
#endif

mkOpApp ::
   [(String, Fixity)]
#if defined(GHCLIB_API_HEAD) || defined(GHCLIB_API_902)
   -> SrcSpanAnnA
#else
   -> SrcSpan
#endif
   -> 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 [(String, Fixity)]
fs SrcSpan
loc e1 :: LHsExpr GhcPs
e1@(L SrcSpan
_ (OpApp XOpApp GhcPs
x1 LHsExpr GhcPs
e11 LHsExpr GhcPs
op1 LHsExpr GhcPs
e12)) LHsExpr GhcPs
op2 Fixity
fix2 LHsExpr GhcPs
e2
#if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_902)
  | nofix_error = L loc (OpApp noAnn e1 op2 e2)
#else
  | 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)
#endif
  | 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
#if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_902)
    loc'= combineLocsA e12 e2
#else
    loc' :: SrcSpan
loc'= LHsExpr GhcPs -> LHsExpr GhcPs -> SrcSpan
forall a b. Located a -> Located b -> SrcSpan
combineLocs LHsExpr GhcPs
e12 LHsExpr GhcPs
e2
#endif
    fix1 :: Fixity
fix1 = [(String, Fixity)] -> LHsExpr GhcPs -> Fixity
findFixity [(String, Fixity)]
fs LHsExpr GhcPs
op1
    (Bool
nofix_error, Bool
associate_right) = Fixity -> Fixity -> (Bool, Bool)
compareFixity Fixity
fix1 Fixity
fix2
--      (- neg_arg) `op` e2
mkOpApp [(String, Fixity)]
fs SrcSpan
loc e1 :: LHsExpr GhcPs
e1@(L SrcSpan
_ (NegApp XNegApp GhcPs
_ LHsExpr GhcPs
neg_arg SyntaxExpr GhcPs
neg_name)) LHsExpr GhcPs
op2 Fixity
fix2 LHsExpr GhcPs
e2
#if defined(GHCLIB_API_HEAD) || defined(GHCLIB_API_902)
  | nofix_error = L loc (OpApp noAnn e1 op2 e2)
#else
  | 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)
#endif
#if defined(GHCLIB_API_HEAD) || defined(GHCLIB_API_902)
  | associate_right = L loc (NegApp noAnn (mkOpApp fs loc' neg_arg op2 fix2 e2) neg_name)
#else
  | 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)
#endif
  where
#if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_902)
    loc' = combineLocsA neg_arg e2
#else
    loc' :: SrcSpan
loc' = LHsExpr GhcPs -> LHsExpr GhcPs -> SrcSpan
forall a b. Located a -> Located b -> SrcSpan
combineLocs LHsExpr GhcPs
neg_arg LHsExpr GhcPs
e2
#endif
    (Bool
nofix_error, Bool
associate_right) = Fixity -> Fixity -> (Bool, Bool)
compareFixity Fixity
negateFixity Fixity
fix2
--      e1 `op` - neg_arg
mkOpApp [(String, Fixity)]
_ SrcSpan
loc LHsExpr GhcPs
e1 LHsExpr GhcPs
op1 Fixity
fix1 e2 :: LHsExpr GhcPs
e2@(L SrcSpan
_ NegApp {}) -- NegApp can occur on the right.
#if defined(GHCLIB_API_HEAD) || defined(GHCLIB_API_902)
  | not associate_right  = L loc (OpApp noAnn e1 op1 e2)-- We *want* right association.
#else
  | 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.
#endif
  where
    (Bool
_, Bool
associate_right) = Fixity -> Fixity -> (Bool, Bool)
compareFixity Fixity
fix1 Fixity
negateFixity
 --     Default case, no rearrangment.
#if defined(GHCLIB_API_HEAD) || defined(GHCLIB_API_902)
mkOpApp _ loc e1 op _fix e2 = L loc (OpApp noAnn e1 op e2)
#else
mkOpApp [(String, Fixity)]
_ SrcSpan
loc LHsExpr GhcPs
e1 LHsExpr GhcPs
op Fixity
_fix 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)
#endif

getIdent :: LHsExpr GhcPs -> String
getIdent :: LHsExpr GhcPs -> String
getIdent (LHsExpr GhcPs -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc -> HsVar XVar GhcPs
_ (L SrcSpan
_ IdP GhcPs
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 LHsExpr GhcPs
_ = String -> String
forall a. HasCallStack => String -> a
error String
"Must be HsVar"

-- If there are no fixities, give 'baseFixities'.
getFixities :: [(String, Fixity)] -> [(String, Fixity)]
getFixities :: [(String, Fixity)] -> [(String, Fixity)]
getFixities [(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 [(String, Fixity)]
fs LHsExpr GhcPs
r = [(String, Fixity)] -> String -> Fixity
askFix [(String, Fixity)]
fs (LHsExpr GhcPs -> String
getIdent LHsExpr GhcPs
r) -- Expressions.

#if defined(GHCLIB_API_HEAD) || defined(GHCLIB_API_902)
findFixity' :: [(String, Fixity)] -> LocatedN RdrName -> Fixity
#else
findFixity' :: [(String, Fixity)] -> Located RdrName -> Fixity
#endif
findFixity' :: [(String, Fixity)] -> Located RdrName -> Fixity
findFixity' [(String, Fixity)]
fs 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 l e. GenLocated l e -> e
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 [(String, Fixity)]
xs = \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 a
def_v a
k [(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_ Int
9  [String
"."]
    , Int -> [String] -> [(String, Fixity)]
infixl_ Int
9  [String
"!!"]
    , Int -> [String] -> [(String, Fixity)]
infixr_ Int
8  [String
"^",String
"^^",String
"**"]
    , Int -> [String] -> [(String, Fixity)]
infixl_ Int
7  [String
"*",String
"/",String
"quot",String
"rem",String
"div",String
"mod",String
":%",String
"%"]
    , Int -> [String] -> [(String, Fixity)]
infixl_ Int
6  [String
"+",String
"-"]
    , Int -> [String] -> [(String, Fixity)]
infixr_ Int
5  [String
":",String
"++"]
    , Int -> [String] -> [(String, Fixity)]
infix_  Int
4  [String
"==",String
"/=",String
"<",String
"<=",String
">=",String
">",String
"elem",String
"notElem"]
    , Int -> [String] -> [(String, Fixity)]
infixr_ Int
3  [String
"&&"]
    , Int -> [String] -> [(String, Fixity)]
infixr_ Int
2  [String
"||"]
    , Int -> [String] -> [(String, Fixity)]
infixl_ Int
1  [String
">>",String
">>="]
    , Int -> [String] -> [(String, Fixity)]
infixr_ Int
1  [String
"=<<"]
    , Int -> [String] -> [(String, Fixity)]
infixr_ Int
0  [String
"$",String
"$!",String
"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_ Int
9 [String
"Compose"]
    , Int -> [String] -> [(String, Fixity)]
infixl_ Int
9 [String
"!",String
"//",String
"!:"]
    , Int -> [String] -> [(String, Fixity)]
infixl_ Int
8 [String
"shift",String
"rotate",String
"shiftL",String
"shiftR",String
"rotateL",String
"rotateR"]
    , Int -> [String] -> [(String, Fixity)]
infixl_ Int
7 [String
".&."]
    , Int -> [String] -> [(String, Fixity)]
infixl_ Int
6 [String
"xor"]
    , Int -> [String] -> [(String, Fixity)]
infix_  Int
6 [String
":+"]
    , Int -> [String] -> [(String, Fixity)]
infixr_ Int
6 [String
"<>"]
    , Int -> [String] -> [(String, Fixity)]
infixl_ Int
5 [String
".|."]
    , Int -> [String] -> [(String, Fixity)]
infixr_ Int
5 [String
"+:+",String
"<++",String
"<+>",String
"<|"] -- Fixity conflict for +++ between ReadP and Arrow.
    , Int -> [String] -> [(String, Fixity)]
infix_  Int
5 [String
"\\\\"]
    , Int -> [String] -> [(String, Fixity)]
infixl_ Int
4 [String
"<$>",String
"<$",String
"$>",String
"<*>",String
"<*",String
"*>",String
"<**>",String
"<$!>"]
    , Int -> [String] -> [(String, Fixity)]
infix_  Int
4 [String
"elemP",String
"notElemP",String
":~:", String
":~~:"]
    , Int -> [String] -> [(String, Fixity)]
infixl_ Int
3 [String
"<|>"]
    , Int -> [String] -> [(String, Fixity)]
infixr_ Int
3 [String
"&&&",String
"***"]
    , Int -> [String] -> [(String, Fixity)]
infixr_ Int
2 [String
"+++",String
"|||"]
    , Int -> [String] -> [(String, Fixity)]
infixr_ Int
1 [String
"<=<",String
">=>",String
">>>",String
"<<<",String
"^<<",String
"<<^",String
"^>>",String
">>^"]
    , Int -> [String] -> [(String, Fixity)]
infixl_ Int
0 [String
"on"]
    , Int -> [String] -> [(String, Fixity)]
infixr_ Int
0 [String
"par",String
"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 FixityDirection
a Int
p = (String -> (String, Fixity)) -> [String] -> [(String, Fixity)]
forall a b. (a -> b) -> [a] -> [b]
map (,SourceText -> Int -> FixityDirection -> Fixity
Fixity (String -> SourceText
SourceText String
"") Int
p FixityDirection
a)

#if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_902) || defined (GHCLIB_API_900)
fixitiesFromModule :: Located HsModule -> [(String, Fixity)]
#else
fixitiesFromModule :: Located (HsModule GhcPs) -> [(String, Fixity)]
#endif
#if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_902)
fixitiesFromModule (L _ (HsModule _ _ _ _ _ decls _ _)) = concatMap f decls
#elif defined (GHCLIB_API_900)
fixitiesFromModule :: Located HsModule -> [(String, Fixity)]
fixitiesFromModule (L SrcSpan
_ (HsModule LayoutInfo
_ Maybe (Located ModuleName)
_ Maybe (Located [LIE GhcPs])
_ [LImportDecl GhcPs]
_ [LHsDecl GhcPs]
decls Maybe (Located WarningTxt)
_ Maybe LHsDocString
_)) = (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
#else
fixitiesFromModule (L _ (HsModule _ _ _ decls _ _)) = concatMap f decls
#endif
  where
    f :: LHsDecl GhcPs -> [(String, Fixity)]
    f :: LHsDecl GhcPs -> [(String, Fixity)]
f (L SrcSpan
_ (SigD XSigD GhcPs
_ (FixSig XFixSig GhcPs
_ (FixitySig XFixitySig GhcPs
_ [GenLocated SrcSpan (IdP GhcPs)]
ops (Fixity SourceText
_ Int
p 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 l e. GenLocated l e -> e
unLoc) [GenLocated SrcSpan (IdP GhcPs)]
[Located RdrName]
ops)
    f LHsDecl GhcPs
_ = []