{-# LANGUAGE CPP #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ViewPatterns #-}
module Refact.Fixity (applyFixities) where

import SrcLoc

import Refact.Utils
import BasicTypes (Fixity(..), defaultFixity, compareFixity, negateFixity, FixityDirection(..), SourceText(..))

#if __GLASGOW_HASKELL__ >= 810
import GHC.Hs
#else
import HsExpr
import HsExtension hiding (noExt)
#endif

import ApiAnnotation
import RdrName
import OccName
import Data.Generics hiding (Fixity)
import Data.List
import Data.Maybe
import Language.Haskell.GHC.ExactPrint.Types hiding (GhcPs, GhcTc, GhcRn)

import Control.Monad.Trans.State
import qualified Data.Map as Map
import Data.Tuple

-- | 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 ((LHsExpr GhcPs -> StateT Anns IO (LHsExpr GhcPs))
-> a -> StateT Anns IO a
forall (m :: * -> *) a b.
(Monad m, Typeable a, Typeable b) =>
(b -> m b) -> a -> m a
mkM LHsExpr GhcPs -> StateT Anns IO (LHsExpr GhcPs)
expFix) Module
m) Anns
as

expFix :: LHsExpr GhcPs -> StateT Anns IO (LHsExpr GhcPs)
expFix :: LHsExpr GhcPs -> StateT Anns IO (LHsExpr GhcPs)
expFix (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
-> StateT Anns IO (LHsExpr GhcPs)
mkOpAppRn [(String, Fixity)]
baseFixities SrcSpan
loc LHsExpr GhcPs
l LHsExpr GhcPs
op ([(String, Fixity)] -> LHsExpr GhcPs -> Fixity
findFixity [(String, Fixity)]
baseFixities LHsExpr GhcPs
op) LHsExpr GhcPs
r

expFix LHsExpr GhcPs
e = LHsExpr GhcPs -> StateT Anns IO (LHsExpr GhcPs)
forall (m :: * -> *) a. Monad m => a -> m a
return LHsExpr GhcPs
e

getIdent :: Expr -> 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 LHsExpr GhcPs
_ = 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
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, 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)
          -> StateT Anns IO (LHsExpr GhcPs)

-- (e11 `op1` e12) `op2` e2
mkOpAppRn :: [(String, Fixity)]
-> SrcSpan
-> LHsExpr GhcPs
-> LHsExpr GhcPs
-> Fixity
-> LHsExpr GhcPs
-> StateT Anns IO (LHsExpr GhcPs)
mkOpAppRn [(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
  | Bool
nofix_error
  = LHsExpr GhcPs -> StateT Anns IO (LHsExpr GhcPs)
forall (m :: * -> *) a. Monad m => a -> m a
return (LHsExpr GhcPs -> StateT Anns IO (LHsExpr GhcPs))
-> LHsExpr GhcPs -> StateT Anns IO (LHsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ 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 = do
    let oldKey :: AnnKey
oldKey = LHsExpr GhcPs -> AnnKey
forall a. Constraints a => a -> AnnKey
mkAnnKey LHsExpr GhcPs
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
    LHsExpr GhcPs
new_e <- [(String, Fixity)]
-> SrcSpan
-> LHsExpr GhcPs
-> LHsExpr GhcPs
-> Fixity
-> LHsExpr GhcPs
-> StateT Anns IO (LHsExpr GhcPs)
mkOpAppRn [(String, Fixity)]
fs SrcSpan
loc' LHsExpr GhcPs
e12 LHsExpr GhcPs
op2 Fixity
fix2 LHsExpr GhcPs
e2
    let newKey :: AnnKey
newKey = LHsExpr GhcPs -> AnnKey
forall a. Constraints a => a -> AnnKey
mkAnnKey LHsExpr GhcPs
new_e
    Annotation -> AnnKey -> AnnKey -> StateT Anns IO ()
moveDelta Annotation
oldAnn AnnKey
oldKey AnnKey
newKey
    LHsExpr GhcPs -> StateT Anns IO (LHsExpr GhcPs)
forall (m :: * -> *) a. Monad m => a -> m a
return (LHsExpr GhcPs -> StateT Anns IO (LHsExpr GhcPs))
-> LHsExpr GhcPs -> StateT Anns IO (LHsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ 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 LHsExpr GhcPs
new_e)
  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
    (Bool
nofix_error, Bool
associate_right) = Fixity -> Fixity -> (Bool, Bool)
compareFixity Fixity
fix1 Fixity
fix2

---------------------------
--      (- neg_arg) `op` e2
mkOpAppRn [(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
  | Bool
nofix_error
  = LHsExpr GhcPs -> StateT Anns IO (LHsExpr GhcPs)
forall (m :: * -> *) a. Monad m => a -> m a
return (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
  = do
      let oldKey :: AnnKey
oldKey = LHsExpr GhcPs -> AnnKey
forall a. Constraints a => a -> AnnKey
mkAnnKey LHsExpr GhcPs
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
      LHsExpr GhcPs
new_e <- [(String, Fixity)]
-> SrcSpan
-> LHsExpr GhcPs
-> LHsExpr GhcPs
-> Fixity
-> LHsExpr GhcPs
-> StateT Anns IO (LHsExpr GhcPs)
mkOpAppRn [(String, Fixity)]
fs SrcSpan
loc' LHsExpr GhcPs
neg_arg LHsExpr GhcPs
op2 Fixity
fix2 LHsExpr GhcPs
e2
      let newKey :: AnnKey
newKey = LHsExpr GhcPs -> AnnKey
forall a. Constraints a => a -> AnnKey
mkAnnKey LHsExpr GhcPs
new_e
      Annotation -> AnnKey -> AnnKey -> StateT Anns IO ()
moveDelta Annotation
oldAnn AnnKey
oldKey AnnKey
newKey
      let res :: LHsExpr GhcPs
res = 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 LHsExpr GhcPs
new_e SyntaxExpr GhcPs
neg_name)
          key :: AnnKey
key = LHsExpr GhcPs -> AnnKey
forall a. Constraints a => a -> AnnKey
mkAnnKey LHsExpr GhcPs
res
          ak :: AnnKey
ak  = SrcSpan -> AnnConName -> AnnKey
AnnKey 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 (LHsExpr GhcPs -> AnnKey
forall a. Constraints a => a -> AnnKey
mkAnnKey LHsExpr GhcPs
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 (LHsExpr GhcPs -> AnnKey
forall a. Constraints a => a -> AnnKey
mkAnnKey LHsExpr GhcPs
e1)
      LHsExpr GhcPs -> StateT Anns IO (LHsExpr GhcPs)
forall (m :: * -> *) a. Monad m => a -> m a
return LHsExpr GhcPs
res

  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
    (Bool
nofix_error, Bool
associate_right) = Fixity -> Fixity -> (Bool, Bool)
compareFixity Fixity
negateFixity Fixity
fix2

---------------------------
--      e1 `op` - neg_arg
mkOpAppRn [(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
  | Bool -> Bool
not Bool
associate_right                 -- We *want* right association
  = LHsExpr GhcPs -> StateT Anns IO (LHsExpr GhcPs)
forall (m :: * -> *) a. Monad m => a -> m a
return (LHsExpr GhcPs -> StateT Anns IO (LHsExpr GhcPs))
-> LHsExpr GhcPs -> StateT Anns IO (LHsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ 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)
  where
    (Bool
_, Bool
associate_right) = Fixity -> Fixity -> (Bool, Bool)
compareFixity Fixity
fix1 Fixity
negateFixity

---------------------------
--      Default case
mkOpAppRn [(String, Fixity)]
_ SrcSpan
loc LHsExpr GhcPs
e1 LHsExpr GhcPs
op Fixity
_fix LHsExpr GhcPs
e2                  -- Default case, no rearrangment
  = LHsExpr GhcPs -> StateT Anns IO (LHsExpr GhcPs)
forall (m :: * -> *) a. Monad m => a -> m a
return (LHsExpr GhcPs -> StateT Anns IO (LHsExpr GhcPs))
-> LHsExpr GhcPs -> StateT Anns IO (LHsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ 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)

findFixity :: [(String, Fixity)] -> Expr -> 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)

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)]
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,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

-- Internal: help function for the above definitions.
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)