{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ImpredicativeTypes #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}
module Ormolu.Diff.ParseResult
( ParseResultDiff (..),
diffParseResult,
)
where
import Data.ByteString (ByteString)
import Data.Generics
import GHC.Hs
import GHC.Types.Basic
import GHC.Types.SrcLoc
import Ormolu.Imports (normalizeImports)
import Ormolu.Parser.CommentStream
import Ormolu.Parser.Result
import Ormolu.Utils
data ParseResultDiff
=
Same
|
Different [SrcSpan]
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
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
forall a. Data a => a -> a -> ParseResultDiff
matchIgnoringSrcSpans 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 = [[LImportDecl GhcPs]] -> [LImportDecl GhcPs]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[LImportDecl GhcPs]] -> [LImportDecl GhcPs])
-> ([LImportDecl GhcPs] -> [[LImportDecl GhcPs]])
-> [LImportDecl GhcPs]
-> [LImportDecl GhcPs]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> [LImportDecl GhcPs] -> [[LImportDecl GhcPs]]
normalizeImports Bool
False ([LImportDecl GhcPs] -> [LImportDecl GhcPs])
-> [LImportDecl GhcPs] -> [LImportDecl GhcPs]
forall a b. (a -> b) -> a -> b
$ HsModule -> [LImportDecl GhcPs]
hsmodImports HsModule
hs0}
HsModule
hs1 {hsmodImports :: [LImportDecl GhcPs]
hsmodImports = [[LImportDecl GhcPs]] -> [LImportDecl GhcPs]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[LImportDecl GhcPs]] -> [LImportDecl GhcPs])
-> ([LImportDecl GhcPs] -> [[LImportDecl GhcPs]])
-> [LImportDecl GhcPs]
-> [LImportDecl GhcPs]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> [LImportDecl GhcPs] -> [[LImportDecl GhcPs]]
normalizeImports Bool
False ([LImportDecl GhcPs] -> [LImportDecl GhcPs])
-> [LImportDecl GhcPs] -> [LImportDecl GhcPs]
forall a b. (a -> b) -> a -> b
$ HsModule -> [LImportDecl GhcPs]
hsmodImports HsModule
hs1}
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
| 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)
-> (Comment -> a -> ParseResultDiff) -> a -> a -> ParseResultDiff
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` Comment -> a -> ParseResultDiff
Comment -> GenericQ ParseResultDiff
commentEq
(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)
-> (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
commentEq :: Comment -> GenericQ ParseResultDiff
commentEq :: Comment -> GenericQ ParseResultDiff
commentEq (Comment Bool
_ NonEmpty String
x) a
d =
case a -> Maybe Comment
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
d :: Maybe Comment of
Maybe Comment
Nothing -> [SrcSpan] -> ParseResultDiff
Different []
Just (Comment Bool
_ NonEmpty String
y) ->
if NonEmpty String
x NonEmpty String -> NonEmpty String -> Bool
forall a. Eq a => a -> a -> Bool
== NonEmpty String
y
then ParseResultDiff
Same
else [SrcSpan] -> ParseResultDiff
Different []
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
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
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
_) (a -> Maybe (HsArrow GhcPs)
forall a. Typeable a => a -> Maybe (HsArrow GhcPs)
castArrow -> Just (HsLinearArrow IsUnicodeSyntax
_)) = ParseResultDiff
Same
unicodeArrowStyleEq (HsExplicitMult IsUnicodeSyntax
_ LHsType GhcPs
t) (a -> Maybe (HsArrow GhcPs)
forall a. Typeable a => a -> Maybe (HsArrow GhcPs)
castArrow -> Just (HsExplicitMult IsUnicodeSyntax
_ LHsType GhcPs
t')) = LHsType GhcPs -> LHsType GhcPs -> ParseResultDiff
GenericQ (GenericQ ParseResultDiff)
genericQuery LHsType GhcPs
t LHsType 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
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 []