{-# LANGUAGE RecordWildCards #-}

module HIndent.Ast.Declaration.Rule.Collection
  ( RuleCollection
  , mkRuleCollection
  ) where

import HIndent.Ast.Declaration.Rule
import HIndent.Ast.NodeComments
import HIndent.Ast.WithComments
import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC
import {-# SOURCE #-} HIndent.Pretty
import HIndent.Pretty.Combinators
import HIndent.Pretty.NodeComments

newtype RuleCollection =
  RuleCollection [WithComments RuleDeclaration]

instance CommentExtraction RuleCollection where
  nodeComments :: RuleCollection -> NodeComments
nodeComments RuleCollection {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []

instance Pretty RuleCollection where
  pretty' :: RuleCollection -> Printer ()
pretty' (RuleCollection [WithComments RuleDeclaration]
xs) =
    [Printer ()] -> Printer ()
lined ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> Printer ()
String -> Printer ()
string String
"{-# RULES" Printer () -> [Printer ()] -> [Printer ()]
forall a. a -> [a] -> [a]
: (WithComments RuleDeclaration -> Printer ())
-> [WithComments RuleDeclaration] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WithComments RuleDeclaration -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [WithComments RuleDeclaration]
xs [Printer ()] -> [Printer ()] -> [Printer ()]
forall a. [a] -> [a] -> [a]
++ [HasCallStack => String -> Printer ()
String -> Printer ()
string String
" #-}"]

mkRuleCollection :: GHC.RuleDecls GHC.GhcPs -> RuleCollection
mkRuleCollection :: RuleDecls GhcPs -> RuleCollection
mkRuleCollection GHC.HsRules {[LRuleDecl GhcPs]
XCRuleDecls GhcPs
rds_ext :: XCRuleDecls GhcPs
rds_rules :: [LRuleDecl GhcPs]
rds_rules :: forall pass. RuleDecls pass -> [LRuleDecl pass]
rds_ext :: forall pass. RuleDecls pass -> XCRuleDecls pass
..} =
  [WithComments RuleDeclaration] -> RuleCollection
RuleCollection ([WithComments RuleDeclaration] -> RuleCollection)
-> [WithComments RuleDeclaration] -> RuleCollection
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (RuleDecl GhcPs)
 -> WithComments RuleDeclaration)
-> [GenLocated SrcSpanAnnA (RuleDecl GhcPs)]
-> [WithComments RuleDeclaration]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((RuleDecl GhcPs -> RuleDeclaration)
-> WithComments (RuleDecl GhcPs) -> WithComments RuleDeclaration
forall a b. (a -> b) -> WithComments a -> WithComments b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RuleDecl GhcPs -> RuleDeclaration
mkRuleDeclaration (WithComments (RuleDecl GhcPs) -> WithComments RuleDeclaration)
-> (GenLocated SrcSpanAnnA (RuleDecl GhcPs)
    -> WithComments (RuleDecl GhcPs))
-> GenLocated SrcSpanAnnA (RuleDecl GhcPs)
-> WithComments RuleDeclaration
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (RuleDecl GhcPs)
-> WithComments (RuleDecl GhcPs)
forall l a. CommentExtraction l => GenLocated l a -> WithComments a
fromGenLocated) [LRuleDecl GhcPs]
[GenLocated SrcSpanAnnA (RuleDecl GhcPs)]
rds_rules