{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}

-- | Rendering of Role annotation declarations.
module Ormolu.Printer.Meat.Declaration.RoleAnnotation
  ( p_roleAnnot,
  )
where

import GHC.Core.Coercion.Axiom
import GHC.Hs hiding (anns)
import GHC.Types.Name.Reader
import Ormolu.Printer.Combinators
import Ormolu.Printer.Meat.Common

p_roleAnnot :: RoleAnnotDecl GhcPs -> R ()
p_roleAnnot :: RoleAnnotDecl GhcPs -> R ()
p_roleAnnot (RoleAnnotDecl XCRoleAnnotDecl GhcPs
_ LIdP GhcPs
l_name [XRec GhcPs (Maybe Role)]
anns) = LocatedN RdrName -> [XRec GhcPs (Maybe Role)] -> R ()
p_roleAnnot' LIdP GhcPs
l_name [XRec GhcPs (Maybe Role)]
anns

p_roleAnnot' :: LocatedN RdrName -> [XRec GhcPs (Maybe Role)] -> R ()
p_roleAnnot' :: LocatedN RdrName -> [XRec GhcPs (Maybe Role)] -> R ()
p_roleAnnot' LocatedN RdrName
l_name [XRec GhcPs (Maybe Role)]
anns = do
  Text -> R ()
txt Text
"type role"
  R ()
breakpoint
  R () -> R ()
inci forall a b. (a -> b) -> a -> b
$ do
    LocatedN RdrName -> R ()
p_rdrName LocatedN RdrName
l_name
    R ()
breakpoint
    let p_role' :: Maybe Role -> R ()
p_role' = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> R ()
txt Text
"_") Role -> R ()
p_role
    R () -> R ()
inci forall b c a. (b -> c) -> (a -> b) -> a -> c
. R () -> R ()
sitcc forall a b. (a -> b) -> a -> b
$ forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
breakpoint (R () -> R ()
sitcc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' Maybe Role -> R ()
p_role') [XRec GhcPs (Maybe Role)]
anns

p_role :: Role -> R ()
p_role :: Role -> R ()
p_role = \case
  Role
Nominal -> Text -> R ()
txt Text
"nominal"
  Role
Representational -> Text -> R ()
txt Text
"representational"
  Role
Phantom -> Text -> R ()
txt Text
"phantom"