{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Ormolu.Printer.Meat.Declaration.Rule
( p_ruleDecls,
)
where
import Control.Monad (unless)
import GHC.Hs
import GHC.Types.Basic
import GHC.Types.SourceText
import Ormolu.Printer.Combinators
import Ormolu.Printer.Meat.Common
import Ormolu.Printer.Meat.Declaration.Signature
import Ormolu.Printer.Meat.Declaration.Value
import Ormolu.Printer.Meat.Type
p_ruleDecls :: RuleDecls GhcPs -> R ()
p_ruleDecls :: RuleDecls GhcPs -> R ()
p_ruleDecls (HsRules XCRuleDecls GhcPs
_ [LRuleDecl GhcPs]
xs) =
Text -> R () -> R ()
pragma Text
"RULES" (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R ()
-> (GenLocated SrcSpanAnnA (RuleDecl GhcPs) -> R ())
-> [GenLocated SrcSpanAnnA (RuleDecl GhcPs)]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
breakpoint (R () -> R ()
sitcc (R () -> R ())
-> (GenLocated SrcSpanAnnA (RuleDecl GhcPs) -> R ())
-> GenLocated SrcSpanAnnA (RuleDecl GhcPs)
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RuleDecl GhcPs -> R ())
-> GenLocated SrcSpanAnnA (RuleDecl GhcPs) -> R ()
forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' RuleDecl GhcPs -> R ()
p_ruleDecl) [LRuleDecl GhcPs]
[GenLocated SrcSpanAnnA (RuleDecl GhcPs)]
xs
p_ruleDecl :: RuleDecl GhcPs -> R ()
p_ruleDecl :: RuleDecl GhcPs -> R ()
p_ruleDecl (HsRule XHsRule GhcPs
_ XRec GhcPs RuleName
ruleName Activation
activation Maybe [LHsTyVarBndr () (NoGhcTc GhcPs)]
tyvars [LRuleBndr GhcPs]
ruleBndrs XRec GhcPs (HsExpr GhcPs)
lhs XRec GhcPs (HsExpr GhcPs)
rhs) = do
GenLocated (SrcAnn NoEpAnns) RuleName -> (RuleName -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs RuleName
GenLocated (SrcAnn NoEpAnns) RuleName
ruleName RuleName -> R ()
p_ruleName
R ()
space
Activation -> R ()
p_activation Activation
activation
R ()
space
case Maybe [LHsTyVarBndr () (NoGhcTc GhcPs)]
tyvars of
Maybe [LHsTyVarBndr () (NoGhcTc GhcPs)]
Nothing -> () -> R ()
forall a. a -> R a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just [LHsTyVarBndr () (NoGhcTc GhcPs)]
xs -> do
ForAllVisibility
-> (HsTyVarBndr () GhcPs -> R ())
-> [GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)]
-> R ()
forall l a.
HasSrcSpan l =>
ForAllVisibility -> (a -> R ()) -> [GenLocated l a] -> R ()
p_forallBndrs ForAllVisibility
ForAllInvis HsTyVarBndr () GhcPs -> R ()
forall flag. IsTyVarBndrFlag flag => HsTyVarBndr flag GhcPs -> R ()
p_hsTyVarBndr [LHsTyVarBndr () (NoGhcTc GhcPs)]
[GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)]
xs
R ()
space
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([GenLocated (SrcAnn NoEpAnns) (RuleBndr GhcPs)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LRuleBndr GhcPs]
[GenLocated (SrcAnn NoEpAnns) (RuleBndr GhcPs)]
ruleBndrs) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
ForAllVisibility
-> (RuleBndr GhcPs -> R ())
-> [GenLocated (SrcAnn NoEpAnns) (RuleBndr GhcPs)]
-> R ()
forall l a.
HasSrcSpan l =>
ForAllVisibility -> (a -> R ()) -> [GenLocated l a] -> R ()
p_forallBndrs ForAllVisibility
ForAllInvis RuleBndr GhcPs -> R ()
p_ruleBndr [LRuleBndr GhcPs]
[GenLocated (SrcAnn NoEpAnns) (RuleBndr GhcPs)]
ruleBndrs
R ()
breakpoint
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
lhs HsExpr GhcPs -> R ()
p_hsExpr
R ()
space
R ()
equals
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
R ()
breakpoint
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
rhs HsExpr GhcPs -> R ()
p_hsExpr
p_ruleName :: RuleName -> R ()
p_ruleName :: RuleName -> R ()
p_ruleName RuleName
name = HsLit GhcPs -> R ()
forall a. Outputable a => a -> R ()
atom (XHsString GhcPs -> RuleName -> HsLit GhcPs
forall x. XHsString x -> RuleName -> HsLit x
HsString XHsString GhcPs
SourceText
NoSourceText RuleName
name :: HsLit GhcPs)
p_ruleBndr :: RuleBndr GhcPs -> R ()
p_ruleBndr :: RuleBndr GhcPs -> R ()
p_ruleBndr = \case
RuleBndr XCRuleBndr GhcPs
_ LIdP GhcPs
x -> LocatedN RdrName -> R ()
p_rdrName LIdP GhcPs
LocatedN RdrName
x
RuleBndrSig XRuleBndrSig GhcPs
_ LIdP GhcPs
x HsPS {XHsPS GhcPs
LHsType GhcPs
hsps_ext :: XHsPS GhcPs
hsps_body :: LHsType GhcPs
hsps_ext :: forall pass. HsPatSigType pass -> XHsPS pass
hsps_body :: forall pass. HsPatSigType pass -> LHsType pass
..} -> BracketStyle -> R () -> R ()
parens BracketStyle
N (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
LocatedN RdrName -> R ()
p_rdrName LIdP GhcPs
LocatedN RdrName
x
LHsSigType GhcPs -> R ()
p_typeAscription (LHsType GhcPs -> LHsSigType GhcPs
lhsTypeToSigType LHsType GhcPs
hsps_body)