{-# LANGUAGE ViewPatterns #-}

module Refact.Fixity (applyFixities) where

import Control.Monad.Trans.State
import Data.Generics hiding (Fixity)
import Data.List
import qualified Data.Map as Map
import Data.Maybe
import Data.Tuple
import qualified GHC
import Language.Haskell.GHC.ExactPrint.Types hiding (GhcPs, GhcRn, GhcTc)
import Refact.Compat (Fixity (..), SourceText (..), occNameString, rdrNameOcc)
import Refact.Utils

-- | Rearrange infix expressions to account for fixity.
-- The set of fixities is wired in and includes all fixities in base.
applyFixities :: Anns -> Module -> IO (Anns, Module)
applyFixities :: Anns -> Module -> IO (Anns, Module)
applyFixities Anns
as Module
m = (Module, Anns) -> (Anns, Module)
forall a b. (a, b) -> (b, a)
swap ((Module, Anns) -> (Anns, Module))
-> IO (Module, Anns) -> IO (Anns, Module)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Anns IO Module -> Anns -> IO (Module, Anns)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (GenericM (StateT Anns IO) -> Module -> StateT Anns IO Module
forall (m :: * -> *). Monad m => GenericM m -> GenericM m
everywhereM ((Expr -> StateT Anns IO Expr) -> a -> StateT Anns IO a
forall (m :: * -> *) a b.
(Monad m, Typeable a, Typeable b) =>
(b -> m b) -> a -> m a
mkM Expr -> StateT Anns IO Expr
expFix) Module
m) Anns
as

expFix :: Expr -> StateT Anns IO Expr
expFix :: Expr -> StateT Anns IO Expr
expFix (GHC.L SrcSpan
loc (GHC.OpApp XOpApp GhcPs
_ Expr
l Expr
op Expr
r)) =
  [(String, Fixity)]
-> SrcSpan -> Expr -> Expr -> Fixity -> Expr -> StateT Anns IO Expr
mkOpAppRn [(String, Fixity)]
baseFixities SrcSpan
loc Expr
l Expr
op ([(String, Fixity)] -> Expr -> Fixity
findFixity [(String, Fixity)]
baseFixities Expr
op) Expr
r
expFix Expr
e = Expr -> StateT Anns IO Expr
forall (m :: * -> *) a. Monad m => a -> m a
return Expr
e

getIdent :: Expr -> String
getIdent :: Expr -> String
getIdent (Expr -> SrcSpanLess Expr
forall a. HasSrcSpan a => a -> SrcSpanLess a
GHC.unLoc -> GHC.HsVar _ (GHC.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 Expr
_ = String -> String
forall a. HasCallStack => String -> a
error String
"Must be HsVar"

-- | Move the delta position from one annotation to another:
--
--  * When rewriting '(e11 `op1` e12) `op2` e2' into 'e11 `op1` (e12 `op2` e2)', move the delta position
--    from 'e12' to '(e12 `op2` e2)'.
--  * When rewriting '(- neg_arg) `op` e2' into '- (neg_arg `op` e2)', move the delta position
--    from 'neg_arg' to '(neg_arg `op` e2)'.
moveDelta :: Annotation -> AnnKey -> AnnKey -> StateT Anns IO ()
moveDelta :: Annotation -> AnnKey -> AnnKey -> StateT Anns IO ()
moveDelta Annotation
oldAnn AnnKey
oldKey AnnKey
newKey = do
  -- If the old annotation has a unary minus operator, add it to the new annotation.
  let newAnnsDP :: [(KeywordId, DeltaPos)]
newAnnsDP
        | Just (KeywordId, DeltaPos)
dp <- ((KeywordId, DeltaPos) -> Bool)
-> [(KeywordId, DeltaPos)] -> Maybe (KeywordId, DeltaPos)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((KeywordId -> KeywordId -> Bool
forall a. Eq a => a -> a -> Bool
== AnnKeywordId -> KeywordId
G AnnKeywordId
GHC.AnnMinus) (KeywordId -> Bool)
-> ((KeywordId, DeltaPos) -> KeywordId)
-> (KeywordId, DeltaPos)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KeywordId, DeltaPos) -> KeywordId
forall a b. (a, b) -> a
fst) (Annotation -> [(KeywordId, DeltaPos)]
annsDP Annotation
oldAnn) = [(KeywordId, DeltaPos)
dp]
        | Bool
otherwise = []
  (Anns -> Anns) -> StateT Anns IO ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify ((Anns -> Anns) -> StateT Anns IO ())
-> (Annotation -> Anns -> Anns) -> Annotation -> StateT Anns IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnnKey -> Annotation -> Anns -> Anns
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert AnnKey
newKey (Annotation -> StateT Anns IO ())
-> Annotation -> StateT Anns IO ()
forall a b. (a -> b) -> a -> b
$
    Annotation
annNone
      { annEntryDelta :: DeltaPos
annEntryDelta = Annotation -> DeltaPos
annEntryDelta Annotation
oldAnn,
        annPriorComments :: [(Comment, DeltaPos)]
annPriorComments = Annotation -> [(Comment, DeltaPos)]
annPriorComments Annotation
oldAnn,
        annsDP :: [(KeywordId, DeltaPos)]
annsDP = [(KeywordId, DeltaPos)]
newAnnsDP
      }

  -- If the old key is still there, reset the value.
  (Anns -> Anns) -> StateT Anns IO ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify ((Anns -> Anns) -> StateT Anns IO ())
-> (Anns -> Anns) -> StateT Anns IO ()
forall a b. (a -> b) -> a -> b
$ (Annotation -> Annotation) -> AnnKey -> Anns -> Anns
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\Annotation
a -> Annotation
a {annEntryDelta :: DeltaPos
annEntryDelta = (Int, Int) -> DeltaPos
DP (Int
0, Int
0), annPriorComments :: [(Comment, DeltaPos)]
annPriorComments = []}) AnnKey
oldKey

---------------------------
-- Modified from GHC Renamer
mkOpAppRn ::
  [(String, GHC.Fixity)] ->
  GHC.SrcSpan ->
  Expr -> -- Left operand; already rearrange
  Expr ->
  GHC.Fixity -> -- Operator and fixity
  Expr -> -- Right operand (not an OpApp, but might
  -- be a NegApp)
  StateT Anns IO Expr
-- (e11 `op1` e12) `op2` e2
mkOpAppRn :: [(String, Fixity)]
-> SrcSpan -> Expr -> Expr -> Fixity -> Expr -> StateT Anns IO Expr
mkOpAppRn [(String, Fixity)]
fs SrcSpan
loc e1 :: Expr
e1@(GHC.L SrcSpan
_ (GHC.OpApp XOpApp GhcPs
x1 Expr
e11 Expr
op1 Expr
e12)) Expr
op2 Fixity
fix2 Expr
e2
  | Bool
nofix_error =
    Expr -> StateT Anns IO Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> StateT Anns IO Expr) -> Expr -> StateT Anns IO Expr
forall a b. (a -> b) -> a -> b
$ SrcSpan -> HsExpr GhcPs -> Expr
forall l e. l -> e -> GenLocated l e
GHC.L SrcSpan
loc (XOpApp GhcPs -> Expr -> Expr -> Expr -> HsExpr GhcPs
forall p.
XOpApp p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
GHC.OpApp NoExtField
XOpApp GhcPs
noExt Expr
e1 Expr
op2 Expr
e2)
  | Bool
associate_right = do
    let oldKey :: AnnKey
oldKey = Expr -> AnnKey
forall a. Constraints a => a -> AnnKey
mkAnnKey Expr
e12
    Annotation
oldAnn <- (Anns -> Annotation) -> StateT Anns IO Annotation
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets ((Anns -> Annotation) -> StateT Anns IO Annotation)
-> (Anns -> Annotation) -> StateT Anns IO Annotation
forall a b. (a -> b) -> a -> b
$ Annotation -> AnnKey -> Anns -> Annotation
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Annotation
annNone AnnKey
oldKey
    Expr
new_e <- [(String, Fixity)]
-> SrcSpan -> Expr -> Expr -> Fixity -> Expr -> StateT Anns IO Expr
mkOpAppRn [(String, Fixity)]
fs SrcSpan
loc' Expr
e12 Expr
op2 Fixity
fix2 Expr
e2
    let newKey :: AnnKey
newKey = Expr -> AnnKey
forall a. Constraints a => a -> AnnKey
mkAnnKey Expr
new_e
    Annotation -> AnnKey -> AnnKey -> StateT Anns IO ()
moveDelta Annotation
oldAnn AnnKey
oldKey AnnKey
newKey
    Expr -> StateT Anns IO Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> StateT Anns IO Expr) -> Expr -> StateT Anns IO Expr
forall a b. (a -> b) -> a -> b
$ SrcSpan -> HsExpr GhcPs -> Expr
forall l e. l -> e -> GenLocated l e
GHC.L SrcSpan
loc (XOpApp GhcPs -> Expr -> Expr -> Expr -> HsExpr GhcPs
forall p.
XOpApp p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
GHC.OpApp XOpApp GhcPs
x1 Expr
e11 Expr
op1 Expr
new_e)
  where
    loc' :: SrcSpan
loc' = Expr -> Expr -> SrcSpan
forall a b. (HasSrcSpan a, HasSrcSpan b) => a -> b -> SrcSpan
GHC.combineLocs Expr
e12 Expr
e2
    fix1 :: Fixity
fix1 = [(String, Fixity)] -> Expr -> Fixity
findFixity [(String, Fixity)]
fs Expr
op1
    (Bool
nofix_error, Bool
associate_right) = Fixity -> Fixity -> (Bool, Bool)
GHC.compareFixity Fixity
fix1 Fixity
fix2

---------------------------
--      (- neg_arg) `op` e2
mkOpAppRn [(String, Fixity)]
fs SrcSpan
loc e1 :: Expr
e1@(GHC.L SrcSpan
_ (GHC.NegApp XNegApp GhcPs
_ Expr
neg_arg SyntaxExpr GhcPs
neg_name)) Expr
op2 Fixity
fix2 Expr
e2
  | Bool
nofix_error =
    Expr -> StateT Anns IO Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan -> HsExpr GhcPs -> Expr
forall l e. l -> e -> GenLocated l e
GHC.L SrcSpan
loc (XOpApp GhcPs -> Expr -> Expr -> Expr -> HsExpr GhcPs
forall p.
XOpApp p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
GHC.OpApp NoExtField
XOpApp GhcPs
noExt Expr
e1 Expr
op2 Expr
e2))
  | Bool
associate_right =
    do
      let oldKey :: AnnKey
oldKey = Expr -> AnnKey
forall a. Constraints a => a -> AnnKey
mkAnnKey Expr
neg_arg
      Annotation
oldAnn <- (Anns -> Annotation) -> StateT Anns IO Annotation
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets ((Anns -> Annotation) -> StateT Anns IO Annotation)
-> (Anns -> Annotation) -> StateT Anns IO Annotation
forall a b. (a -> b) -> a -> b
$ Annotation -> AnnKey -> Anns -> Annotation
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Annotation
annNone AnnKey
oldKey
      Expr
new_e <- [(String, Fixity)]
-> SrcSpan -> Expr -> Expr -> Fixity -> Expr -> StateT Anns IO Expr
mkOpAppRn [(String, Fixity)]
fs SrcSpan
loc' Expr
neg_arg Expr
op2 Fixity
fix2 Expr
e2
      let newKey :: AnnKey
newKey = Expr -> AnnKey
forall a. Constraints a => a -> AnnKey
mkAnnKey Expr
new_e
      Annotation -> AnnKey -> AnnKey -> StateT Anns IO ()
moveDelta Annotation
oldAnn AnnKey
oldKey AnnKey
newKey
      let res :: Expr
res = SrcSpan -> HsExpr GhcPs -> Expr
forall l e. l -> e -> GenLocated l e
GHC.L SrcSpan
loc (XNegApp GhcPs -> Expr -> SyntaxExpr GhcPs -> HsExpr GhcPs
forall p. XNegApp p -> LHsExpr p -> SyntaxExpr p -> HsExpr p
GHC.NegApp NoExtField
XNegApp GhcPs
noExt Expr
new_e SyntaxExpr GhcPs
neg_name)
          key :: AnnKey
key = Expr -> AnnKey
forall a. Constraints a => a -> AnnKey
mkAnnKey Expr
res
          ak :: AnnKey
ak = SrcSpan -> AnnConName -> AnnKey
AnnKey (SrcSpan -> SrcSpan
srcSpanToAnnSpan SrcSpan
loc) (String -> AnnConName
CN String
"OpApp")
      Annotation
opAnn <- (Anns -> Annotation) -> StateT Anns IO Annotation
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets (Annotation -> Maybe Annotation -> Annotation
forall a. a -> Maybe a -> a
fromMaybe Annotation
annNone (Maybe Annotation -> Annotation)
-> (Anns -> Maybe Annotation) -> Anns -> Annotation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnnKey -> Anns -> Maybe Annotation
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup AnnKey
ak)
      Annotation
negAnns <- (Anns -> Annotation) -> StateT Anns IO Annotation
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets (Annotation -> Maybe Annotation -> Annotation
forall a. a -> Maybe a -> a
fromMaybe Annotation
annNone (Maybe Annotation -> Annotation)
-> (Anns -> Maybe Annotation) -> Anns -> Annotation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnnKey -> Anns -> Maybe Annotation
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Expr -> AnnKey
forall a. Constraints a => a -> AnnKey
mkAnnKey Expr
e1))
      (Anns -> Anns) -> StateT Anns IO ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify ((Anns -> Anns) -> StateT Anns IO ())
-> (Anns -> Anns) -> StateT Anns IO ()
forall a b. (a -> b) -> a -> b
$ AnnKey -> Annotation -> Anns -> Anns
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert AnnKey
key (Annotation
annNone {annEntryDelta :: DeltaPos
annEntryDelta = Annotation -> DeltaPos
annEntryDelta Annotation
opAnn, annsDP :: [(KeywordId, DeltaPos)]
annsDP = Annotation -> [(KeywordId, DeltaPos)]
annsDP Annotation
negAnns})
      (Anns -> Anns) -> StateT Anns IO ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify ((Anns -> Anns) -> StateT Anns IO ())
-> (Anns -> Anns) -> StateT Anns IO ()
forall a b. (a -> b) -> a -> b
$ AnnKey -> Anns -> Anns
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete (Expr -> AnnKey
forall a. Constraints a => a -> AnnKey
mkAnnKey Expr
e1)
      Expr -> StateT Anns IO Expr
forall (m :: * -> *) a. Monad m => a -> m a
return Expr
res
  where
    loc' :: SrcSpan
loc' = Expr -> Expr -> SrcSpan
forall a b. (HasSrcSpan a, HasSrcSpan b) => a -> b -> SrcSpan
GHC.combineLocs Expr
neg_arg Expr
e2
    (Bool
nofix_error, Bool
associate_right) = Fixity -> Fixity -> (Bool, Bool)
GHC.compareFixity Fixity
GHC.negateFixity Fixity
fix2

---------------------------
--      e1 `op` - neg_arg
mkOpAppRn [(String, Fixity)]
_ SrcSpan
loc Expr
e1 Expr
op1 Fixity
fix1 e2 :: Expr
e2@(GHC.L SrcSpan
_ GHC.NegApp {}) -- NegApp can occur on the right
  | Bool -> Bool
not Bool
associate_right -- We *want* right association
    =
    Expr -> StateT Anns IO Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> StateT Anns IO Expr) -> Expr -> StateT Anns IO Expr
forall a b. (a -> b) -> a -> b
$ SrcSpan -> HsExpr GhcPs -> Expr
forall l e. l -> e -> GenLocated l e
GHC.L SrcSpan
loc (XOpApp GhcPs -> Expr -> Expr -> Expr -> HsExpr GhcPs
forall p.
XOpApp p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
GHC.OpApp NoExtField
XOpApp GhcPs
noExt Expr
e1 Expr
op1 Expr
e2)
  where
    (Bool
_, Bool
associate_right) = Fixity -> Fixity -> (Bool, Bool)
GHC.compareFixity Fixity
fix1 Fixity
GHC.negateFixity

---------------------------
--      Default case
mkOpAppRn [(String, Fixity)]
_ SrcSpan
loc Expr
e1 Expr
op Fixity
_fix Expr
e2 -- Default case, no rearrangment
  =
  Expr -> StateT Anns IO Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> StateT Anns IO Expr) -> Expr -> StateT Anns IO Expr
forall a b. (a -> b) -> a -> b
$ SrcSpan -> HsExpr GhcPs -> Expr
forall l e. l -> e -> GenLocated l e
GHC.L SrcSpan
loc (XOpApp GhcPs -> Expr -> Expr -> Expr -> HsExpr GhcPs
forall p.
XOpApp p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
GHC.OpApp NoExtField
XOpApp GhcPs
noExt Expr
e1 Expr
op Expr
e2)

findFixity :: [(String, GHC.Fixity)] -> Expr -> GHC.Fixity
findFixity :: [(String, Fixity)] -> Expr -> Fixity
findFixity [(String, Fixity)]
fs Expr
r = [(String, Fixity)] -> String -> Fixity
askFix [(String, Fixity)]
fs (Expr -> String
getIdent Expr
r)

askFix :: [(String, GHC.Fixity)] -> String -> GHC.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
GHC.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, GHC.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, GHC.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)]
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)]
infixl_ Int
5 [String
".|."],
        Int -> [String] -> [(String, Fixity)]
infixr_ Int
5 [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
"<**>"],
        Int -> [String] -> [(String, Fixity)]
infix_ Int
4 [String
"elemP", String
"notElemP"],
        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, GHC.Fixity)]
infixr_ :: Int -> [String] -> [(String, Fixity)]
infixr_ = FixityDirection -> Int -> [String] -> [(String, Fixity)]
fixity FixityDirection
GHC.InfixR
infixl_ :: Int -> [String] -> [(String, Fixity)]
infixl_ = FixityDirection -> Int -> [String] -> [(String, Fixity)]
fixity FixityDirection
GHC.InfixL
infix_ :: Int -> [String] -> [(String, Fixity)]
infix_ = FixityDirection -> Int -> [String] -> [(String, Fixity)]
fixity FixityDirection
GHC.InfixN

-- Internal: help function for the above definitions.
fixity :: GHC.FixityDirection -> Int -> [String] -> [(String, GHC.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)