{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}

-- | Rendering of declarations.
module Ormolu.Printer.Meat.Declaration
  ( p_hsDecls,
    p_hsDeclsRespectGrouping,
  )
where

import Data.List (sort)
import Data.List.NonEmpty (NonEmpty (..), (<|))
import qualified Data.List.NonEmpty as NE
import GHC.Hs
import GHC.Types.Name.Occurrence (occNameFS)
import GHC.Types.Name.Reader
import GHC.Types.SrcLoc
import Ormolu.Config (SourceType (SignatureSource))
import Ormolu.Printer.Combinators
import Ormolu.Printer.Internal (askSourceType)
import Ormolu.Printer.Meat.Common
import Ormolu.Printer.Meat.Declaration.Annotation
import Ormolu.Printer.Meat.Declaration.Class
import Ormolu.Printer.Meat.Declaration.Data
import Ormolu.Printer.Meat.Declaration.Default
import Ormolu.Printer.Meat.Declaration.Foreign
import Ormolu.Printer.Meat.Declaration.Instance
import Ormolu.Printer.Meat.Declaration.RoleAnnotation
import Ormolu.Printer.Meat.Declaration.Rule
import Ormolu.Printer.Meat.Declaration.Signature
import Ormolu.Printer.Meat.Declaration.Splice
import Ormolu.Printer.Meat.Declaration.Type
import Ormolu.Printer.Meat.Declaration.TypeFamily
import Ormolu.Printer.Meat.Declaration.Value
import Ormolu.Printer.Meat.Declaration.Warning
import Ormolu.Printer.Meat.Type
import Ormolu.Utils

data UserGrouping
  = -- | Always put newlines where we think they should be
    Disregard
  | -- | Respect user preferences regarding grouping
    Respect
  deriving (UserGrouping -> UserGrouping -> Bool
(UserGrouping -> UserGrouping -> Bool)
-> (UserGrouping -> UserGrouping -> Bool) -> Eq UserGrouping
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserGrouping -> UserGrouping -> Bool
$c/= :: UserGrouping -> UserGrouping -> Bool
== :: UserGrouping -> UserGrouping -> Bool
$c== :: UserGrouping -> UserGrouping -> Bool
Eq, Int -> UserGrouping -> ShowS
[UserGrouping] -> ShowS
UserGrouping -> String
(Int -> UserGrouping -> ShowS)
-> (UserGrouping -> String)
-> ([UserGrouping] -> ShowS)
-> Show UserGrouping
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserGrouping] -> ShowS
$cshowList :: [UserGrouping] -> ShowS
show :: UserGrouping -> String
$cshow :: UserGrouping -> String
showsPrec :: Int -> UserGrouping -> ShowS
$cshowsPrec :: Int -> UserGrouping -> ShowS
Show)

p_hsDecls :: FamilyStyle -> [LHsDecl GhcPs] -> R ()
p_hsDecls :: FamilyStyle -> [LHsDecl GhcPs] -> R ()
p_hsDecls = UserGrouping -> FamilyStyle -> [LHsDecl GhcPs] -> R ()
p_hsDecls' UserGrouping
Disregard

-- | Like 'p_hsDecls' but respects user choices regarding grouping. If the
-- user omits newlines between declarations, we also omit them in most
-- cases, except when said declarations have associated Haddocks.
--
-- Does some normalization (compress subsequent newlines into a single one)
p_hsDeclsRespectGrouping :: FamilyStyle -> [LHsDecl GhcPs] -> R ()
p_hsDeclsRespectGrouping :: FamilyStyle -> [LHsDecl GhcPs] -> R ()
p_hsDeclsRespectGrouping = UserGrouping -> FamilyStyle -> [LHsDecl GhcPs] -> R ()
p_hsDecls' UserGrouping
Respect

p_hsDecls' :: UserGrouping -> FamilyStyle -> [LHsDecl GhcPs] -> R ()
p_hsDecls' :: UserGrouping -> FamilyStyle -> [LHsDecl GhcPs] -> R ()
p_hsDecls' UserGrouping
grouping FamilyStyle
style [LHsDecl GhcPs]
decls = do
  Bool
isSig <- (SourceType -> SourceType -> Bool
forall a. Eq a => a -> a -> Bool
== SourceType
SignatureSource) (SourceType -> Bool) -> R SourceType -> R Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> R SourceType
askSourceType
  (R () -> R ()) -> [R ()] -> R ()
forall a. (a -> R ()) -> [a] -> R ()
sepSemi R () -> R ()
forall a. a -> a
id ([R ()] -> R ()) -> [R ()] -> R ()
forall a b. (a -> b) -> a -> b
$
    -- Return a list of rendered declarations, adding a newline to separate
    -- groups.
    case Bool -> [LHsDecl GhcPs] -> [NonEmpty (LHsDecl GhcPs)]
groupDecls Bool
isSig [LHsDecl GhcPs]
decls of
      [] -> []
      (NonEmpty (LHsDecl GhcPs)
x : [NonEmpty (LHsDecl GhcPs)]
xs) -> NonEmpty (GenLocated SrcSpanAnnA (HsDecl GhcPs)) -> [R ()]
renderGroup NonEmpty (GenLocated SrcSpanAnnA (HsDecl GhcPs))
NonEmpty (LHsDecl GhcPs)
x [R ()] -> [R ()] -> [R ()]
forall a. [a] -> [a] -> [a]
++ [[R ()]] -> [R ()]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((NonEmpty (GenLocated SrcSpanAnnA (HsDecl GhcPs))
 -> NonEmpty (GenLocated SrcSpanAnnA (HsDecl GhcPs)) -> [R ()])
-> [NonEmpty (GenLocated SrcSpanAnnA (HsDecl GhcPs))]
-> [NonEmpty (GenLocated SrcSpanAnnA (HsDecl GhcPs))]
-> [[R ()]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith NonEmpty (GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> NonEmpty (GenLocated SrcSpanAnnA (HsDecl GhcPs)) -> [R ()]
renderGroupWithPrev (NonEmpty (GenLocated SrcSpanAnnA (HsDecl GhcPs))
NonEmpty (LHsDecl GhcPs)
x NonEmpty (GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> [NonEmpty (GenLocated SrcSpanAnnA (HsDecl GhcPs))]
-> [NonEmpty (GenLocated SrcSpanAnnA (HsDecl GhcPs))]
forall a. a -> [a] -> [a]
: [NonEmpty (GenLocated SrcSpanAnnA (HsDecl GhcPs))]
[NonEmpty (LHsDecl GhcPs)]
xs) [NonEmpty (GenLocated SrcSpanAnnA (HsDecl GhcPs))]
[NonEmpty (LHsDecl GhcPs)]
xs)
  where
    renderGroup :: NonEmpty (GenLocated SrcSpanAnnA (HsDecl GhcPs)) -> [R ()]
renderGroup = NonEmpty (R ()) -> [R ()]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty (R ()) -> [R ()])
-> (NonEmpty (GenLocated SrcSpanAnnA (HsDecl GhcPs))
    -> NonEmpty (R ()))
-> NonEmpty (GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> [R ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenLocated SrcSpanAnnA (HsDecl GhcPs) -> R ())
-> NonEmpty (GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> NonEmpty (R ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((HsDecl GhcPs -> R ())
-> GenLocated SrcSpanAnnA (HsDecl GhcPs) -> R ()
forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' ((HsDecl GhcPs -> R ())
 -> GenLocated SrcSpanAnnA (HsDecl GhcPs) -> R ())
-> (HsDecl GhcPs -> R ())
-> GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> R ()
forall a b. (a -> b) -> a -> b
$ R () -> R ()
dontUseBraces (R () -> R ()) -> (HsDecl GhcPs -> R ()) -> HsDecl GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FamilyStyle -> HsDecl GhcPs -> R ()
p_hsDecl FamilyStyle
style)
    renderGroupWithPrev :: NonEmpty (GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> NonEmpty (GenLocated SrcSpanAnnA (HsDecl GhcPs)) -> [R ()]
renderGroupWithPrev NonEmpty (GenLocated SrcSpanAnnA (HsDecl GhcPs))
prev NonEmpty (GenLocated SrcSpanAnnA (HsDecl GhcPs))
curr =
      -- We can omit a blank line when the user didn't add one, but we must
      -- ensure we always add blank lines around documented declarations
      case UserGrouping
grouping of
        UserGrouping
Disregard ->
          R ()
breakpoint R () -> [R ()] -> [R ()]
forall a. a -> [a] -> [a]
: NonEmpty (GenLocated SrcSpanAnnA (HsDecl GhcPs)) -> [R ()]
renderGroup NonEmpty (GenLocated SrcSpanAnnA (HsDecl GhcPs))
curr
        UserGrouping
Respect ->
          if (GenLocated SrcSpanAnnA (HsDecl GhcPs) -> SrcSpan)
-> NonEmpty (GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> NonEmpty (GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> Bool
forall a. (a -> SrcSpan) -> NonEmpty a -> NonEmpty a -> Bool
separatedByBlankNE GenLocated SrcSpanAnnA (HsDecl GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA NonEmpty (GenLocated SrcSpanAnnA (HsDecl GhcPs))
prev NonEmpty (GenLocated SrcSpanAnnA (HsDecl GhcPs))
curr
            Bool -> Bool -> Bool
|| NonEmpty (LHsDecl GhcPs) -> Bool
isDocumented NonEmpty (GenLocated SrcSpanAnnA (HsDecl GhcPs))
NonEmpty (LHsDecl GhcPs)
prev
            Bool -> Bool -> Bool
|| NonEmpty (LHsDecl GhcPs) -> Bool
isDocumented NonEmpty (GenLocated SrcSpanAnnA (HsDecl GhcPs))
NonEmpty (LHsDecl GhcPs)
curr
            then R ()
breakpoint R () -> [R ()] -> [R ()]
forall a. a -> [a] -> [a]
: NonEmpty (GenLocated SrcSpanAnnA (HsDecl GhcPs)) -> [R ()]
renderGroup NonEmpty (GenLocated SrcSpanAnnA (HsDecl GhcPs))
curr
            else NonEmpty (GenLocated SrcSpanAnnA (HsDecl GhcPs)) -> [R ()]
renderGroup NonEmpty (GenLocated SrcSpanAnnA (HsDecl GhcPs))
curr

-- | Is a declaration group documented?
isDocumented :: NonEmpty (LHsDecl GhcPs) -> Bool
isDocumented :: NonEmpty (LHsDecl GhcPs) -> Bool
isDocumented = (GenLocated SrcSpanAnnA (HsDecl GhcPs) -> Bool)
-> NonEmpty (GenLocated SrcSpanAnnA (HsDecl GhcPs)) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (HsDecl GhcPs -> Bool
isHaddock (HsDecl GhcPs -> Bool)
-> (GenLocated SrcSpanAnnA (HsDecl GhcPs) -> HsDecl GhcPs)
-> GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (HsDecl GhcPs) -> HsDecl GhcPs
forall l e. GenLocated l e -> e
unLoc)
  where
    isHaddock :: HsDecl GhcPs -> Bool
isHaddock HsDecl GhcPs
DocNext = Bool
True
    isHaddock HsDecl GhcPs
DocPrev = Bool
True
    isHaddock HsDecl GhcPs
_ = Bool
False

-- | Group relevant declarations together.
groupDecls ::
  -- | Is the source a signature file?
  Bool ->
  -- | List of declarations
  [LHsDecl GhcPs] ->
  [NonEmpty (LHsDecl GhcPs)]
groupDecls :: Bool -> [LHsDecl GhcPs] -> [NonEmpty (LHsDecl GhcPs)]
groupDecls Bool
_ [] = []
groupDecls Bool
isSig (l :: LHsDecl GhcPs
l@(L _ DocNext) : [LHsDecl GhcPs]
xs) =
  -- If the first element is a doc string for next element, just include it
  -- in the next block:
  case Bool -> [LHsDecl GhcPs] -> [NonEmpty (LHsDecl GhcPs)]
groupDecls Bool
isSig [LHsDecl GhcPs]
xs of
    [] -> [GenLocated SrcSpanAnnA (HsDecl GhcPs)
LHsDecl GhcPs
l GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> NonEmpty (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a. a -> [a] -> NonEmpty a
:| []]
    (NonEmpty (LHsDecl GhcPs)
x : [NonEmpty (LHsDecl GhcPs)]
xs') -> (GenLocated SrcSpanAnnA (HsDecl GhcPs)
LHsDecl GhcPs
l GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> NonEmpty (GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> NonEmpty (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a. a -> NonEmpty a -> NonEmpty a
<| NonEmpty (GenLocated SrcSpanAnnA (HsDecl GhcPs))
NonEmpty (LHsDecl GhcPs)
x) NonEmpty (GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> [NonEmpty (GenLocated SrcSpanAnnA (HsDecl GhcPs))]
-> [NonEmpty (GenLocated SrcSpanAnnA (HsDecl GhcPs))]
forall a. a -> [a] -> [a]
: [NonEmpty (GenLocated SrcSpanAnnA (HsDecl GhcPs))]
[NonEmpty (LHsDecl GhcPs)]
xs'
groupDecls Bool
isSig (LHsDecl GhcPs
header : [LHsDecl GhcPs]
xs) =
  let ([(GenLocated SrcSpanAnnA (HsDecl GhcPs),
  GenLocated SrcSpanAnnA (HsDecl GhcPs))]
grp, [(GenLocated SrcSpanAnnA (HsDecl GhcPs),
  GenLocated SrcSpanAnnA (HsDecl GhcPs))]
rest) = (((GenLocated SrcSpanAnnA (HsDecl GhcPs),
   GenLocated SrcSpanAnnA (HsDecl GhcPs))
  -> Bool)
 -> [(GenLocated SrcSpanAnnA (HsDecl GhcPs),
      GenLocated SrcSpanAnnA (HsDecl GhcPs))]
 -> ([(GenLocated SrcSpanAnnA (HsDecl GhcPs),
       GenLocated SrcSpanAnnA (HsDecl GhcPs))],
     [(GenLocated SrcSpanAnnA (HsDecl GhcPs),
       GenLocated SrcSpanAnnA (HsDecl GhcPs))]))
-> [(GenLocated SrcSpanAnnA (HsDecl GhcPs),
     GenLocated SrcSpanAnnA (HsDecl GhcPs))]
-> ((GenLocated SrcSpanAnnA (HsDecl GhcPs),
     GenLocated SrcSpanAnnA (HsDecl GhcPs))
    -> Bool)
-> ([(GenLocated SrcSpanAnnA (HsDecl GhcPs),
      GenLocated SrcSpanAnnA (HsDecl GhcPs))],
    [(GenLocated SrcSpanAnnA (HsDecl GhcPs),
      GenLocated SrcSpanAnnA (HsDecl GhcPs))])
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((GenLocated SrcSpanAnnA (HsDecl GhcPs),
  GenLocated SrcSpanAnnA (HsDecl GhcPs))
 -> Bool)
-> [(GenLocated SrcSpanAnnA (HsDecl GhcPs),
     GenLocated SrcSpanAnnA (HsDecl GhcPs))]
-> ([(GenLocated SrcSpanAnnA (HsDecl GhcPs),
      GenLocated SrcSpanAnnA (HsDecl GhcPs))],
    [(GenLocated SrcSpanAnnA (HsDecl GhcPs),
      GenLocated SrcSpanAnnA (HsDecl GhcPs))])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span ([GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> [(GenLocated SrcSpanAnnA (HsDecl GhcPs),
     GenLocated SrcSpanAnnA (HsDecl GhcPs))]
forall a b. [a] -> [b] -> [(a, b)]
zip (GenLocated SrcSpanAnnA (HsDecl GhcPs)
LHsDecl GhcPs
header GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a. a -> [a] -> [a]
: [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
[LHsDecl GhcPs]
xs) [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
[LHsDecl GhcPs]
xs) (((GenLocated SrcSpanAnnA (HsDecl GhcPs),
   GenLocated SrcSpanAnnA (HsDecl GhcPs))
  -> Bool)
 -> ([(GenLocated SrcSpanAnnA (HsDecl GhcPs),
       GenLocated SrcSpanAnnA (HsDecl GhcPs))],
     [(GenLocated SrcSpanAnnA (HsDecl GhcPs),
       GenLocated SrcSpanAnnA (HsDecl GhcPs))]))
-> ((GenLocated SrcSpanAnnA (HsDecl GhcPs),
     GenLocated SrcSpanAnnA (HsDecl GhcPs))
    -> Bool)
-> ([(GenLocated SrcSpanAnnA (HsDecl GhcPs),
      GenLocated SrcSpanAnnA (HsDecl GhcPs))],
    [(GenLocated SrcSpanAnnA (HsDecl GhcPs),
      GenLocated SrcSpanAnnA (HsDecl GhcPs))])
forall a b. (a -> b) -> a -> b
$ \(GenLocated SrcSpanAnnA (HsDecl GhcPs)
previous, GenLocated SrcSpanAnnA (HsDecl GhcPs)
current) ->
        let relevantToHdr :: Bool
relevantToHdr = LHsDecl GhcPs -> LHsDecl GhcPs -> Bool
groupedDecls LHsDecl GhcPs
header GenLocated SrcSpanAnnA (HsDecl GhcPs)
LHsDecl GhcPs
current
            relevantToPrev :: Bool
relevantToPrev = LHsDecl GhcPs -> LHsDecl GhcPs -> Bool
groupedDecls GenLocated SrcSpanAnnA (HsDecl GhcPs)
LHsDecl GhcPs
previous GenLocated SrcSpanAnnA (HsDecl GhcPs)
LHsDecl GhcPs
current
            isDeclSeries :: Bool
isDeclSeries = Bool -> Bool
not Bool
isSig Bool -> Bool -> Bool
&& LHsDecl GhcPs -> LHsDecl GhcPs -> Bool
declSeries GenLocated SrcSpanAnnA (HsDecl GhcPs)
LHsDecl GhcPs
previous GenLocated SrcSpanAnnA (HsDecl GhcPs)
LHsDecl GhcPs
current
         in Bool
isDeclSeries Bool -> Bool -> Bool
|| Bool
relevantToHdr Bool -> Bool -> Bool
|| Bool
relevantToPrev
   in (GenLocated SrcSpanAnnA (HsDecl GhcPs)
LHsDecl GhcPs
header GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> NonEmpty (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a. a -> [a] -> NonEmpty a
:| ((GenLocated SrcSpanAnnA (HsDecl GhcPs),
  GenLocated SrcSpanAnnA (HsDecl GhcPs))
 -> GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> [(GenLocated SrcSpanAnnA (HsDecl GhcPs),
     GenLocated SrcSpanAnnA (HsDecl GhcPs))]
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a b. (a -> b) -> [a] -> [b]
map (GenLocated SrcSpanAnnA (HsDecl GhcPs),
 GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall a b. (a, b) -> b
snd [(GenLocated SrcSpanAnnA (HsDecl GhcPs),
  GenLocated SrcSpanAnnA (HsDecl GhcPs))]
grp) NonEmpty (GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> [NonEmpty (GenLocated SrcSpanAnnA (HsDecl GhcPs))]
-> [NonEmpty (GenLocated SrcSpanAnnA (HsDecl GhcPs))]
forall a. a -> [a] -> [a]
: Bool -> [LHsDecl GhcPs] -> [NonEmpty (LHsDecl GhcPs)]
groupDecls Bool
isSig (((GenLocated SrcSpanAnnA (HsDecl GhcPs),
  GenLocated SrcSpanAnnA (HsDecl GhcPs))
 -> GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> [(GenLocated SrcSpanAnnA (HsDecl GhcPs),
     GenLocated SrcSpanAnnA (HsDecl GhcPs))]
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a b. (a -> b) -> [a] -> [b]
map (GenLocated SrcSpanAnnA (HsDecl GhcPs),
 GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall a b. (a, b) -> b
snd [(GenLocated SrcSpanAnnA (HsDecl GhcPs),
  GenLocated SrcSpanAnnA (HsDecl GhcPs))]
rest)

p_hsDecl :: FamilyStyle -> HsDecl GhcPs -> R ()
p_hsDecl :: FamilyStyle -> HsDecl GhcPs -> R ()
p_hsDecl FamilyStyle
style = \case
  TyClD XTyClD GhcPs
_ TyClDecl GhcPs
x -> FamilyStyle -> TyClDecl GhcPs -> R ()
p_tyClDecl FamilyStyle
style TyClDecl GhcPs
x
  ValD XValD GhcPs
_ HsBind GhcPs
x -> HsBind GhcPs -> R ()
p_valDecl HsBind GhcPs
x
  SigD XSigD GhcPs
_ Sig GhcPs
x -> Sig GhcPs -> R ()
p_sigDecl Sig GhcPs
x
  InstD XInstD GhcPs
_ InstDecl GhcPs
x -> FamilyStyle -> InstDecl GhcPs -> R ()
p_instDecl FamilyStyle
style InstDecl GhcPs
x
  DerivD XDerivD GhcPs
_ DerivDecl GhcPs
x -> DerivDecl GhcPs -> R ()
p_standaloneDerivDecl DerivDecl GhcPs
x
  DefD XDefD GhcPs
_ DefaultDecl GhcPs
x -> DefaultDecl GhcPs -> R ()
p_defaultDecl DefaultDecl GhcPs
x
  ForD XForD GhcPs
_ ForeignDecl GhcPs
x -> ForeignDecl GhcPs -> R ()
p_foreignDecl ForeignDecl GhcPs
x
  WarningD XWarningD GhcPs
_ WarnDecls GhcPs
x -> WarnDecls GhcPs -> R ()
p_warnDecls WarnDecls GhcPs
x
  AnnD XAnnD GhcPs
_ AnnDecl GhcPs
x -> AnnDecl GhcPs -> R ()
p_annDecl AnnDecl GhcPs
x
  RuleD XRuleD GhcPs
_ RuleDecls GhcPs
x -> RuleDecls GhcPs -> R ()
p_ruleDecls RuleDecls GhcPs
x
  SpliceD XSpliceD GhcPs
_ SpliceDecl GhcPs
x -> SpliceDecl GhcPs -> R ()
p_spliceDecl SpliceDecl GhcPs
x
  DocD XDocD GhcPs
_ DocDecl
docDecl ->
    case DocDecl
docDecl of
      DocCommentNext HsDocString
str -> HaddockStyle -> Bool -> LHsDocString -> R ()
p_hsDocString HaddockStyle
Pipe Bool
False (HsDocString -> LHsDocString
forall e. e -> Located e
noLoc HsDocString
str)
      DocCommentPrev HsDocString
str -> HaddockStyle -> Bool -> LHsDocString -> R ()
p_hsDocString HaddockStyle
Caret Bool
False (HsDocString -> LHsDocString
forall e. e -> Located e
noLoc HsDocString
str)
      DocCommentNamed String
name HsDocString
str -> HaddockStyle -> Bool -> LHsDocString -> R ()
p_hsDocString (String -> HaddockStyle
Named String
name) Bool
False (HsDocString -> LHsDocString
forall e. e -> Located e
noLoc HsDocString
str)
      DocGroup Int
n HsDocString
str -> HaddockStyle -> Bool -> LHsDocString -> R ()
p_hsDocString (Int -> HaddockStyle
Asterisk Int
n) Bool
False (HsDocString -> LHsDocString
forall e. e -> Located e
noLoc HsDocString
str)
  RoleAnnotD XRoleAnnotD GhcPs
_ RoleAnnotDecl GhcPs
x -> RoleAnnotDecl GhcPs -> R ()
p_roleAnnot RoleAnnotDecl GhcPs
x
  KindSigD XKindSigD GhcPs
_ StandaloneKindSig GhcPs
s -> StandaloneKindSig GhcPs -> R ()
p_standaloneKindSig StandaloneKindSig GhcPs
s

p_tyClDecl :: FamilyStyle -> TyClDecl GhcPs -> R ()
p_tyClDecl :: FamilyStyle -> TyClDecl GhcPs -> R ()
p_tyClDecl FamilyStyle
style = \case
  FamDecl XFamDecl GhcPs
_ FamilyDecl GhcPs
x -> FamilyStyle -> FamilyDecl GhcPs -> R ()
p_famDecl FamilyStyle
style FamilyDecl GhcPs
x
  SynDecl {XSynDecl GhcPs
LIdP GhcPs
LHsType GhcPs
LexicalFixity
LHsQTyVars GhcPs
tcdTyVars :: forall pass. TyClDecl pass -> LHsQTyVars pass
tcdSExt :: forall pass. TyClDecl pass -> XSynDecl pass
tcdRhs :: forall pass. TyClDecl pass -> LHsType pass
tcdLName :: forall pass. TyClDecl pass -> LIdP pass
tcdFixity :: forall pass. TyClDecl pass -> LexicalFixity
tcdRhs :: LHsType GhcPs
tcdFixity :: LexicalFixity
tcdTyVars :: LHsQTyVars GhcPs
tcdLName :: LIdP GhcPs
tcdSExt :: XSynDecl GhcPs
..} -> LocatedN RdrName
-> LexicalFixity -> LHsQTyVars GhcPs -> LHsType GhcPs -> R ()
p_synDecl LocatedN RdrName
LIdP GhcPs
tcdLName LexicalFixity
tcdFixity LHsQTyVars GhcPs
tcdTyVars LHsType GhcPs
tcdRhs
  DataDecl {HsDataDefn GhcPs
XDataDecl GhcPs
LIdP GhcPs
LexicalFixity
LHsQTyVars GhcPs
tcdDataDefn :: forall pass. TyClDecl pass -> HsDataDefn pass
tcdDExt :: forall pass. TyClDecl pass -> XDataDecl pass
tcdDataDefn :: HsDataDefn GhcPs
tcdFixity :: LexicalFixity
tcdTyVars :: LHsQTyVars GhcPs
tcdLName :: LIdP GhcPs
tcdDExt :: XDataDecl GhcPs
tcdTyVars :: forall pass. TyClDecl pass -> LHsQTyVars pass
tcdLName :: forall pass. TyClDecl pass -> LIdP pass
tcdFixity :: forall pass. TyClDecl pass -> LexicalFixity
..} ->
    FamilyStyle
-> LocatedN RdrName
-> HsTyPats GhcPs
-> LexicalFixity
-> HsDataDefn GhcPs
-> R ()
p_dataDecl
      FamilyStyle
Associated
      LocatedN RdrName
LIdP GhcPs
tcdLName
      (LHsQTyVars GhcPs -> HsTyPats GhcPs
tyVarsToTyPats LHsQTyVars GhcPs
tcdTyVars)
      LexicalFixity
tcdFixity
      HsDataDefn GhcPs
tcdDataDefn
  ClassDecl {[LDocDecl GhcPs]
[LFamilyDecl GhcPs]
[LHsFunDep GhcPs]
[LTyFamDefltDecl GhcPs]
[LSig GhcPs]
Maybe (LHsContext GhcPs)
LHsBinds GhcPs
XClassDecl GhcPs
LIdP GhcPs
LexicalFixity
LHsQTyVars GhcPs
tcdSigs :: forall pass. TyClDecl pass -> [LSig pass]
tcdMeths :: forall pass. TyClDecl pass -> LHsBinds pass
tcdFDs :: forall pass. TyClDecl pass -> [LHsFunDep pass]
tcdDocs :: forall pass. TyClDecl pass -> [LDocDecl pass]
tcdCtxt :: forall pass. TyClDecl pass -> Maybe (LHsContext pass)
tcdCExt :: forall pass. TyClDecl pass -> XClassDecl pass
tcdATs :: forall pass. TyClDecl pass -> [LFamilyDecl pass]
tcdATDefs :: forall pass. TyClDecl pass -> [LTyFamDefltDecl pass]
tcdDocs :: [LDocDecl GhcPs]
tcdATDefs :: [LTyFamDefltDecl GhcPs]
tcdATs :: [LFamilyDecl GhcPs]
tcdMeths :: LHsBinds GhcPs
tcdSigs :: [LSig GhcPs]
tcdFDs :: [LHsFunDep GhcPs]
tcdFixity :: LexicalFixity
tcdTyVars :: LHsQTyVars GhcPs
tcdLName :: LIdP GhcPs
tcdCtxt :: Maybe (LHsContext GhcPs)
tcdCExt :: XClassDecl GhcPs
tcdTyVars :: forall pass. TyClDecl pass -> LHsQTyVars pass
tcdLName :: forall pass. TyClDecl pass -> LIdP pass
tcdFixity :: forall pass. TyClDecl pass -> LexicalFixity
..} ->
    Maybe (LHsContext GhcPs)
-> LocatedN RdrName
-> LHsQTyVars GhcPs
-> LexicalFixity
-> [LHsFunDep GhcPs]
-> [LSig GhcPs]
-> LHsBinds GhcPs
-> [LFamilyDecl GhcPs]
-> [LTyFamDefltDecl GhcPs]
-> [LDocDecl GhcPs]
-> R ()
p_classDecl
      Maybe (LHsContext GhcPs)
tcdCtxt
      LocatedN RdrName
LIdP GhcPs
tcdLName
      LHsQTyVars GhcPs
tcdTyVars
      LexicalFixity
tcdFixity
      [LHsFunDep GhcPs]
tcdFDs
      [LSig GhcPs]
tcdSigs
      LHsBinds GhcPs
tcdMeths
      [LFamilyDecl GhcPs]
tcdATs
      [LTyFamDefltDecl GhcPs]
tcdATDefs
      [LDocDecl GhcPs]
tcdDocs

p_instDecl :: FamilyStyle -> InstDecl GhcPs -> R ()
p_instDecl :: FamilyStyle -> InstDecl GhcPs -> R ()
p_instDecl FamilyStyle
style = \case
  ClsInstD XClsInstD GhcPs
_ ClsInstDecl GhcPs
x -> ClsInstDecl GhcPs -> R ()
p_clsInstDecl ClsInstDecl GhcPs
x
  TyFamInstD XTyFamInstD GhcPs
_ TyFamInstDecl GhcPs
x -> FamilyStyle -> TyFamInstDecl GhcPs -> R ()
p_tyFamInstDecl FamilyStyle
style TyFamInstDecl GhcPs
x
  DataFamInstD XDataFamInstD GhcPs
_ DataFamInstDecl GhcPs
x -> FamilyStyle -> DataFamInstDecl GhcPs -> R ()
p_dataFamInstDecl FamilyStyle
style DataFamInstDecl GhcPs
x

-- | Determine if these declarations should be grouped together.
groupedDecls ::
  LHsDecl GhcPs ->
  LHsDecl GhcPs ->
  Bool
groupedDecls :: LHsDecl GhcPs -> LHsDecl GhcPs -> Bool
groupedDecls (L (locA -> l_x) x') (L (locA -> l_y) y') =
  case (HsDecl GhcPs
x', HsDecl GhcPs
y') of
    (TypeSignature [RdrName]
ns, FunctionBody [RdrName]
ns') -> [RdrName]
ns [RdrName] -> [RdrName] -> Bool
forall a. Ord a => [a] -> [a] -> Bool
`intersects` [RdrName]
ns'
    (TypeSignature [RdrName]
ns, DefaultSignature [RdrName]
ns') -> [RdrName]
ns [RdrName] -> [RdrName] -> Bool
forall a. Ord a => [a] -> [a] -> Bool
`intersects` [RdrName]
ns'
    (DefaultSignature [RdrName]
ns, TypeSignature [RdrName]
ns') -> [RdrName]
ns [RdrName] -> [RdrName] -> Bool
forall a. Ord a => [a] -> [a] -> Bool
`intersects` [RdrName]
ns'
    (DefaultSignature [RdrName]
ns, FunctionBody [RdrName]
ns') -> [RdrName]
ns [RdrName] -> [RdrName] -> Bool
forall a. Ord a => [a] -> [a] -> Bool
`intersects` [RdrName]
ns'
    (HsDecl GhcPs
x, FunctionBody [RdrName]
ns) | Just [RdrName]
ns' <- HsDecl GhcPs -> Maybe [RdrName]
isPragma HsDecl GhcPs
x -> [RdrName]
ns [RdrName] -> [RdrName] -> Bool
forall a. Ord a => [a] -> [a] -> Bool
`intersects` [RdrName]
ns'
    (FunctionBody [RdrName]
ns, HsDecl GhcPs
x) | Just [RdrName]
ns' <- HsDecl GhcPs -> Maybe [RdrName]
isPragma HsDecl GhcPs
x -> [RdrName]
ns [RdrName] -> [RdrName] -> Bool
forall a. Ord a => [a] -> [a] -> Bool
`intersects` [RdrName]
ns'
    (HsDecl GhcPs
x, DataDeclaration RdrName
n) | Just [RdrName]
ns <- HsDecl GhcPs -> Maybe [RdrName]
isPragma HsDecl GhcPs
x -> RdrName
n RdrName -> [RdrName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [RdrName]
ns
    (DataDeclaration RdrName
n, HsDecl GhcPs
x)
      | Just [RdrName]
ns <- HsDecl GhcPs -> Maybe [RdrName]
isPragma HsDecl GhcPs
x ->
          let f :: RdrName -> FastString
f = OccName -> FastString
occNameFS (OccName -> FastString)
-> (RdrName -> OccName) -> RdrName -> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrName -> OccName
rdrNameOcc in RdrName -> FastString
f RdrName
n FastString -> [FastString] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (RdrName -> FastString) -> [RdrName] -> [FastString]
forall a b. (a -> b) -> [a] -> [b]
map RdrName -> FastString
f [RdrName]
ns
    (HsDecl GhcPs
x, HsDecl GhcPs
y)
      | Just [RdrName]
ns <- HsDecl GhcPs -> Maybe [RdrName]
isPragma HsDecl GhcPs
x,
        Just [RdrName]
ns' <- HsDecl GhcPs -> Maybe [RdrName]
isPragma HsDecl GhcPs
y ->
          [RdrName]
ns [RdrName] -> [RdrName] -> Bool
forall a. Ord a => [a] -> [a] -> Bool
`intersects` [RdrName]
ns'
    (HsDecl GhcPs
x, TypeSignature [RdrName]
ns) | Just [RdrName]
ns' <- HsDecl GhcPs -> Maybe [RdrName]
isPragma HsDecl GhcPs
x -> [RdrName]
ns [RdrName] -> [RdrName] -> Bool
forall a. Ord a => [a] -> [a] -> Bool
`intersects` [RdrName]
ns'
    (TypeSignature [RdrName]
ns, HsDecl GhcPs
x) | Just [RdrName]
ns' <- HsDecl GhcPs -> Maybe [RdrName]
isPragma HsDecl GhcPs
x -> [RdrName]
ns [RdrName] -> [RdrName] -> Bool
forall a. Ord a => [a] -> [a] -> Bool
`intersects` [RdrName]
ns'
    (PatternSignature [RdrName]
ns, Pattern RdrName
n) -> RdrName
n RdrName -> [RdrName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [RdrName]
ns
    (KindSignature RdrName
n, DataDeclaration RdrName
n') -> RdrName
n RdrName -> RdrName -> Bool
forall a. Eq a => a -> a -> Bool
== RdrName
n'
    (KindSignature RdrName
n, ClassDeclaration RdrName
n') -> RdrName
n RdrName -> RdrName -> Bool
forall a. Eq a => a -> a -> Bool
== RdrName
n'
    (KindSignature RdrName
n, FamilyDeclaration RdrName
n') -> RdrName
n RdrName -> RdrName -> Bool
forall a. Eq a => a -> a -> Bool
== RdrName
n'
    (KindSignature RdrName
n, TypeSynonym RdrName
n') -> RdrName
n RdrName -> RdrName -> Bool
forall a. Eq a => a -> a -> Bool
== RdrName
n'
    -- Special case for TH splices, we look at locations
    (HsDecl GhcPs
Splice, HsDecl GhcPs
Splice) -> Bool -> Bool
not ((SrcSpan -> SrcSpan) -> SrcSpan -> SrcSpan -> Bool
forall a. (a -> SrcSpan) -> a -> a -> Bool
separatedByBlank SrcSpan -> SrcSpan
forall a. a -> a
id SrcSpan
l_x SrcSpan
l_y)
    -- This looks only at Haddocks, normal comments are handled elsewhere
    (HsDecl GhcPs
DocNext, HsDecl GhcPs
_) -> Bool
True
    (HsDecl GhcPs
_, HsDecl GhcPs
DocPrev) -> Bool
True
    (HsDecl GhcPs, HsDecl GhcPs)
_ -> Bool
False

-- | Detect declaration series that should not have blanks between them.
declSeries ::
  LHsDecl GhcPs ->
  LHsDecl GhcPs ->
  Bool
declSeries :: LHsDecl GhcPs -> LHsDecl GhcPs -> Bool
declSeries (L _ x) (L _ y) =
  case (HsDecl GhcPs
x, HsDecl GhcPs
y) of
    ( SigD XSigD GhcPs
_ (TypeSig XTypeSig GhcPs
_ [LIdP GhcPs]
_ LHsSigWcType GhcPs
_),
      SigD XSigD GhcPs
_ (TypeSig XTypeSig GhcPs
_ [LIdP GhcPs]
_ LHsSigWcType GhcPs
_)
      ) -> Bool
True
    (HsDecl GhcPs, HsDecl GhcPs)
_ -> Bool
False

intersects :: Ord a => [a] -> [a] -> Bool
intersects :: [a] -> [a] -> Bool
intersects [a]
a [a]
b = [a] -> [a] -> Bool
forall a. Ord a => [a] -> [a] -> Bool
go ([a] -> [a]
forall a. Ord a => [a] -> [a]
sort [a]
a) ([a] -> [a]
forall a. Ord a => [a] -> [a]
sort [a]
b)
  where
    go :: Ord a => [a] -> [a] -> Bool
    go :: [a] -> [a] -> Bool
go [a]
_ [] = Bool
False
    go [] [a]
_ = Bool
False
    go (a
x : [a]
xs) (a
y : [a]
ys)
      | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
y = [a] -> [a] -> Bool
forall a. Ord a => [a] -> [a] -> Bool
go [a]
xs (a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ys)
      | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
y = [a] -> [a] -> Bool
forall a. Ord a => [a] -> [a] -> Bool
go (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs) [a]
ys
      | Bool
otherwise = Bool
True

isPragma ::
  HsDecl GhcPs ->
  Maybe [RdrName]
isPragma :: HsDecl GhcPs -> Maybe [RdrName]
isPragma = \case
  InlinePragma RdrName
n -> [RdrName] -> Maybe [RdrName]
forall a. a -> Maybe a
Just [RdrName
n]
  SpecializePragma RdrName
n -> [RdrName] -> Maybe [RdrName]
forall a. a -> Maybe a
Just [RdrName
n]
  SCCPragma RdrName
n -> [RdrName] -> Maybe [RdrName]
forall a. a -> Maybe a
Just [RdrName
n]
  AnnTypePragma RdrName
n -> [RdrName] -> Maybe [RdrName]
forall a. a -> Maybe a
Just [RdrName
n]
  AnnValuePragma RdrName
n -> [RdrName] -> Maybe [RdrName]
forall a. a -> Maybe a
Just [RdrName
n]
  WarningPragma [RdrName]
n -> [RdrName] -> Maybe [RdrName]
forall a. a -> Maybe a
Just [RdrName]
n
  HsDecl GhcPs
_ -> Maybe [RdrName]
forall a. Maybe a
Nothing

-- Declarations that do not refer to names

pattern Splice :: HsDecl GhcPs
pattern $mSplice :: forall r. HsDecl GhcPs -> (Void# -> r) -> (Void# -> r) -> r
Splice <- SpliceD _ (SpliceDecl _ _ _)

-- Declarations referring to a single name

pattern
  InlinePragma,
  SpecializePragma,
  SCCPragma,
  AnnTypePragma,
  AnnValuePragma,
  Pattern,
  DataDeclaration,
  ClassDeclaration,
  KindSignature,
  FamilyDeclaration,
  TypeSynonym ::
    RdrName -> HsDecl GhcPs
pattern $mInlinePragma :: forall r. HsDecl GhcPs -> (RdrName -> r) -> (Void# -> r) -> r
InlinePragma n <- SigD _ (InlineSig _ (L _ n) _)
pattern $mSpecializePragma :: forall r. HsDecl GhcPs -> (RdrName -> r) -> (Void# -> r) -> r
SpecializePragma n <- SigD _ (SpecSig _ (L _ n) _ _)
pattern $mSCCPragma :: forall r. HsDecl GhcPs -> (RdrName -> r) -> (Void# -> r) -> r
SCCPragma n <- SigD _ (SCCFunSig _ _ (L _ n) _)
pattern $mAnnTypePragma :: forall r. HsDecl GhcPs -> (RdrName -> r) -> (Void# -> r) -> r
AnnTypePragma n <- AnnD _ (HsAnnotation _ _ (TypeAnnProvenance (L _ n)) _)
pattern $mAnnValuePragma :: forall r. HsDecl GhcPs -> (RdrName -> r) -> (Void# -> r) -> r
AnnValuePragma n <- AnnD _ (HsAnnotation _ _ (ValueAnnProvenance (L _ n)) _)
pattern $mPattern :: forall r. HsDecl GhcPs -> (RdrName -> r) -> (Void# -> r) -> r
Pattern n <- ValD _ (PatSynBind _ (PSB _ (L _ n) _ _ _))
pattern $mDataDeclaration :: forall r. HsDecl GhcPs -> (RdrName -> r) -> (Void# -> r) -> r
DataDeclaration n <- TyClD _ (DataDecl _ (L _ n) _ _ _)
pattern $mClassDeclaration :: forall r. HsDecl GhcPs -> (RdrName -> r) -> (Void# -> r) -> r
ClassDeclaration n <- TyClD _ (ClassDecl _ _ (L _ n) _ _ _ _ _ _ _ _)
pattern $mKindSignature :: forall r. HsDecl GhcPs -> (RdrName -> r) -> (Void# -> r) -> r
KindSignature n <- KindSigD _ (StandaloneKindSig _ (L _ n) _)
pattern $mFamilyDeclaration :: forall r. HsDecl GhcPs -> (RdrName -> r) -> (Void# -> r) -> r
FamilyDeclaration n <- TyClD _ (FamDecl _ (FamilyDecl _ _ _ (L _ n) _ _ _ _))
pattern $mTypeSynonym :: forall r. HsDecl GhcPs -> (RdrName -> r) -> (Void# -> r) -> r
TypeSynonym n <- TyClD _ (SynDecl _ (L _ n) _ _ _)

-- Declarations which can refer to multiple names

pattern
  TypeSignature,
  DefaultSignature,
  FunctionBody,
  PatternSignature,
  WarningPragma ::
    [RdrName] -> HsDecl GhcPs
pattern $mTypeSignature :: forall r. HsDecl GhcPs -> ([RdrName] -> r) -> (Void# -> r) -> r
TypeSignature n <- (sigRdrNames -> Just n)
pattern $mDefaultSignature :: forall r. HsDecl GhcPs -> ([RdrName] -> r) -> (Void# -> r) -> r
DefaultSignature n <- (defSigRdrNames -> Just n)
pattern $mFunctionBody :: forall r. HsDecl GhcPs -> ([RdrName] -> r) -> (Void# -> r) -> r
FunctionBody n <- (funRdrNames -> Just n)
pattern $mPatternSignature :: forall r. HsDecl GhcPs -> ([RdrName] -> r) -> (Void# -> r) -> r
PatternSignature n <- (patSigRdrNames -> Just n)
pattern $mWarningPragma :: forall r. HsDecl GhcPs -> ([RdrName] -> r) -> (Void# -> r) -> r
WarningPragma n <- (warnSigRdrNames -> Just n)

pattern DocNext, DocPrev :: HsDecl GhcPs
pattern $mDocNext :: forall r. HsDecl GhcPs -> (Void# -> r) -> (Void# -> r) -> r
DocNext <- (DocD _ (DocCommentNext _))
pattern $mDocPrev :: forall r. HsDecl GhcPs -> (Void# -> r) -> (Void# -> r) -> r
DocPrev <- (DocD _ (DocCommentPrev _))

sigRdrNames :: HsDecl GhcPs -> Maybe [RdrName]
sigRdrNames :: HsDecl GhcPs -> Maybe [RdrName]
sigRdrNames (SigD XSigD GhcPs
_ (TypeSig XTypeSig GhcPs
_ [LIdP GhcPs]
ns LHsSigWcType GhcPs
_)) = [RdrName] -> Maybe [RdrName]
forall a. a -> Maybe a
Just ([RdrName] -> Maybe [RdrName]) -> [RdrName] -> Maybe [RdrName]
forall a b. (a -> b) -> a -> b
$ (LocatedN RdrName -> RdrName) -> [LocatedN RdrName] -> [RdrName]
forall a b. (a -> b) -> [a] -> [b]
map LocatedN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc [LocatedN RdrName]
[LIdP GhcPs]
ns
sigRdrNames (SigD XSigD GhcPs
_ (ClassOpSig XClassOpSig GhcPs
_ Bool
_ [LIdP GhcPs]
ns LHsSigType GhcPs
_)) = [RdrName] -> Maybe [RdrName]
forall a. a -> Maybe a
Just ([RdrName] -> Maybe [RdrName]) -> [RdrName] -> Maybe [RdrName]
forall a b. (a -> b) -> a -> b
$ (LocatedN RdrName -> RdrName) -> [LocatedN RdrName] -> [RdrName]
forall a b. (a -> b) -> [a] -> [b]
map LocatedN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc [LocatedN RdrName]
[LIdP GhcPs]
ns
sigRdrNames (SigD XSigD GhcPs
_ (PatSynSig XPatSynSig GhcPs
_ [LIdP GhcPs]
ns LHsSigType GhcPs
_)) = [RdrName] -> Maybe [RdrName]
forall a. a -> Maybe a
Just ([RdrName] -> Maybe [RdrName]) -> [RdrName] -> Maybe [RdrName]
forall a b. (a -> b) -> a -> b
$ (LocatedN RdrName -> RdrName) -> [LocatedN RdrName] -> [RdrName]
forall a b. (a -> b) -> [a] -> [b]
map LocatedN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc [LocatedN RdrName]
[LIdP GhcPs]
ns
sigRdrNames HsDecl GhcPs
_ = Maybe [RdrName]
forall a. Maybe a
Nothing

defSigRdrNames :: HsDecl GhcPs -> Maybe [RdrName]
defSigRdrNames :: HsDecl GhcPs -> Maybe [RdrName]
defSigRdrNames (SigD XSigD GhcPs
_ (ClassOpSig XClassOpSig GhcPs
_ Bool
True [LIdP GhcPs]
ns LHsSigType GhcPs
_)) = [RdrName] -> Maybe [RdrName]
forall a. a -> Maybe a
Just ([RdrName] -> Maybe [RdrName]) -> [RdrName] -> Maybe [RdrName]
forall a b. (a -> b) -> a -> b
$ (LocatedN RdrName -> RdrName) -> [LocatedN RdrName] -> [RdrName]
forall a b. (a -> b) -> [a] -> [b]
map LocatedN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc [LocatedN RdrName]
[LIdP GhcPs]
ns
defSigRdrNames HsDecl GhcPs
_ = Maybe [RdrName]
forall a. Maybe a
Nothing

funRdrNames :: HsDecl GhcPs -> Maybe [RdrName]
funRdrNames :: HsDecl GhcPs -> Maybe [RdrName]
funRdrNames (ValD XValD GhcPs
_ (FunBind XFunBind GhcPs GhcPs
_ (L _ n) MatchGroup GhcPs (LHsExpr GhcPs)
_ [CoreTickish]
_)) = [RdrName] -> Maybe [RdrName]
forall a. a -> Maybe a
Just [RdrName
n]
funRdrNames (ValD XValD GhcPs
_ (PatBind XPatBind GhcPs GhcPs
_ (L _ n) GRHSs GhcPs (LHsExpr GhcPs)
_ ([CoreTickish], [[CoreTickish]])
_)) = [RdrName] -> Maybe [RdrName]
forall a. a -> Maybe a
Just ([RdrName] -> Maybe [RdrName]) -> [RdrName] -> Maybe [RdrName]
forall a b. (a -> b) -> a -> b
$ Pat GhcPs -> [RdrName]
patBindNames Pat GhcPs
n
funRdrNames HsDecl GhcPs
_ = Maybe [RdrName]
forall a. Maybe a
Nothing

patSigRdrNames :: HsDecl GhcPs -> Maybe [RdrName]
patSigRdrNames :: HsDecl GhcPs -> Maybe [RdrName]
patSigRdrNames (SigD XSigD GhcPs
_ (PatSynSig XPatSynSig GhcPs
_ [LIdP GhcPs]
ns LHsSigType GhcPs
_)) = [RdrName] -> Maybe [RdrName]
forall a. a -> Maybe a
Just ([RdrName] -> Maybe [RdrName]) -> [RdrName] -> Maybe [RdrName]
forall a b. (a -> b) -> a -> b
$ (LocatedN RdrName -> RdrName) -> [LocatedN RdrName] -> [RdrName]
forall a b. (a -> b) -> [a] -> [b]
map LocatedN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc [LocatedN RdrName]
[LIdP GhcPs]
ns
patSigRdrNames HsDecl GhcPs
_ = Maybe [RdrName]
forall a. Maybe a
Nothing

warnSigRdrNames :: HsDecl GhcPs -> Maybe [RdrName]
warnSigRdrNames :: HsDecl GhcPs -> Maybe [RdrName]
warnSigRdrNames (WarningD XWarningD GhcPs
_ (Warnings XWarnings GhcPs
_ SourceText
_ [LWarnDecl GhcPs]
ws)) = [RdrName] -> Maybe [RdrName]
forall a. a -> Maybe a
Just ([RdrName] -> Maybe [RdrName]) -> [RdrName] -> Maybe [RdrName]
forall a b. (a -> b) -> a -> b
$
  ((GenLocated SrcSpanAnnA (WarnDecl GhcPs) -> [RdrName])
 -> [GenLocated SrcSpanAnnA (WarnDecl GhcPs)] -> [RdrName])
-> [GenLocated SrcSpanAnnA (WarnDecl GhcPs)]
-> (GenLocated SrcSpanAnnA (WarnDecl GhcPs) -> [RdrName])
-> [RdrName]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (GenLocated SrcSpanAnnA (WarnDecl GhcPs) -> [RdrName])
-> [GenLocated SrcSpanAnnA (WarnDecl GhcPs)] -> [RdrName]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [GenLocated SrcSpanAnnA (WarnDecl GhcPs)]
[LWarnDecl GhcPs]
ws ((GenLocated SrcSpanAnnA (WarnDecl GhcPs) -> [RdrName])
 -> [RdrName])
-> (GenLocated SrcSpanAnnA (WarnDecl GhcPs) -> [RdrName])
-> [RdrName]
forall a b. (a -> b) -> a -> b
$ \(L SrcSpanAnnA
_ (Warning XWarning GhcPs
_ [LIdP GhcPs]
ns WarningTxt
_)) -> (LocatedN RdrName -> RdrName) -> [LocatedN RdrName] -> [RdrName]
forall a b. (a -> b) -> [a] -> [b]
map LocatedN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc [LocatedN RdrName]
[LIdP GhcPs]
ns
warnSigRdrNames HsDecl GhcPs
_ = Maybe [RdrName]
forall a. Maybe a
Nothing

patBindNames :: Pat GhcPs -> [RdrName]
patBindNames :: Pat GhcPs -> [RdrName]
patBindNames (TuplePat XTuplePat GhcPs
_ [LPat GhcPs]
ps Boxity
_) = (GenLocated SrcSpanAnnA (Pat GhcPs) -> [RdrName])
-> [GenLocated SrcSpanAnnA (Pat GhcPs)] -> [RdrName]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Pat GhcPs -> [RdrName]
patBindNames (Pat GhcPs -> [RdrName])
-> (GenLocated SrcSpanAnnA (Pat GhcPs) -> Pat GhcPs)
-> GenLocated SrcSpanAnnA (Pat GhcPs)
-> [RdrName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (Pat GhcPs) -> Pat GhcPs
forall l e. GenLocated l e -> e
unLoc) [GenLocated SrcSpanAnnA (Pat GhcPs)]
[LPat GhcPs]
ps
patBindNames (VarPat XVarPat GhcPs
_ (L _ n)) = [RdrName
n]
patBindNames (WildPat XWildPat GhcPs
_) = []
patBindNames (LazyPat XLazyPat GhcPs
_ (L _ p)) = Pat GhcPs -> [RdrName]
patBindNames Pat GhcPs
p
patBindNames (BangPat XBangPat GhcPs
_ (L _ p)) = Pat GhcPs -> [RdrName]
patBindNames Pat GhcPs
p
patBindNames (ParPat XParPat GhcPs
_ (L _ p)) = Pat GhcPs -> [RdrName]
patBindNames Pat GhcPs
p
patBindNames (ListPat XListPat GhcPs
_ [LPat GhcPs]
ps) = (GenLocated SrcSpanAnnA (Pat GhcPs) -> [RdrName])
-> [GenLocated SrcSpanAnnA (Pat GhcPs)] -> [RdrName]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Pat GhcPs -> [RdrName]
patBindNames (Pat GhcPs -> [RdrName])
-> (GenLocated SrcSpanAnnA (Pat GhcPs) -> Pat GhcPs)
-> GenLocated SrcSpanAnnA (Pat GhcPs)
-> [RdrName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (Pat GhcPs) -> Pat GhcPs
forall l e. GenLocated l e -> e
unLoc) [GenLocated SrcSpanAnnA (Pat GhcPs)]
[LPat GhcPs]
ps
patBindNames (AsPat XAsPat GhcPs
_ (L _ n) (L _ p)) = RdrName
n RdrName -> [RdrName] -> [RdrName]
forall a. a -> [a] -> [a]
: Pat GhcPs -> [RdrName]
patBindNames Pat GhcPs
p
patBindNames (SumPat XSumPat GhcPs
_ (L _ p) Int
_ Int
_) = Pat GhcPs -> [RdrName]
patBindNames Pat GhcPs
p
patBindNames (ViewPat XViewPat GhcPs
_ LHsExpr GhcPs
_ (L _ p)) = Pat GhcPs -> [RdrName]
patBindNames Pat GhcPs
p
patBindNames (SplicePat XSplicePat GhcPs
_ HsSplice GhcPs
_) = []
patBindNames (LitPat XLitPat GhcPs
_ HsLit GhcPs
_) = []
patBindNames (SigPat XSigPat GhcPs
_ (L _ p) HsPatSigType (NoGhcTc GhcPs)
_) = Pat GhcPs -> [RdrName]
patBindNames Pat GhcPs
p
patBindNames (NPat XNPat GhcPs
_ XRec GhcPs (HsOverLit GhcPs)
_ Maybe (SyntaxExpr GhcPs)
_ SyntaxExpr GhcPs
_) = []
patBindNames (NPlusKPat XNPlusKPat GhcPs
_ (L _ n) XRec GhcPs (HsOverLit GhcPs)
_ HsOverLit GhcPs
_ SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_) = [RdrName
n]
patBindNames (ConPat XConPat GhcPs
_ XRec GhcPs (ConLikeP GhcPs)
_ HsConPatDetails GhcPs
d) = (GenLocated SrcSpanAnnA (Pat GhcPs) -> [RdrName])
-> [GenLocated SrcSpanAnnA (Pat GhcPs)] -> [RdrName]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Pat GhcPs -> [RdrName]
patBindNames (Pat GhcPs -> [RdrName])
-> (GenLocated SrcSpanAnnA (Pat GhcPs) -> Pat GhcPs)
-> GenLocated SrcSpanAnnA (Pat GhcPs)
-> [RdrName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (Pat GhcPs) -> Pat GhcPs
forall l e. GenLocated l e -> e
unLoc) (HsConPatDetails GhcPs -> [LPat GhcPs]
forall p. UnXRec p => HsConPatDetails p -> [LPat p]
hsConPatArgs HsConPatDetails GhcPs
d)