-- |
-- Operators fixity and associativity
--
module Language.PureScript.AST.Operators where

import Prelude

import Codec.Serialise (Serialise)
import GHC.Generics (Generic)
import Control.DeepSeq (NFData)
import Data.Aeson ((.=))
import Data.Aeson qualified as A

import Language.PureScript.Crash (internalError)

-- |
-- A precedence level for an infix operator
--
type Precedence = Integer

-- |
-- Associativity for infix operators
--
data Associativity = Infixl | Infixr | Infix
  deriving (Int -> Associativity -> ShowS
[Associativity] -> ShowS
Associativity -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Associativity] -> ShowS
$cshowList :: [Associativity] -> ShowS
show :: Associativity -> String
$cshow :: Associativity -> String
showsPrec :: Int -> Associativity -> ShowS
$cshowsPrec :: Int -> Associativity -> ShowS
Show, Associativity -> Associativity -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Associativity -> Associativity -> Bool
$c/= :: Associativity -> Associativity -> Bool
== :: Associativity -> Associativity -> Bool
$c== :: Associativity -> Associativity -> Bool
Eq, Eq Associativity
Associativity -> Associativity -> Bool
Associativity -> Associativity -> Ordering
Associativity -> Associativity -> Associativity
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Associativity -> Associativity -> Associativity
$cmin :: Associativity -> Associativity -> Associativity
max :: Associativity -> Associativity -> Associativity
$cmax :: Associativity -> Associativity -> Associativity
>= :: Associativity -> Associativity -> Bool
$c>= :: Associativity -> Associativity -> Bool
> :: Associativity -> Associativity -> Bool
$c> :: Associativity -> Associativity -> Bool
<= :: Associativity -> Associativity -> Bool
$c<= :: Associativity -> Associativity -> Bool
< :: Associativity -> Associativity -> Bool
$c< :: Associativity -> Associativity -> Bool
compare :: Associativity -> Associativity -> Ordering
$ccompare :: Associativity -> Associativity -> Ordering
Ord, forall x. Rep Associativity x -> Associativity
forall x. Associativity -> Rep Associativity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Associativity x -> Associativity
$cfrom :: forall x. Associativity -> Rep Associativity x
Generic)

instance NFData Associativity
instance Serialise Associativity

showAssoc :: Associativity -> String
showAssoc :: Associativity -> String
showAssoc Associativity
Infixl = String
"infixl"
showAssoc Associativity
Infixr = String
"infixr"
showAssoc Associativity
Infix  = String
"infix"

readAssoc :: String -> Associativity
readAssoc :: String -> Associativity
readAssoc String
"infixl" = Associativity
Infixl
readAssoc String
"infixr" = Associativity
Infixr
readAssoc String
"infix"  = Associativity
Infix
readAssoc String
_ = forall a. HasCallStack => String -> a
internalError String
"readAssoc: no parse"

instance A.ToJSON Associativity where
  toJSON :: Associativity -> Value
toJSON = forall a. ToJSON a => a -> Value
A.toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. Associativity -> String
showAssoc

instance A.FromJSON Associativity where
  parseJSON :: Value -> Parser Associativity
parseJSON = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Associativity
readAssoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => Value -> Parser a
A.parseJSON

-- |
-- Fixity data for infix operators
--
data Fixity = Fixity Associativity Precedence
  deriving (Int -> Fixity -> ShowS
[Fixity] -> ShowS
Fixity -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Fixity] -> ShowS
$cshowList :: [Fixity] -> ShowS
show :: Fixity -> String
$cshow :: Fixity -> String
showsPrec :: Int -> Fixity -> ShowS
$cshowsPrec :: Int -> Fixity -> ShowS
Show, Fixity -> Fixity -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Fixity -> Fixity -> Bool
$c/= :: Fixity -> Fixity -> Bool
== :: Fixity -> Fixity -> Bool
$c== :: Fixity -> Fixity -> Bool
Eq, Eq Fixity
Fixity -> Fixity -> Bool
Fixity -> Fixity -> Ordering
Fixity -> Fixity -> Fixity
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Fixity -> Fixity -> Fixity
$cmin :: Fixity -> Fixity -> Fixity
max :: Fixity -> Fixity -> Fixity
$cmax :: Fixity -> Fixity -> Fixity
>= :: Fixity -> Fixity -> Bool
$c>= :: Fixity -> Fixity -> Bool
> :: Fixity -> Fixity -> Bool
$c> :: Fixity -> Fixity -> Bool
<= :: Fixity -> Fixity -> Bool
$c<= :: Fixity -> Fixity -> Bool
< :: Fixity -> Fixity -> Bool
$c< :: Fixity -> Fixity -> Bool
compare :: Fixity -> Fixity -> Ordering
$ccompare :: Fixity -> Fixity -> Ordering
Ord, forall x. Rep Fixity x -> Fixity
forall x. Fixity -> Rep Fixity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Fixity x -> Fixity
$cfrom :: forall x. Fixity -> Rep Fixity x
Generic)

instance NFData Fixity
instance Serialise Fixity

instance A.ToJSON Fixity where
  toJSON :: Fixity -> Value
toJSON (Fixity Associativity
associativity Precedence
precedence) =
    [Pair] -> Value
A.object [ Key
"associativity" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Associativity
associativity
             , Key
"precedence" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Precedence
precedence
             ]