git.iko.soy/ormolu
on 625f239 help sign in
ormolu/src/Ormolu/Diff.hs
98 lines 2.9 kB history raw
1{-# LANGUAGE DeriveDataTypeable #-}
2{-# LANGUAGE RankNTypes #-}
3{-# LANGUAGE RecordWildCards #-}
5-- | Diffing GHC ASTs modulo span positions.
7module Ormolu.Diff
8 ( diff
9 , Diff(..)
10 )
11where
13import BasicTypes (SourceText)
14import Data.ByteString (ByteString)
15import Data.Generics
16import GHC
17import Ormolu.Imports (sortImports)
18import Ormolu.Parser.Result
20-- | Result of comparing two 'ParseResult's.
22data Diff
23 = Same -- ^ Two parse results are the same
24 | Different [SrcSpan] -- ^ Two parse results differ
26instance Semigroup Diff where
27 Same <> a = a
28 a <> Same = a
29 Different xs <> Different ys = Different (xs ++ ys)
31instance Monoid Diff where
32 mempty = Same
34-- | Return 'False' if two annotated ASTs are the same modulo span
35-- positions.
37diff :: ParseResult -> ParseResult -> Diff
38diff ParseResult { prCommentStream = cstream0
39 , prParsedSource = ps0
40 }
41 ParseResult { prCommentStream = cstream1
42 , prParsedSource = ps1
43 } =
44 matchIgnoringSrcSpans cstream0 cstream1 <>
45 matchIgnoringSrcSpans ps0 ps1
47-- | Compare two values for equality disregarding differences in 'SrcSpan's
48-- and the ordering of import lists.
50matchIgnoringSrcSpans :: Data a => a -> a -> Diff
51matchIgnoringSrcSpans = genericQuery
52 where
53 genericQuery :: GenericQ (GenericQ Diff)
54 genericQuery x y
55 -- NOTE 'ByteString' implement 'Data' instance manually and does not
56 -- implement 'toConstr', so we have to deal with it in a special way.
57 | Just x' <- cast x, Just y' <- cast y =
58 if x' == (y' :: ByteString)
59 then Same
60 else Different []
61 | typeOf x == typeOf y, toConstr x == toConstr y =
62 mconcat $ gzipWithQ
63 (genericQuery
64 `extQ` srcSpanEq
65 `extQ` hsModuleEq
66 `extQ` sourceTextEq
67 `ext2Q` forLocated)
68 x y
69 | otherwise = Different []
71 srcSpanEq :: SrcSpan -> GenericQ Diff
72 srcSpanEq _ _ = Same
74 hsModuleEq :: HsModule GhcPs -> GenericQ Diff
75 hsModuleEq hs0 hs1' =
76 case cast hs1' :: Maybe (HsModule GhcPs) of
77 Nothing -> Different []
78 Just hs1 ->
79 matchIgnoringSrcSpans
80 hs0 { hsmodImports = sortImports (hsmodImports hs0) }
81 hs1 { hsmodImports = sortImports (hsmodImports hs1) }
83 sourceTextEq :: SourceText -> GenericQ Diff
84 sourceTextEq _ _ = Same
86 forLocated
87 :: (Data e0, Data e1)
88 => GenLocated e0 e1
89 -> GenericQ Diff
90 forLocated x@(L mspn _) y =
91 maybe id appendSpan (cast mspn) (genericQuery x y)
93 appendSpan :: SrcSpan -> Diff -> Diff
94 appendSpan s (Different ss) | fresh && helpful = Different (s:ss)
95 where
96 fresh = not $ any (flip isSubspanOf s) ss
97 helpful = isGoodSrcSpan s
98 appendSpan _ d = d