bf22720 · ormolu · git.iko.soy

git.iko.soy/ormolu

on master help sign in

Implement diffing of comment annotations

bf22720mrkkrp8 years ago

ormolu.cabal+1

compare with master

unifiedsplit

@@ -37,6 +37,7 @@ library

37 , syb >= 0.7 && < 0.8

38 , text >= 0.2 && < 1.3

39 exposed-modules: Ormolu

40+ , Ormolu.Comments

40 , Ormolu.Config

41 , Ormolu.Config

41 , Ormolu.Diff

42 , Ormolu.Diff

42 , Ormolu.Parser

43 , Ormolu.Parser

src/Ormolu/Comments.hsnew file+33

@@ -0,0 +1,33 @@

1+-- | Various functions for manipulation of 'Comment's.

3+module Ormolu.Comments

4+ ( annComment

5+ , normalizeComment

6+ )

7+where

9+import Data.List (isPrefixOf)

10+import Language.Haskell.GHC.ExactPrint.Types

11+

12+-- | If 'KeywordId' is a comment, extract it.

13+

14+annComment :: KeywordId -> Maybe Comment

15+annComment (AnnComment x) = Just x

16+annComment _ = Nothing

17+

18+-- | Normalize comment string. Sometimes one multi-line comment is turned

19+-- into several lines for subsequent outputting with correct indentation for

20+-- each line.

21+

22+normalizeComment :: String -> [String]

23+normalizeComment s =

24+ if isMultiline s

25+ then if isPragma s

26+ then [normalizePragma s]

27+ else normalizeIndent s

28+ else [s]

29+ where

30+ isMultiline x = not ("--" `isPrefixOf` x)

31+ isPragma x = "{-#" `isPrefixOf` x

32+ normalizeIndent = fmap (dropWhile (== ' ')) . lines

33+ normalizePragma = unwords . words

src/Ormolu/Diff.hs+30−4

@@ -1,5 +1,6 @@

1{-# LANGUAGE DeriveDataTypeable #-}

2{-# LANGUAGE RankNTypes #-}

3+{-# LANGUAGE RecordWildCards #-}

4-- | Diffing GHC ASTs modulo span positions.

5-- | Diffing GHC ASTs modulo span positions.

@@ -9,8 +10,11 @@ module Ormolu.Diff

9where

10where

11import Data.Generics

12import Data.Generics

13+import Data.Maybe (mapMaybe)

12import GHC

14import GHC

13import Language.Haskell.GHC.ExactPrint.Types

15import Language.Haskell.GHC.ExactPrint.Types

16+import Ormolu.Comments

17+import qualified Data.Map.Strict as M

15-- | Return 'False' of two annotated ASTs are the same modulo span

19-- | Return 'False' of two annotated ASTs are the same modulo span

16-- positions.

20-- positions.

@@ -19,17 +23,39 @@ diff

19 :: (Anns, ParsedSource) -- ^ First annotated AST

23 :: (Anns, ParsedSource) -- ^ First annotated AST

20 -> (Anns, ParsedSource) -- ^ Second annotated AST

24 -> (Anns, ParsedSource) -- ^ Second annotated AST

21 -> Bool

25 -> Bool

22−diff (_, ps0) (_, ps1) =

26+diff (anns0, ps0) (anns1, ps1) =

23− not (matchParsedSources ps0 ps1)

27+ not (matchIgnoringSrcSpans (simplifyAnns anns0) (simplifyAnns anns1))

28+ || not (matchIgnoringSrcSpans ps0 ps1)

25-- | Compare two 'ParsedSource' values disregarding differences in

30-- | Compare two 'ParsedSource' values disregarding differences in

26-- 'SrcSpan's.

31-- 'SrcSpan's.

28−matchParsedSources :: ParsedSource -> ParsedSource -> Bool

33+matchIgnoringSrcSpans :: Data a => a -> a -> Bool

29−matchParsedSources x0 y0 = geq' x0 y0

34+matchIgnoringSrcSpans x0 y0 = geq' x0 y0

30 where

35 where

31 geq' :: GenericQ (GenericQ Bool)

36 geq' :: GenericQ (GenericQ Bool)

32 geq' x y = (toConstr x == toConstr y)

37 geq' x y = (toConstr x == toConstr y)

33 && and (gzipWithQ (geq' `extQ` srcSpanEq) x y)

38 && and (gzipWithQ (geq' `extQ` srcSpanEq) x y)

34 srcSpanEq :: SrcSpan -> GenericQ Bool

39 srcSpanEq :: SrcSpan -> GenericQ Bool

35 srcSpanEq _ _ = True

40 srcSpanEq _ _ = True

41+

42+-- | Simplified collection of 'Comment's.

43+

44+data Comments = Comments [Comment] [Comment] [Comment]

45+ deriving (Show, Typeable, Data)

46+

47+-- | Simplify a collection of annotations.

48+

49+simplifyAnns :: Anns -> [Comments]

50+simplifyAnns = fmap simplifyAnn . M.elems

51+

52+-- | Simplify single annotation.

53+

54+simplifyAnn :: Annotation -> Comments

55+simplifyAnn Ann {..} = Comments

56+ (f . fst <$> annPriorComments)

57+ (f . fst <$> annFollowingComments)

58+ (mapMaybe (fmap f . annComment) (fst <$> annsDP))

59+ where

60+ f (Comment str i o) =

61+ Comment (unlines $ normalizeComment str) i o

src/Ormolu/Printer/Comments.hs+4−20

@@ -19,9 +19,9 @@ where

19import ApiAnnotation (AnnKeywordId (AnnModule))

20import Control.Monad

21import Data.Bifunctor

22−import Data.List (isPrefixOf)

23import Data.Maybe (mapMaybe)

22import Data.Maybe (mapMaybe)

24import Language.Haskell.GHC.ExactPrint.Types

23import Language.Haskell.GHC.ExactPrint.Types

24+import Ormolu.Comments

25import Ormolu.Printer.Internal

26import SrcLoc

27import qualified Data.Text as T

@@ -71,19 +71,9 @@ spitComments = mapM_ $ \(comment, (Decoration d0 d1)) -> do

72spitComment :: Comment -> R ()

73spitComment (Comment str _ _) =

74− if isMultiline str

74+ forM_ (normalizeComment str) $ \x -> do

75− then if isPragma str

76− then handleOne (normalizePragma str)

77− else forM_ (normalizeIndent str) handleOne

78− else handleOne str

79− where

80− handleOne x = do

81− ensureIndent

75+ ensureIndent

82− spit (T.pack x)

76+ spit (T.pack x)

83− isMultiline x = not ("--" `isPrefixOf` x)

84− isPragma x = "{-#" `isPrefixOf` x

85− normalizeIndent = fmap (dropWhile (== ' ')) . lines

86− normalizePragma = unwords . words

88-- | Partition annotations to get a collection of 'Comment's preceding a

78-- | Partition annotations to get a collection of 'Comment's preceding a

89-- definition and following it. Every 'Comment' has corresponding

79-- definition and following it. Every 'Comment' has corresponding

@@ -144,12 +134,6 @@ fixupLastDec [] = []

144fixupLastDec [(c, Decoration d0 _)] = [(c, Decoration d0 NoDec)]

134fixupLastDec [(c, Decoration d0 _)] = [(c, Decoration d0 NoDec)]

145fixupLastDec (c:cs) = c : fixupLastDec cs

135fixupLastDec (c:cs) = c : fixupLastDec cs

146

136

147−-- | If 'KeywordId' is a comment, extract it.

148−

149−annComment :: KeywordId -> Maybe Comment

150−annComment (AnnComment x) = Just x

151−annComment _ = Nothing

152−

153-- | Replace 'DeltaPos' with 'Decoration'.

137-- | Replace 'DeltaPos' with 'Decoration'.

154

138

155addDecoration

139addDecoration