{-# 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