1 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
2 module Language.RNC.Fixity where
4 import Data.Semigroup hiding (option)
5 import Data.String (IsString(..))
6 import Prelude hiding (any)
7 import qualified Data.Bool as Bool
17 = Prefix { unifix_prece :: Precedence }
18 | Postfix { unifix_prece :: Precedence }
24 { infix_assoc :: Maybe Associativity
25 , infix_prece :: Precedence
28 infixL :: Precedence -> Infix
29 infixL = Infix (Just AssocL)
31 infixR :: Precedence -> Infix
32 infixR = Infix (Just AssocR)
34 infixB :: Side -> Precedence -> Infix
35 infixB = Infix . Just . AssocB
37 infixN :: Precedence -> Infix
38 infixN = Infix Nothing
46 -- | Given 'Precedence' and 'Associativity' of its parent operator,
47 -- and the operand 'Side' it is in,
48 -- return whether an 'Infix' operator
49 -- needs to be enclosed by parenthesis.
50 needsParenInfix :: (Infix, Side) -> Infix -> Bool
51 needsParenInfix (po, lr) op =
52 infix_prece op < infix_prece po
53 || infix_prece op == infix_prece po
57 case (lr, infix_assoc po) of
58 (_, Just AssocB{}) -> True
59 (SideL, Just AssocL) -> True
60 (SideR, Just AssocR) -> True
63 -- | If 'needsParenInfix' is 'True',
64 -- enclose the given 'IsString' by parenthesis,
65 -- otherwise returns the same 'IsString'.
67 (Semigroup s, IsString s) =>
71 pairInfix pair po op s =
72 if needsParenInfix po op
74 let (o,c) = textPair pair in
75 fromString o <> s <> fromString c
78 -- * Type 'Precedence'
81 -- ** Class 'PrecedenceOf'
82 class PrecedenceOf a where
83 precedence :: a -> Precedence
84 instance PrecedenceOf Fixity where
85 precedence (Fixity1 uni) = precedence uni
86 precedence (Fixity2 inf) = precedence inf
87 instance PrecedenceOf Unifix where
88 precedence = unifix_prece
89 instance PrecedenceOf Infix where
90 precedence = infix_prece
92 -- * Type 'Associativity'
94 = AssocL -- ^ Associate to the left: @a ¹ b ² c == (a ¹ b) ² c@
95 | AssocR -- ^ Associate to the right: @a ¹ b ² c == a ¹ (b ² c)@
96 | AssocB Side -- ^ Associate to both sides, but to 'Side' when reading.
111 textPair :: Pair -> (String,String)
112 textPair PairParen = ("(",")")
113 textPair PairBrace = ("{","}")