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

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

import CoAxiom
import GHC
import Ormolu.Printer.Combinators
import Ormolu.Printer.Meat.Common

p_roleAnnot :: RoleAnnotDecl GhcPs -> R ()
p_roleAnnot :: RoleAnnotDecl GhcPs -> R ()
p_roleAnnot = \case
  RoleAnnotDecl XCRoleAnnotDecl GhcPs
NoExtField Located (IdP GhcPs)
l_name [Located (Maybe Role)]
anns -> Located RdrName -> [Located (Maybe Role)] -> R ()
p_roleAnnot' Located (IdP GhcPs)
Located RdrName
l_name [Located (Maybe Role)]
anns
  XRoleAnnotDecl XXRoleAnnotDecl GhcPs
x -> NoExtCon -> R ()
forall a. NoExtCon -> a
noExtCon NoExtCon
XXRoleAnnotDecl GhcPs
x

p_roleAnnot' :: Located RdrName -> [Located (Maybe Role)] -> R ()
p_roleAnnot' :: Located RdrName -> [Located (Maybe Role)] -> R ()
p_roleAnnot' Located RdrName
l_name [Located (Maybe Role)]
anns = do
  Text -> R ()
txt Text
"type role"
  R ()
breakpoint
  R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
    Located RdrName -> R ()
p_rdrName Located RdrName
l_name
    R ()
breakpoint
    let p_role' :: Maybe Role -> R ()
p_role' = R () -> (Role -> R ()) -> Maybe Role -> R ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> R ()
txt Text
"_") Role -> R ()
p_role
    R () -> R ()
inci (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R ()
-> (Located (Maybe Role) -> R ()) -> [Located (Maybe Role)] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
breakpoint (R () -> R ()
sitcc (R () -> R ())
-> (Located (Maybe Role) -> R ()) -> Located (Maybe Role) -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Role -> R ()) -> Located (Maybe Role) -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' Maybe Role -> R ()
p_role') [Located (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"