{-# LANGUAGE RecordWildCards #-} module HIndent.Ast.Declaration.Signature.Fixity ( Fixity , mkFixity ) where import qualified GHC.Types.Fixity as GHC import HIndent.Ast.Declaration.Signature.Fixity.Associativity import HIndent.Ast.NodeComments import {-# SOURCE #-} HIndent.Pretty import HIndent.Pretty.Combinators import HIndent.Pretty.NodeComments data Fixity = Fixity { Fixity -> Int level :: Int , Fixity -> Associativity associativity :: Associativity } instance CommentExtraction Fixity where nodeComments :: Fixity -> NodeComments nodeComments Fixity {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments NodeComments [] [] [] instance Pretty Fixity where pretty' :: Fixity -> Printer () pretty' Fixity {Int Associativity level :: Fixity -> Int associativity :: Fixity -> Associativity level :: Int associativity :: Associativity ..} = [Printer ()] -> Printer () spaced [Associativity -> Printer () forall a. Pretty a => a -> Printer () pretty Associativity associativity, HasCallStack => String -> Printer () String -> Printer () string (String -> Printer ()) -> String -> Printer () forall a b. (a -> b) -> a -> b $ Int -> String forall a. Show a => a -> String show Int level] mkFixity :: GHC.Fixity -> Fixity mkFixity :: Fixity -> Fixity mkFixity (GHC.Fixity SourceText _ Int level FixityDirection associativity) = Int -> Associativity -> Fixity Fixity Int level (FixityDirection -> Associativity mkAssociativity FixityDirection associativity)