{-# LANGUAGE CPP #-} module HIndent.Ast.Declaration.Signature.Inline.Spec ( InlineSpec , mkInlineSpec ) where import qualified GHC.Types.Basic as GHC import HIndent.Ast.NodeComments import {-# SOURCE #-} HIndent.Pretty import HIndent.Pretty.Combinators import HIndent.Pretty.NodeComments data InlineSpec = Inline | Inlinable | NoInline | Opaque instance CommentExtraction InlineSpec where nodeComments :: InlineSpec -> NodeComments nodeComments InlineSpec Inline = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments NodeComments [] [] [] nodeComments InlineSpec Inlinable = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments NodeComments [] [] [] nodeComments InlineSpec NoInline = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments NodeComments [] [] [] nodeComments InlineSpec Opaque = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments NodeComments [] [] [] instance Pretty InlineSpec where pretty' :: InlineSpec -> Printer () pretty' InlineSpec Inline = HasCallStack => String -> Printer () String -> Printer () string String "INLINE" pretty' InlineSpec Inlinable = HasCallStack => String -> Printer () String -> Printer () string String "INLINABLE" pretty' InlineSpec NoInline = HasCallStack => String -> Printer () String -> Printer () string String "NOINLINE" pretty' InlineSpec Opaque = HasCallStack => String -> Printer () String -> Printer () string String "OPAQUE" mkInlineSpec :: GHC.InlineSpec -> InlineSpec mkInlineSpec :: InlineSpec -> InlineSpec mkInlineSpec GHC.Inline {} = InlineSpec Inline mkInlineSpec GHC.Inlinable {} = InlineSpec Inlinable mkInlineSpec GHC.NoInline {} = InlineSpec NoInline mkInlineSpec InlineSpec GHC.NoUserInlinePrag = String -> InlineSpec forall a. HasCallStack => String -> a error String "NoUserInlinePrag is not supported" #if MIN_VERSION_ghc_lib_parser(9, 4, 1) mkInlineSpec GHC.Opaque {} = InlineSpec Opaque #endif