git.iko.soy/ormolu
on 2cae331 help sign in
ormolu/src/Ormolu/Diff.hs
91 lines 2.6 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.Generics
15import GHC
16import Ormolu.Imports (sortImports)
17import Ormolu.Parser.Result
19-- | Result of comparing two 'ParseResult's.
21data Diff
22 = Same -- ^ Two parse results are the same
23 | Different [SrcSpan] -- ^ Two parse results differ
25instance Semigroup Diff where
26 Same <> a = a
27 a <> Same = a
28 Different xs <> Different ys = Different (xs ++ ys)
30instance Monoid Diff where
31 mempty = Same
33-- | Return 'False' if two annotated ASTs are the same modulo span
34-- positions.
36diff :: ParseResult -> ParseResult -> Diff
37diff ParseResult { prCommentStream = cstream0
38 , prParsedSource = ps0
39 }
40 ParseResult { prCommentStream = cstream1
41 , prParsedSource = ps1
42 } =
43 matchIgnoringSrcSpans cstream0 cstream1 <>
44 matchIgnoringSrcSpans ps0 ps1
46-- | Compare two values for equality disregarding differences in 'SrcSpan's
47-- and the ordering of import lists.
49matchIgnoringSrcSpans :: Data a => a -> a -> Diff
50matchIgnoringSrcSpans = genericQuery
51 where
52 genericQuery :: GenericQ (GenericQ Diff)
53 genericQuery x y
54 | typeOf x == typeOf y, toConstr x == toConstr y =
55 mconcat $ gzipWithQ
56 (genericQuery
57 `extQ` srcSpanEq
58 `extQ` hsModuleEq
59 `extQ` sourceTextEq
60 `ext2Q` forLocated)
61 x y
62 | otherwise = Different []
64 srcSpanEq :: SrcSpan -> GenericQ Diff
65 srcSpanEq _ _ = Same
67 hsModuleEq :: HsModule GhcPs -> GenericQ Diff
68 hsModuleEq hs0 hs1' =
69 case cast hs1' :: Maybe (HsModule GhcPs) of
70 Nothing -> Different []
71 Just hs1 ->
72 matchIgnoringSrcSpans
73 hs0 { hsmodImports = sortImports (hsmodImports hs0) }
74 hs1 { hsmodImports = sortImports (hsmodImports hs1) }
76 sourceTextEq :: SourceText -> GenericQ Diff
77 sourceTextEq _ _ = Same
79 forLocated
80 :: (Data e0, Data e1)
81 => GenLocated e0 e1
82 -> GenericQ Diff
83 forLocated x@(L mspn _) y =
84 maybe id appendSpan (cast mspn) (genericQuery x y)
86 appendSpan :: SrcSpan -> Diff -> Diff
87 appendSpan s (Different ss) | fresh && helpful = Different (s:ss)
88 where
89 fresh = not $ any (flip isSubspanOf s) ss
90 helpful = isGoodSrcSpan s
91 appendSpan _ d = d