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

module Ormolu.Printer.Meat.Declaration.Rule
  ( p_ruleDecls,
  )
where

import BasicTypes
import Control.Monad (unless)
import GHC
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
import Ormolu.Utils

p_ruleDecls :: RuleDecls GhcPs -> R ()
p_ruleDecls :: RuleDecls GhcPs -> R ()
p_ruleDecls = \case
  HsRules NoExt _ xs :: [LRuleDecl GhcPs]
xs ->
    Text -> R () -> R ()
pragma "RULES" (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 () -> (LRuleDecl GhcPs -> R ()) -> [LRuleDecl GhcPs] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
breakpoint (R () -> R ()
sitcc (R () -> R ())
-> (LRuleDecl GhcPs -> R ()) -> LRuleDecl GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RuleDecl GhcPs -> R ()) -> LRuleDecl GhcPs -> R ()
forall a. Data a => (a -> R ()) -> Located a -> R ()
located' RuleDecl GhcPs -> R ()
p_ruleDecl) [LRuleDecl GhcPs]
xs
  XRuleDecls NoExt -> String -> R ()
forall a. String -> a
notImplemented "XRuleDecls"

p_ruleDecl :: RuleDecl GhcPs -> R ()
p_ruleDecl :: RuleDecl GhcPs -> R ()
p_ruleDecl = \case
  HsRule NoExt ruleName :: Located (SourceText, RuleName)
ruleName activation :: Activation
activation tyvars :: Maybe [LHsTyVarBndr (NoGhcTc GhcPs)]
tyvars ruleBndrs :: [LRuleBndr GhcPs]
ruleBndrs lhs :: Located (HsExpr GhcPs)
lhs rhs :: Located (HsExpr GhcPs)
rhs -> do
    Located (SourceText, RuleName)
-> ((SourceText, RuleName) -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located Located (SourceText, RuleName)
ruleName (SourceText, RuleName) -> R ()
p_ruleName
    R ()
space
    Activation -> R ()
p_activation Activation
activation
    R ()
space
    case Maybe [LHsTyVarBndr (NoGhcTc GhcPs)]
tyvars of
      Nothing -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just xs :: [LHsTyVarBndr (NoGhcTc GhcPs)]
xs -> do
        (HsTyVarBndr GhcPs -> R ())
-> [Located (HsTyVarBndr GhcPs)] -> R ()
forall a. Data a => (a -> R ()) -> [Located a] -> R ()
p_forallBndrs HsTyVarBndr GhcPs -> R ()
p_hsTyVarBndr [Located (HsTyVarBndr GhcPs)]
[LHsTyVarBndr (NoGhcTc GhcPs)]
xs
        R ()
space
    -- It appears that there is no way to tell if there was an empty forall
    -- in the input or no forall at all. We do not want to add redundant
    -- foralls, so let's just skip the empty ones.
    Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([LRuleBndr GhcPs] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LRuleBndr GhcPs]
ruleBndrs) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
      (RuleBndr GhcPs -> R ()) -> [LRuleBndr GhcPs] -> R ()
forall a. Data a => (a -> R ()) -> [Located a] -> R ()
p_forallBndrs RuleBndr GhcPs -> R ()
p_ruleBndr [LRuleBndr GhcPs]
ruleBndrs
    R ()
breakpoint
    R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
      Located (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located Located (HsExpr GhcPs)
lhs HsExpr GhcPs -> R ()
p_hsExpr
      R ()
space
      Text -> R ()
txt "="
      R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
        R ()
breakpoint
        Located (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located Located (HsExpr GhcPs)
rhs HsExpr GhcPs -> R ()
p_hsExpr
  XRuleDecl NoExt -> String -> R ()
forall a. String -> a
notImplemented "XRuleDecl"

p_ruleName :: (SourceText, RuleName) -> R ()
p_ruleName :: (SourceText, RuleName) -> R ()
p_ruleName (_, name :: RuleName
name) = HsLit (GhcPass Any) -> R ()
forall a. Outputable a => a -> R ()
atom (HsLit (GhcPass Any) -> R ()) -> HsLit (GhcPass Any) -> R ()
forall a b. (a -> b) -> a -> b
$ XHsString (GhcPass Any) -> RuleName -> HsLit (GhcPass Any)
forall x. XHsString x -> RuleName -> HsLit x
HsString XHsString (GhcPass Any)
SourceText
NoSourceText RuleName
name

p_ruleBndr :: RuleBndr GhcPs -> R ()
p_ruleBndr :: RuleBndr GhcPs -> R ()
p_ruleBndr = \case
  RuleBndr NoExt x :: Located (IdP GhcPs)
x -> Located RdrName -> R ()
p_rdrName Located (IdP GhcPs)
Located RdrName
x
  RuleBndrSig NoExt x :: Located (IdP GhcPs)
x hswc :: LHsSigWcType GhcPs
hswc -> BracketStyle -> R () -> R ()
parens BracketStyle
N (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
    Located RdrName -> R ()
p_rdrName Located (IdP GhcPs)
Located RdrName
x
    LHsSigWcType GhcPs -> R ()
p_typeAscription LHsSigWcType GhcPs
hswc
  XRuleBndr NoExt -> String -> R ()
forall a. String -> a
notImplemented "XRuleBndr"