{-# LANGUAGE BangPatterns #-}
-- needed on GHC 9.0 due to simplified subsumption
{-# LANGUAGE ImpredicativeTypes #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}

-- | This module allows us to diff two 'ParseResult's.
module Ormolu.Diff.ParseResult
  ( ParseResultDiff (..),
    diffParseResult,
  )
where

import Data.ByteString (ByteString)
import Data.Foldable
import Data.Generics
import GHC.Hs
import GHC.Types.SourceText
import GHC.Types.SrcLoc
import Ormolu.Imports (normalizeImports)
import Ormolu.Parser.CommentStream
import Ormolu.Parser.Result
import Ormolu.Utils

-- | Result of comparing two 'ParseResult's.
data ParseResultDiff
  = -- | Two parse results are the same
    Same
  | -- | Two parse results differ
    Different [SrcSpan]
  deriving (Int -> ParseResultDiff -> ShowS
[ParseResultDiff] -> ShowS
ParseResultDiff -> String
(Int -> ParseResultDiff -> ShowS)
-> (ParseResultDiff -> String)
-> ([ParseResultDiff] -> ShowS)
-> Show ParseResultDiff
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParseResultDiff] -> ShowS
$cshowList :: [ParseResultDiff] -> ShowS
show :: ParseResultDiff -> String
$cshow :: ParseResultDiff -> String
showsPrec :: Int -> ParseResultDiff -> ShowS
$cshowsPrec :: Int -> ParseResultDiff -> ShowS
Show)

instance Semigroup ParseResultDiff where
  ParseResultDiff
Same <> :: ParseResultDiff -> ParseResultDiff -> ParseResultDiff
<> ParseResultDiff
a = ParseResultDiff
a
  ParseResultDiff
a <> ParseResultDiff
Same = ParseResultDiff
a
  Different [SrcSpan]
xs <> Different [SrcSpan]
ys = [SrcSpan] -> ParseResultDiff
Different ([SrcSpan]
xs [SrcSpan] -> [SrcSpan] -> [SrcSpan]
forall a. [a] -> [a] -> [a]
++ [SrcSpan]
ys)

instance Monoid ParseResultDiff where
  mempty :: ParseResultDiff
mempty = ParseResultDiff
Same

-- | Return 'Diff' of two 'ParseResult's.
diffParseResult ::
  ParseResult ->
  ParseResult ->
  ParseResultDiff
diffParseResult :: ParseResult -> ParseResult -> ParseResultDiff
diffParseResult
  ParseResult
    { prCommentStream :: ParseResult -> CommentStream
prCommentStream = CommentStream
cstream0,
      prParsedSource :: ParseResult -> HsModule
prParsedSource = HsModule
hs0
    }
  ParseResult
    { prCommentStream :: ParseResult -> CommentStream
prCommentStream = CommentStream
cstream1,
      prParsedSource :: ParseResult -> HsModule
prParsedSource = HsModule
hs1
    } =
    CommentStream -> CommentStream -> ParseResultDiff
diffCommentStream CommentStream
cstream0 CommentStream
cstream1
      ParseResultDiff -> ParseResultDiff -> ParseResultDiff
forall a. Semigroup a => a -> a -> a
<> HsModule -> HsModule -> ParseResultDiff
forall a. Data a => a -> a -> ParseResultDiff
matchIgnoringSrcSpans
        HsModule
hs0 {hsmodImports :: [LImportDecl GhcPs]
hsmodImports = [[GenLocated SrcSpanAnnA (ImportDecl GhcPs)]]
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[GenLocated SrcSpanAnnA (ImportDecl GhcPs)]]
 -> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)])
-> ([GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
    -> [[GenLocated SrcSpanAnnA (ImportDecl GhcPs)]])
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> [LImportDecl GhcPs] -> [[LImportDecl GhcPs]]
normalizeImports Bool
False ([GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
 -> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)])
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
forall a b. (a -> b) -> a -> b
$ HsModule -> [LImportDecl GhcPs]
hsmodImports HsModule
hs0}
        HsModule
hs1 {hsmodImports :: [LImportDecl GhcPs]
hsmodImports = [[GenLocated SrcSpanAnnA (ImportDecl GhcPs)]]
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[GenLocated SrcSpanAnnA (ImportDecl GhcPs)]]
 -> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)])
-> ([GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
    -> [[GenLocated SrcSpanAnnA (ImportDecl GhcPs)]])
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> [LImportDecl GhcPs] -> [[LImportDecl GhcPs]]
normalizeImports Bool
False ([GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
 -> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)])
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
forall a b. (a -> b) -> a -> b
$ HsModule -> [LImportDecl GhcPs]
hsmodImports HsModule
hs1}

diffCommentStream :: CommentStream -> CommentStream -> ParseResultDiff
diffCommentStream :: CommentStream -> CommentStream -> ParseResultDiff
diffCommentStream (CommentStream [RealLocated Comment]
cs) (CommentStream [RealLocated Comment]
cs')
  | [RealLocated Comment] -> [String]
forall l. [GenLocated l Comment] -> [String]
commentLines [RealLocated Comment]
cs [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
== [RealLocated Comment] -> [String]
forall l. [GenLocated l Comment] -> [String]
commentLines [RealLocated Comment]
cs' = ParseResultDiff
Same
  | Bool
otherwise = [SrcSpan] -> ParseResultDiff
Different []
  where
    commentLines :: [GenLocated l Comment] -> [String]
commentLines = (GenLocated l Comment -> [String])
-> [GenLocated l Comment] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (NonEmpty String -> [String]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty String -> [String])
-> (GenLocated l Comment -> NonEmpty String)
-> GenLocated l Comment
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Comment -> NonEmpty String
unComment (Comment -> NonEmpty String)
-> (GenLocated l Comment -> Comment)
-> GenLocated l Comment
-> NonEmpty String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated l Comment -> Comment
forall l e. GenLocated l e -> e
unLoc)

-- | Compare two values for equality disregarding the following aspects:
--
--     * 'SrcSpan's
--     * ordering of import lists
--     * style (ASCII vs Unicode) of arrows
--     * LayoutInfo (brace style) in extension fields
--     * Empty contexts in type classes
--     * Parens around derived type classes
matchIgnoringSrcSpans :: Data a => a -> a -> ParseResultDiff
matchIgnoringSrcSpans :: a -> a -> ParseResultDiff
matchIgnoringSrcSpans a
a = a -> GenericQ ParseResultDiff
GenericQ (GenericQ ParseResultDiff)
genericQuery a
a
  where
    genericQuery :: GenericQ (GenericQ ParseResultDiff)
    genericQuery :: a -> GenericQ ParseResultDiff
genericQuery a
x a
y
      -- 'ByteString' implements 'Data' instance manually and does not
      -- implement 'toConstr', so we have to deal with it in a special way.
      | Just ByteString
x' <- a -> Maybe ByteString
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
x,
        Just ByteString
y' <- a -> Maybe ByteString
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
y =
          if ByteString
x' ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== (ByteString
y' :: ByteString)
            then ParseResultDiff
Same
            else [SrcSpan] -> ParseResultDiff
Different []
      | a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf a
x TypeRep -> TypeRep -> Bool
forall a. Eq a => a -> a -> Bool
== a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf a
y,
        a -> Constr
forall a. Data a => a -> Constr
toConstr a
x Constr -> Constr -> Bool
forall a. Eq a => a -> a -> Bool
== a -> Constr
forall a. Data a => a -> Constr
toConstr a
y =
          [ParseResultDiff] -> ParseResultDiff
forall a. Monoid a => [a] -> a
mconcat ([ParseResultDiff] -> ParseResultDiff)
-> [ParseResultDiff] -> ParseResultDiff
forall a b. (a -> b) -> a -> b
$
            GenericQ (GenericQ ParseResultDiff) -> a -> a -> [ParseResultDiff]
forall r. GenericQ (GenericQ r) -> GenericQ (GenericQ [r])
gzipWithQ
              ( a -> a -> ParseResultDiff
GenericQ (GenericQ ParseResultDiff)
genericQuery
                  (a -> a -> ParseResultDiff)
-> (SrcSpan -> a -> ParseResultDiff) -> a -> a -> ParseResultDiff
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` SrcSpan -> a -> ParseResultDiff
SrcSpan -> GenericQ ParseResultDiff
srcSpanEq
                  (a -> a -> ParseResultDiff)
-> (forall e. Data e => EpAnn e -> a -> ParseResultDiff)
-> a
-> a
-> ParseResultDiff
forall d (t :: * -> *) q.
(Data d, Typeable t) =>
(d -> q) -> (forall e. Data e => t e -> q) -> d -> q
`ext1Q` forall e. Data e => EpAnn e -> a -> ParseResultDiff
forall a. EpAnn a -> GenericQ ParseResultDiff
epAnnEq
                  (a -> a -> ParseResultDiff)
-> (SourceText -> a -> ParseResultDiff)
-> a
-> a
-> ParseResultDiff
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` SourceText -> a -> ParseResultDiff
SourceText -> GenericQ ParseResultDiff
sourceTextEq
                  (a -> a -> ParseResultDiff)
-> (HsDocString -> a -> ParseResultDiff)
-> a
-> a
-> ParseResultDiff
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` HsDocString -> a -> ParseResultDiff
HsDocString -> GenericQ ParseResultDiff
hsDocStringEq
                  (a -> a -> ParseResultDiff)
-> (ImportDeclQualifiedStyle -> a -> ParseResultDiff)
-> a
-> a
-> ParseResultDiff
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` ImportDeclQualifiedStyle -> a -> ParseResultDiff
ImportDeclQualifiedStyle -> GenericQ ParseResultDiff
importDeclQualifiedStyleEq
                  (a -> a -> ParseResultDiff)
-> (HsArrow GhcPs -> a -> ParseResultDiff)
-> a
-> a
-> ParseResultDiff
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` HsArrow GhcPs -> a -> ParseResultDiff
HsArrow GhcPs -> GenericQ ParseResultDiff
unicodeArrowStyleEq
                  (a -> a -> ParseResultDiff)
-> (LayoutInfo -> a -> ParseResultDiff)
-> a
-> a
-> ParseResultDiff
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` LayoutInfo -> a -> ParseResultDiff
LayoutInfo -> GenericQ ParseResultDiff
layoutInfoEq
                  (a -> a -> ParseResultDiff)
-> (TyClDecl GhcPs -> a -> ParseResultDiff)
-> a
-> a
-> ParseResultDiff
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` TyClDecl GhcPs -> a -> ParseResultDiff
TyClDecl GhcPs -> GenericQ ParseResultDiff
classDeclCtxEq
                  (a -> a -> ParseResultDiff)
-> (DerivClauseTys GhcPs -> a -> ParseResultDiff)
-> a
-> a
-> ParseResultDiff
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` DerivClauseTys GhcPs -> a -> ParseResultDiff
DerivClauseTys GhcPs -> GenericQ ParseResultDiff
derivedTyClsParensEq
                  (a -> a -> ParseResultDiff)
-> (EpAnnComments -> a -> ParseResultDiff)
-> a
-> a
-> ParseResultDiff
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` EpAnnComments -> a -> ParseResultDiff
EpAnnComments -> GenericQ ParseResultDiff
epaCommentsEq
                  (a -> a -> ParseResultDiff)
-> (forall d1 d2.
    (Data d1, Data d2) =>
    GenLocated d1 d2 -> a -> ParseResultDiff)
-> a
-> a
-> ParseResultDiff
forall d (t :: * -> * -> *) q.
(Data d, Typeable t) =>
(d -> q)
-> (forall d1 d2. (Data d1, Data d2) => t d1 d2 -> q) -> d -> q
`ext2Q` forall d1 d2.
(Data d1, Data d2) =>
GenLocated d1 d2 -> a -> ParseResultDiff
forall e0 e1.
(Data e0, Data e1) =>
GenLocated e0 e1 -> GenericQ ParseResultDiff
forLocated
              )
              a
x
              a
y
      | Bool
otherwise = [SrcSpan] -> ParseResultDiff
Different []
    srcSpanEq :: SrcSpan -> GenericQ ParseResultDiff
    srcSpanEq :: SrcSpan -> GenericQ ParseResultDiff
srcSpanEq SrcSpan
_ a
_ = ParseResultDiff
Same
    epAnnEq :: EpAnn a -> GenericQ ParseResultDiff
    epAnnEq :: EpAnn a -> GenericQ ParseResultDiff
epAnnEq EpAnn a
_ a
_ = ParseResultDiff
Same
    sourceTextEq :: SourceText -> GenericQ ParseResultDiff
    sourceTextEq :: SourceText -> GenericQ ParseResultDiff
sourceTextEq SourceText
_ a
_ = ParseResultDiff
Same
    importDeclQualifiedStyleEq ::
      ImportDeclQualifiedStyle ->
      GenericQ ParseResultDiff
    importDeclQualifiedStyleEq :: ImportDeclQualifiedStyle -> GenericQ ParseResultDiff
importDeclQualifiedStyleEq ImportDeclQualifiedStyle
d0 a
d1' =
      case (ImportDeclQualifiedStyle
d0, a -> Maybe ImportDeclQualifiedStyle
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
d1' :: Maybe ImportDeclQualifiedStyle) of
        (ImportDeclQualifiedStyle
x, Just ImportDeclQualifiedStyle
x') | ImportDeclQualifiedStyle
x ImportDeclQualifiedStyle -> ImportDeclQualifiedStyle -> Bool
forall a. Eq a => a -> a -> Bool
== ImportDeclQualifiedStyle
x' -> ParseResultDiff
Same
        (ImportDeclQualifiedStyle
QualifiedPre, Just ImportDeclQualifiedStyle
QualifiedPost) -> ParseResultDiff
Same
        (ImportDeclQualifiedStyle
QualifiedPost, Just ImportDeclQualifiedStyle
QualifiedPre) -> ParseResultDiff
Same
        (ImportDeclQualifiedStyle, Maybe ImportDeclQualifiedStyle)
_ -> [SrcSpan] -> ParseResultDiff
Different []
    hsDocStringEq :: HsDocString -> GenericQ ParseResultDiff
    hsDocStringEq :: HsDocString -> GenericQ ParseResultDiff
hsDocStringEq HsDocString
str0 a
str1' =
      case a -> Maybe HsDocString
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
str1' :: Maybe HsDocString of
        Maybe HsDocString
Nothing -> [SrcSpan] -> ParseResultDiff
Different []
        Just HsDocString
str1 ->
          if HsDocString -> [Text]
splitDocString HsDocString
str0 [Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
== HsDocString -> [Text]
splitDocString HsDocString
str1
            then ParseResultDiff
Same
            else [SrcSpan] -> ParseResultDiff
Different []
    forLocated ::
      (Data e0, Data e1) =>
      GenLocated e0 e1 ->
      GenericQ ParseResultDiff
    forLocated :: GenLocated e0 e1 -> GenericQ ParseResultDiff
forLocated x :: GenLocated e0 e1
x@(L e0
mspn e1
_) a
y =
      (ParseResultDiff -> ParseResultDiff)
-> (SrcSpan -> ParseResultDiff -> ParseResultDiff)
-> Maybe SrcSpan
-> ParseResultDiff
-> ParseResultDiff
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ParseResultDiff -> ParseResultDiff
forall a. a -> a
id SrcSpan -> ParseResultDiff -> ParseResultDiff
appendSpan (e0 -> Maybe SrcSpan
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast (e0 -> Maybe SrcSpan)
-> (forall e. Data e => SrcSpanAnn' e -> Maybe SrcSpan)
-> e0
-> Maybe SrcSpan
forall d (t :: * -> *) q.
(Data d, Typeable t) =>
(d -> q) -> (forall e. Data e => t e -> q) -> d -> q
`ext1Q` (SrcSpan -> Maybe SrcSpan
forall a. a -> Maybe a
Just (SrcSpan -> Maybe SrcSpan)
-> (SrcSpanAnn' e -> SrcSpan) -> SrcSpanAnn' e -> Maybe SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpanAnn' e -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA) (e0 -> Maybe SrcSpan) -> e0 -> Maybe SrcSpan
forall a b. (a -> b) -> a -> b
$ e0
mspn) (GenLocated e0 e1 -> a -> ParseResultDiff
GenericQ (GenericQ ParseResultDiff)
genericQuery GenLocated e0 e1
x a
y)
    appendSpan :: SrcSpan -> ParseResultDiff -> ParseResultDiff
    appendSpan :: SrcSpan -> ParseResultDiff -> ParseResultDiff
appendSpan SrcSpan
s (Different [SrcSpan]
ss) | Bool
fresh Bool -> Bool -> Bool
&& Bool
helpful = [SrcSpan] -> ParseResultDiff
Different (SrcSpan
s SrcSpan -> [SrcSpan] -> [SrcSpan]
forall a. a -> [a] -> [a]
: [SrcSpan]
ss)
      where
        fresh :: Bool
fresh = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (SrcSpan -> Bool) -> [SrcSpan] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (SrcSpan -> SrcSpan -> Bool
`isSubspanOf` SrcSpan
s) [SrcSpan]
ss
        helpful :: Bool
helpful = SrcSpan -> Bool
isGoodSrcSpan SrcSpan
s
    appendSpan SrcSpan
_ ParseResultDiff
d = ParseResultDiff
d
    -- as we normalize arrow styles (e.g. -> vs →), we consider them equal here
    unicodeArrowStyleEq :: HsArrow GhcPs -> GenericQ ParseResultDiff
    unicodeArrowStyleEq :: HsArrow GhcPs -> GenericQ ParseResultDiff
unicodeArrowStyleEq (HsUnrestrictedArrow IsUnicodeSyntax
_) (a -> Maybe (HsArrow GhcPs)
forall a. Typeable a => a -> Maybe (HsArrow GhcPs)
castArrow -> Just (HsUnrestrictedArrow IsUnicodeSyntax
_)) = ParseResultDiff
Same
    unicodeArrowStyleEq (HsLinearArrow IsUnicodeSyntax
_ Maybe AddEpAnn
_) (a -> Maybe (HsArrow GhcPs)
forall a. Typeable a => a -> Maybe (HsArrow GhcPs)
castArrow -> Just (HsLinearArrow IsUnicodeSyntax
_ Maybe AddEpAnn
_)) = ParseResultDiff
Same
    unicodeArrowStyleEq (HsExplicitMult IsUnicodeSyntax
_ Maybe AddEpAnn
_ LHsType GhcPs
t) (a -> Maybe (HsArrow GhcPs)
forall a. Typeable a => a -> Maybe (HsArrow GhcPs)
castArrow -> Just (HsExplicitMult IsUnicodeSyntax
_ Maybe AddEpAnn
_ LHsType GhcPs
t')) = GenLocated SrcSpanAnnA (HsType GhcPs)
-> GenLocated SrcSpanAnnA (HsType GhcPs) -> ParseResultDiff
GenericQ (GenericQ ParseResultDiff)
genericQuery LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
t LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
t'
    unicodeArrowStyleEq HsArrow GhcPs
_ a
_ = [SrcSpan] -> ParseResultDiff
Different []
    castArrow :: Typeable a => a -> Maybe (HsArrow GhcPs)
    castArrow :: a -> Maybe (HsArrow GhcPs)
castArrow = a -> Maybe (HsArrow GhcPs)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast
    -- LayoutInfo ~ XClassDecl GhcPs tracks brace information
    layoutInfoEq :: LayoutInfo -> GenericQ ParseResultDiff
    layoutInfoEq :: LayoutInfo -> GenericQ ParseResultDiff
layoutInfoEq LayoutInfo
_ (a -> Maybe LayoutInfo
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast -> Just (LayoutInfo
_ :: LayoutInfo)) = ParseResultDiff
Same
    layoutInfoEq LayoutInfo
_ a
_ = [SrcSpan] -> ParseResultDiff
Different []
    classDeclCtxEq :: TyClDecl GhcPs -> GenericQ ParseResultDiff
    classDeclCtxEq :: TyClDecl GhcPs -> GenericQ ParseResultDiff
classDeclCtxEq ClassDecl {tcdCtxt :: forall pass. TyClDecl pass -> Maybe (LHsContext pass)
tcdCtxt = Just (L _ []), [LHsFunDep GhcPs]
[LFamilyDecl GhcPs]
[LTyFamDefltDecl GhcPs]
[LDocDecl GhcPs]
[LSig GhcPs]
LHsQTyVars GhcPs
LIdP GhcPs
XClassDecl GhcPs
LexicalFixity
LHsBinds GhcPs
tcdLName :: forall pass. TyClDecl pass -> LIdP pass
tcdTyVars :: forall pass. TyClDecl pass -> LHsQTyVars pass
tcdFixity :: forall pass. TyClDecl pass -> LexicalFixity
tcdCExt :: forall pass. TyClDecl pass -> XClassDecl pass
tcdFDs :: forall pass. TyClDecl pass -> [LHsFunDep pass]
tcdSigs :: forall pass. TyClDecl pass -> [LSig pass]
tcdMeths :: forall pass. TyClDecl pass -> LHsBinds pass
tcdATs :: forall pass. TyClDecl pass -> [LFamilyDecl pass]
tcdATDefs :: forall pass. TyClDecl pass -> [LTyFamDefltDecl pass]
tcdDocs :: forall pass. TyClDecl pass -> [LDocDecl 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
tcdCExt :: XClassDecl GhcPs
..} a
tc' = TyClDecl GhcPs -> a -> ParseResultDiff
GenericQ (GenericQ ParseResultDiff)
genericQuery ClassDecl :: forall pass.
XClassDecl pass
-> Maybe (LHsContext pass)
-> LIdP pass
-> LHsQTyVars pass
-> LexicalFixity
-> [LHsFunDep pass]
-> [LSig pass]
-> LHsBinds pass
-> [LFamilyDecl pass]
-> [LTyFamDefltDecl pass]
-> [LDocDecl pass]
-> TyClDecl pass
ClassDecl {tcdCtxt :: Maybe (LHsContext GhcPs)
tcdCtxt = Maybe (LHsContext GhcPs)
forall a. Maybe a
Nothing, [LHsFunDep GhcPs]
[LFamilyDecl GhcPs]
[LTyFamDefltDecl GhcPs]
[LDocDecl GhcPs]
[LSig GhcPs]
LHsQTyVars GhcPs
LIdP GhcPs
XClassDecl GhcPs
LexicalFixity
LHsBinds GhcPs
tcdLName :: LIdP GhcPs
tcdTyVars :: LHsQTyVars GhcPs
tcdFixity :: LexicalFixity
tcdCExt :: XClassDecl GhcPs
tcdFDs :: [LHsFunDep GhcPs]
tcdSigs :: [LSig GhcPs]
tcdMeths :: LHsBinds GhcPs
tcdATs :: [LFamilyDecl GhcPs]
tcdATDefs :: [LTyFamDefltDecl GhcPs]
tcdDocs :: [LDocDecl GhcPs]
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
tcdCExt :: XClassDecl GhcPs
..} a
tc'
    classDeclCtxEq TyClDecl GhcPs
tc a
tc' = TyClDecl GhcPs -> a -> ParseResultDiff
GenericQ (GenericQ ParseResultDiff)
genericQuery TyClDecl GhcPs
tc a
tc'
    derivedTyClsParensEq :: DerivClauseTys GhcPs -> GenericQ ParseResultDiff
    derivedTyClsParensEq :: DerivClauseTys GhcPs -> GenericQ ParseResultDiff
derivedTyClsParensEq (DctSingle XDctSingle GhcPs
NoExtField LHsSigType GhcPs
sigTy) a
dct' = DerivClauseTys GhcPs -> a -> ParseResultDiff
GenericQ (GenericQ ParseResultDiff)
genericQuery (XDctMulti GhcPs -> [LHsSigType GhcPs] -> DerivClauseTys GhcPs
forall pass.
XDctMulti pass -> [LHsSigType pass] -> DerivClauseTys pass
DctMulti NoExtField
XDctMulti GhcPs
NoExtField [LHsSigType GhcPs
sigTy]) a
dct'
    derivedTyClsParensEq DerivClauseTys GhcPs
dct a
dct' = DerivClauseTys GhcPs -> a -> ParseResultDiff
GenericQ (GenericQ ParseResultDiff)
genericQuery DerivClauseTys GhcPs
dct a
dct'
    -- EpAnnComments ~ XCGRHSs GhcPs
    epaCommentsEq :: EpAnnComments -> GenericQ ParseResultDiff
    epaCommentsEq :: EpAnnComments -> GenericQ ParseResultDiff
epaCommentsEq EpAnnComments
_ (a -> Maybe EpAnnComments
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast -> Just (EpAnnComments
_ :: EpAnnComments)) = ParseResultDiff
Same
    epaCommentsEq EpAnnComments
_ a
_ = [SrcSpan] -> ParseResultDiff
Different []