module HIndent.Ast.Role
  ( Role
  , mkRole
  ) where

import qualified GHC.Core.TyCon as GHC
import HIndent.Ast.NodeComments
import {-# SOURCE #-} HIndent.Pretty
import HIndent.Pretty.Combinators
import HIndent.Pretty.NodeComments

data Role
  = Nominal
  | Representational
  | Phantom

instance CommentExtraction Role where
  nodeComments :: Role -> NodeComments
nodeComments Role
Nominal = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []
  nodeComments Role
Representational = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []
  nodeComments Role
Phantom = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []

instance Pretty Role where
  pretty' :: Role -> Printer ()
pretty' Role
Nominal = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"nominal"
  pretty' Role
Representational = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"representational"
  pretty' Role
Phantom = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"phantom"

mkRole :: GHC.Role -> Role
mkRole :: Role -> Role
mkRole Role
GHC.Nominal = Role
Nominal
mkRole Role
GHC.Representational = Role
Representational
mkRole Role
GHC.Phantom = Role
Phantom