-----------------------------------------------------------------------------
-- |
-- Module      :  Disco.Pretty.Prec
-- Copyright   :  disco team and contributors
-- Maintainer  :  byorgey@gmail.com
--
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Precedence and associativity for pretty-printing.
--
-----------------------------------------------------------------------------

module Disco.Pretty.Prec where

import           Disco.Syntax.Operators

-- Types for storing precedence + associativity together

type Prec = Int

data PA = PA Prec BFixity
  deriving (Int -> PA -> ShowS
[PA] -> ShowS
PA -> String
(Int -> PA -> ShowS)
-> (PA -> String) -> ([PA] -> ShowS) -> Show PA
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PA] -> ShowS
$cshowList :: [PA] -> ShowS
show :: PA -> String
$cshow :: PA -> String
showsPrec :: Int -> PA -> ShowS
$cshowsPrec :: Int -> PA -> ShowS
Show, PA -> PA -> Bool
(PA -> PA -> Bool) -> (PA -> PA -> Bool) -> Eq PA
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PA -> PA -> Bool
$c/= :: PA -> PA -> Bool
== :: PA -> PA -> Bool
$c== :: PA -> PA -> Bool
Eq)

instance Ord PA where
  compare :: PA -> PA -> Ordering
compare (PA Int
p1 BFixity
a1) (PA Int
p2 BFixity
a2) = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
p1 Int
p2 Ordering -> Ordering -> Ordering
forall a. Monoid a => a -> a -> a
`mappend` (if BFixity
a1 BFixity -> BFixity -> Bool
forall a. Eq a => a -> a -> Bool
== BFixity
a2 then Ordering
EQ else Ordering
LT)

-- Standard precedence levels

initPA :: PA
initPA :: PA
initPA = Int -> BFixity -> PA
PA Int
0 BFixity
InL

ascrPA :: PA
ascrPA :: PA
ascrPA = Int -> BFixity -> PA
PA Int
1 BFixity
InL

funPA :: PA
funPA :: PA
funPA = Int -> BFixity -> PA
PA Int
funPrec BFixity
InL

rPA :: Int -> PA
rPA :: Int -> PA
rPA Int
n = Int -> BFixity -> PA
PA Int
n BFixity
InR

tarrPA, taddPA, tmulPA, tfunPA :: PA
tarrPA :: PA
tarrPA = Int -> PA
rPA Int
1
taddPA :: PA
taddPA = Int -> PA
rPA Int
6
tmulPA :: PA
tmulPA = Int -> PA
rPA Int
7
tfunPA :: PA
tfunPA = Int -> BFixity -> PA
PA Int
9 BFixity
InL

-- Converting UOp and BOp

ugetPA :: UOp -> PA
ugetPA :: UOp -> PA
ugetPA UOp
op = Int -> BFixity -> PA
PA (UOp -> Int
uPrec UOp
op) BFixity
In

getPA :: BOp -> PA
getPA :: BOp -> PA
getPA BOp
op = Int -> BFixity -> PA
PA (BOp -> Int
bPrec BOp
op) (BOp -> BFixity
assoc BOp
op)