{-# LANGUAGE DeriveDataTypeable #-}
{-# OPTIONS_GHC -Wno-dodgy-exports #-} -- For re-export of GHC.Hs.Basic instances

-- | Fixity
module GHC.Types.Fixity
   ( Fixity (..)
   , FixityDirection (..)
   , LexicalFixity (..)
   , maxPrecedence
   , minPrecedence
   , defaultFixity
   , negateFixity
   , funTyFixity
   , compareFixity
   , module GHC.Hs.Basic
   )
where

import GHC.Prelude

import Language.Haskell.Syntax.Basic (LexicalFixity(..), FixityDirection(..), Fixity(..) )
import GHC.Hs.Basic () -- For instances only

------------------------

maxPrecedence, minPrecedence :: Int
maxPrecedence :: Int
maxPrecedence = Int
9
minPrecedence :: Int
minPrecedence = Int
0

defaultFixity :: Fixity
defaultFixity :: Fixity
defaultFixity = Int -> FixityDirection -> Fixity
Fixity Int
maxPrecedence FixityDirection
InfixL

negateFixity, funTyFixity :: Fixity
-- Wired-in fixities
negateFixity :: Fixity
negateFixity = Int -> FixityDirection -> Fixity
Fixity Int
6 FixityDirection
InfixL  -- Fixity of unary negate
funTyFixity :: Fixity
funTyFixity  = Int -> FixityDirection -> Fixity
Fixity (-Int
1) FixityDirection
InfixR  -- Fixity of '->', see #15235

{-
Consider

\begin{verbatim}
        a `op1` b `op2` c
\end{verbatim}
@(compareFixity op1 op2)@ tells which way to arrange application, or
whether there's an error.
-}

compareFixity :: Fixity -> Fixity
              -> (Bool,         -- Error please
                  Bool)         -- Associate to the right: a op1 (b op2 c)
compareFixity :: Fixity -> Fixity -> (Bool, Bool)
compareFixity (Fixity Int
prec1 FixityDirection
dir1) (Fixity Int
prec2 FixityDirection
dir2)
  = case Int
prec1 Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Int
prec2 of
        Ordering
GT -> (Bool, Bool)
left
        Ordering
LT -> (Bool, Bool)
right
        Ordering
EQ -> case (FixityDirection
dir1, FixityDirection
dir2) of
                        (FixityDirection
InfixR, FixityDirection
InfixR) -> (Bool, Bool)
right
                        (FixityDirection
InfixL, FixityDirection
InfixL) -> (Bool, Bool)
left
                        (FixityDirection, FixityDirection)
_                -> (Bool, Bool)
error_please
  where
    right :: (Bool, Bool)
right        = (Bool
False, Bool
True)
    left :: (Bool, Bool)
left         = (Bool
False, Bool
False)
    error_please :: (Bool, Bool)
error_please = (Bool
True,  Bool
False)