    -- |
    -- Module      :  Cryptol.Parser.Fixity
    -- Copyright   :  (c) 2013-2016 Galois, Inc.
    -- License     :  BSD3
    -- Maintainer  :  cryptol@galois.com
    -- Stability   :  provisional
    -- Portability :  portable

    {-# LANGUAGE Safe #-}

    {-# LANGUAGE DeriveAnyClass #-}
    {-# LANGUAGE DeriveGeneric #-}
    module Cryptol.Parser.Fixity
      ( Fixity(..)
      , defaultFixity
      , FixityCmp(..)
      , compareFixity
      ) where

    import Cryptol.Utils.PP

    import GHC.Generics (Generic)
    import Control.DeepSeq

    data Fixity = Fixity { Fixity -> Assoc
    fAssoc :: !Assoc
                         , Fixity -> Int
    fLevel :: !Int
                         } deriving (Fixity -> Fixity -> Bool
    (Fixity -> Fixity -> Bool)
    -> (Fixity -> Fixity -> Bool) -> Eq Fixity
    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, (forall x. Fixity -> Rep Fixity x)
    -> (forall x. Rep Fixity x -> Fixity) -> Generic Fixity
    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, Fixity -> ()
    (Fixity -> ()) -> NFData Fixity
    forall a. (a -> ()) -> NFData a
    rnf :: Fixity -> ()
    $crnf :: Fixity -> ()
    NFData, Int -> Fixity -> ShowS
    [Fixity] -> ShowS
    Fixity -> String
    (Int -> Fixity -> ShowS)
    -> (Fixity -> String) -> ([Fixity] -> ShowS) -> Show Fixity
    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)

    data FixityCmp = FCError
                   | FCLeft
                   | FCRight
                     deriving (Int -> FixityCmp -> ShowS
    [FixityCmp] -> ShowS
    FixityCmp -> String
    (Int -> FixityCmp -> ShowS)
    -> (FixityCmp -> String)
    -> ([FixityCmp] -> ShowS)
    -> Show FixityCmp
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [FixityCmp] -> ShowS
    $cshowList :: [FixityCmp] -> ShowS
    show :: FixityCmp -> String
    $cshow :: FixityCmp -> String
    showsPrec :: Int -> FixityCmp -> ShowS
    $cshowsPrec :: Int -> FixityCmp -> ShowS
    Show, FixityCmp -> FixityCmp -> Bool
    (FixityCmp -> FixityCmp -> Bool)
    -> (FixityCmp -> FixityCmp -> Bool) -> Eq FixityCmp
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: FixityCmp -> FixityCmp -> Bool
    $c/= :: FixityCmp -> FixityCmp -> Bool
    == :: FixityCmp -> FixityCmp -> Bool
    $c== :: FixityCmp -> FixityCmp -> Bool
    Eq)

    compareFixity :: Fixity -> Fixity -> FixityCmp
    compareFixity :: Fixity -> Fixity -> FixityCmp
    compareFixity (Fixity a1 :: Assoc
    a1 p1 :: Int
    p1) (Fixity a2 :: Assoc
    a2 p2 :: Int
    p2) =
      case Int -> Int -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare Int
    p1 Int
    p2 of
        GT -> FixityCmp
    FCLeft
        LT -> FixityCmp
    FCRight
        EQ -> case (Assoc
    a1, Assoc
    a2) of
                (LeftAssoc, LeftAssoc)   -> FixityCmp
    FCLeft
                (RightAssoc, RightAssoc) -> FixityCmp
    FCRight
                _                        -> FixityCmp
    FCError

    -- | The fixity used when none is provided.
    defaultFixity :: Fixity
    defaultFixity :: Fixity
    defaultFixity = Assoc -> Int -> Fixity
    Fixity Assoc
    LeftAssoc 100

    instance PP Fixity where
      ppPrec :: Int -> Fixity -> Doc
    ppPrec _ (Fixity assoc :: Assoc
    assoc level :: Int
    level) =
        String -> Doc
    text "precedence" Doc -> Doc -> Doc
    <+> Int -> Doc
    int Int
    level Doc -> Doc -> Doc
    <.> Doc
    comma Doc -> Doc -> Doc
    <+> Assoc -> Doc
    forall a. PP a => a -> Doc
    pp Assoc
    assoc