3fbc130 · ormolu · git.iko.soy

git.iko.soy/ormolu

on master help sign in

Factor out the ‘isModule’ function and the use of module span

3fbc130Mark Karpov6 years ago

src/GHC.hs−3

compare with master

unifiedsplit

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

1module GHC

2 ( module X,

3− ParsedSource,

4 )

3 )

5where

4where

@@ -11,5 +10,3 @@ import GHC.Hs.Instances as X ()

11import Module as X

10import Module as X

12import RdrName as X

11import RdrName as X

13import SrcLoc as X

12import SrcLoc as X

14−

15−type ParsedSource = Located (HsModule GhcPs)

src/Ormolu/Diff.hs+5−12

@@ -38,14 +38,16 @@ diffParseResult :: ParseResult -> ParseResult -> Diff

38diffParseResult

39 ParseResult

40 { prCommentStream = cstream0,

41− prParsedSource = ps0

41+ prParsedSource = hs0

42 }

43 ParseResult

44 { prCommentStream = cstream1,

45− prParsedSource = ps1

45+ prParsedSource = hs1

46 } =

47 matchIgnoringSrcSpans cstream0 cstream1

48− <> matchIgnoringSrcSpans ps0 ps1

48+ <> matchIgnoringSrcSpans

49+ hs0 {hsmodImports = sortImports (hsmodImports hs0)}

50+ hs1 {hsmodImports = sortImports (hsmodImports hs1)}

50-- | Compare two values for equality disregarding differences in 'SrcSpan's

52-- | Compare two values for equality disregarding differences in 'SrcSpan's

51-- and the ordering of import lists.

53-- and the ordering of import lists.

@@ -67,7 +69,6 @@ matchIgnoringSrcSpans = genericQuery

67 gzipWithQ

69 gzipWithQ

68 ( genericQuery

70 ( genericQuery

69 `extQ` srcSpanEq

71 `extQ` srcSpanEq

70− `extQ` hsModuleEq

71 `extQ` sourceTextEq

72 `extQ` sourceTextEq

72 `extQ` hsDocStringEq

73 `extQ` hsDocStringEq

73 `extQ` importDeclQualifiedStyleEq

74 `extQ` importDeclQualifiedStyleEq

@@ -78,14 +79,6 @@ matchIgnoringSrcSpans = genericQuery

78 | otherwise = Different []

79 | otherwise = Different []

79 srcSpanEq :: SrcSpan -> GenericQ Diff

80 srcSpanEq :: SrcSpan -> GenericQ Diff

80 srcSpanEq _ _ = Same

81 srcSpanEq _ _ = Same

81− hsModuleEq :: HsModule GhcPs -> GenericQ Diff

82− hsModuleEq hs0 hs1' =

83− case cast hs1' :: Maybe (HsModule GhcPs) of

84− Nothing -> Different []

85− Just hs1 ->

86− matchIgnoringSrcSpans

87− hs0 {hsmodImports = sortImports (hsmodImports hs0)}

88− hs1 {hsmodImports = sortImports (hsmodImports hs1)}

89 sourceTextEq :: SourceText -> GenericQ Diff

82 sourceTextEq :: SourceText -> GenericQ Diff

90 sourceTextEq _ _ = Same

83 sourceTextEq _ _ = Same

91 importDeclQualifiedStyleEq :: ImportDeclQualifiedStyle -> GenericQ Diff

84 importDeclQualifiedStyleEq :: ImportDeclQualifiedStyle -> GenericQ Diff

src/Ormolu/Parser.hs+2−2

@@ -88,7 +88,7 @@ parseModule Config {..} path rawInput = liftIO $ do

88 case pStateErrors pstate of

89 Just err -> Left err

90 Nothing -> error "PFailed does not have an error"

91− GHC.POk pstate pmod ->

91+ GHC.POk pstate (L _ hsModule) ->

92 case pStateErrors pstate of

93 -- Some parse errors (pattern/arrow syntax in expr context)

94 -- do not cause a parse error, but they are replaced with "_"

@@ -100,7 +100,7 @@ parseModule Config {..} path rawInput = liftIO $ do

100 mkCommentStream extraComments pstate

101 in Right

102 ParseResult

103− { prParsedSource = pmod,

103+ { prParsedSource = hsModule,

104 prAnns = mkAnns pstate,

105 prStackHeader = stackHeader,

106 prShebangs = shebangs,

src/Ormolu/Parser/Result.hs+1−1

@@ -17,7 +17,7 @@ import Ormolu.Parser.Shebang (Shebang)

17-- | A collection of data that represents a parsed module in Ormolu.

18data ParseResult = ParseResult

19 { -- | 'ParsedSource' from GHC

20− prParsedSource :: ParsedSource,

20+ prParsedSource :: HsModule GhcPs,

21 -- | Ormolu-specfic representation of annotations

22 prAnns :: Anns,

23 -- | Stack header

src/Ormolu/Printer/Combinators.hs+6−19

@@ -62,12 +62,10 @@ module Ormolu.Printer.Combinators

62where

64import Control.Monad

65−import Data.Data (Data)

66import Data.List (intersperse)

65import Data.List (intersperse)

67import Data.Text (Text)

66import Data.Text (Text)

68import Ormolu.Printer.Comments

67import Ormolu.Printer.Comments

69import Ormolu.Printer.Internal

68import Ormolu.Printer.Internal

70−import Ormolu.Utils (isModule)

71import SrcLoc

69import SrcLoc

73----------------------------------------------------------------------------

71----------------------------------------------------------------------------

@@ -79,31 +77,20 @@ import SrcLoc

79-- 'Located' wrapper, it should be “discharged” with a corresponding

77-- 'Located' wrapper, it should be “discharged” with a corresponding

80-- 'located' invocation.

78-- 'located' invocation.

81located ::

79located ::

82− Data a =>

83 -- | Thing to enter

80 -- | Thing to enter

84 Located a ->

81 Located a ->

85 -- | How to render inner value

82 -- | How to render inner value

86 (a -> R ()) ->

83 (a -> R ()) ->

87 R ()

84 R ()

88−located loc f = do

85+located (L (UnhelpfulSpan _) a) f = f a

89− let withRealLocated (L l a) g =

86+located (L (RealSrcSpan l) a) f = do

90− case l of

91− UnhelpfulSpan _ -> return ()

92− RealSrcSpan l' -> g (L l' a)

93− withRealLocated loc spitPrecedingComments

87+ spitPrecedingComments l

94− let setEnclosingSpan =

95− case getLoc loc of

96− UnhelpfulSpan _ -> id

97− RealSrcSpan orf ->

98− if isModule (unLoc loc)

99− then id

100− else withEnclosingSpan orf

88+ withEnclosingSpan l $

101− setEnclosingSpan $ switchLayout [getLoc loc] (f (unLoc loc))

89+ switchLayout [RealSrcSpan l] (f a)

102− withRealLocated loc spitFollowingComments

90+ spitFollowingComments l

103

104-- | A version of 'located' with arguments flipped.

92-- | A version of 'located' with arguments flipped.

105located' ::

93located' ::

106− Data a =>

107 -- | How to render inner value

94 -- | How to render inner value

108 (a -> R ()) ->

95 (a -> R ()) ->

109 -- | Thing to enter

96 -- | Thing to enter

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

@@ -14,12 +14,10 @@ where

15import Control.Monad

16import Data.Coerce (coerce)

17−import Data.Data (Data)

18import qualified Data.List.NonEmpty as NE

17import qualified Data.List.NonEmpty as NE

19import qualified Data.Text as T

18import qualified Data.Text as T

20import Ormolu.Parser.CommentStream

19import Ormolu.Parser.CommentStream

21import Ormolu.Printer.Internal

20import Ormolu.Printer.Internal

22−import Ormolu.Utils (isModule)

23import SrcLoc

21import SrcLoc

25----------------------------------------------------------------------------

23----------------------------------------------------------------------------

@@ -27,9 +25,8 @@ import SrcLoc

28-- | Output all preceding comments for an element at given location.

26-- | Output all preceding comments for an element at given location.

29spitPrecedingComments ::

27spitPrecedingComments ::

30− Data a =>

31− -- | AST element to attach comments to

28+ -- | Span of the element to attach comments to

32− RealLocated a ->

29+ RealSrcSpan ->

33 R ()

30 R ()

34spitPrecedingComments ref = do

31spitPrecedingComments ref = do

35 gotSome <- handleCommentSeries (spitPrecedingComment ref)

32 gotSome <- handleCommentSeries (spitPrecedingComment ref)

@@ -37,16 +34,15 @@ spitPrecedingComments ref = do

37 lastMark <- getSpanMark

34 lastMark <- getSpanMark

38 -- Insert a blank line between the preceding comments and the thing

35 -- Insert a blank line between the preceding comments and the thing

39 -- after them if there was a blank line in the input.

36 -- after them if there was a blank line in the input.

40− when (needsNewlineBefore (getRealSrcSpan ref) lastMark) newline

37+ when (needsNewlineBefore ref lastMark) newline

42-- | Output all comments following an element at given location.

39-- | Output all comments following an element at given location.

43spitFollowingComments ::

40spitFollowingComments ::

44− Data a =>

45− -- | AST element of attach comments to

41+ -- | Span of the element to attach comments to

46− RealLocated a ->

42+ RealSrcSpan ->

47 R ()

43 R ()

48spitFollowingComments ref = do

44spitFollowingComments ref = do

49− trimSpanStream (getRealSrcSpan ref)

45+ trimSpanStream ref

50 void $ handleCommentSeries (spitFollowingComment ref)

46 void $ handleCommentSeries (spitFollowingComment ref)

52-- | Output all remaining comments in the comment stream.

48-- | Output all remaining comments in the comment stream.

@@ -62,14 +58,13 @@ spitRemainingComments = do

63-- | Output a single preceding comment for an element at given location.

59-- | Output a single preceding comment for an element at given location.

64spitPrecedingComment ::

60spitPrecedingComment ::

65− Data a =>

66− -- | AST element to attach comments to

61+ -- | Span of the element to attach comments to

67− RealLocated a ->

62+ RealSrcSpan ->

68 -- | Location of last comment in the series

63 -- | Location of last comment in the series

69 Maybe SpanMark ->

64 Maybe SpanMark ->

70 -- | Are we done?

65 -- | Are we done?

71 R Bool

66 R Bool

72−spitPrecedingComment (L ref a) mlastMark = do

67+spitPrecedingComment ref mlastMark = do

73 let p (L l _) = realSrcSpanEnd l <= realSrcSpanStart ref

68 let p (L l _) = realSrcSpanEnd l <= realSrcSpanStart ref

74 withPoppedComment p $ \l comment -> do

69 withPoppedComment p $ \l comment -> do

75 dirtyLine <-

70 dirtyLine <-

@@ -80,31 +75,33 @@ spitPrecedingComment (L ref a) mlastMark = do

80 -- immediately because it'll be attached to the previous element (on

75 -- immediately because it'll be attached to the previous element (on

81 -- the same line) on the next run, so we play safe here and output

76 -- the same line) on the next run, so we play safe here and output

82 -- an extra 'newline' in this case.

77 -- an extra 'newline' in this case.

78+ --

83− Nothing -> isLineDirty -- only for very first preceding comment

79+ -- We check 'mlastMark' to do this only for the very first preceding

80+ -- comment.

84 Just _ -> return False

81 Just _ -> return False

82+ _ -> isLineDirty

85 when (dirtyLine || needsNewlineBefore l mlastMark) newline

83 when (dirtyLine || needsNewlineBefore l mlastMark) newline

86 spitCommentNow l comment

84 spitCommentNow l comment

87− if theSameLinePre l ref && not (isModule a)

85+ if theSameLinePre l ref

88 then space

86 then space

89 else newline

87 else newline

91-- | Output a comment that follows element at given location immediately on

89-- | Output a comment that follows element at given location immediately on

92-- the same line, if there is any.

90-- the same line, if there is any.

93spitFollowingComment ::

91spitFollowingComment ::

94− Data a =>

95 -- | AST element to attach comments to

92 -- | AST element to attach comments to

96− RealLocated a ->

93+ RealSrcSpan ->

97 -- | Location of last comment in the series

94 -- | Location of last comment in the series

98 Maybe SpanMark ->

95 Maybe SpanMark ->

99 -- | Are we done?

96 -- | Are we done?

100 R Bool

97 R Bool

101−spitFollowingComment (L ref a) mlastMark = do

98+spitFollowingComment ref mlastMark = do

102 mnSpn <- nextEltSpan

99 mnSpn <- nextEltSpan

103 -- Get first enclosing span that is not equal to reference span, i.e. it's

100 -- Get first enclosing span that is not equal to reference span, i.e. it's

104 -- truly something enclosing the AST element.

101 -- truly something enclosing the AST element.

105 meSpn <- getEnclosingSpan (/= ref)

102 meSpn <- getEnclosingSpan (/= ref)

106 withPoppedComment (commentFollowsElt ref mnSpn meSpn mlastMark) $ \l comment ->

103 withPoppedComment (commentFollowsElt ref mnSpn meSpn mlastMark) $ \l comment ->

107− if theSameLinePost l ref && not (isModule a)

104+ if theSameLinePost l ref

108 then

105 then

109 if isMultilineComment comment

106 if isMultilineComment comment

110 then space >> spitCommentNow l comment

107 then space >> spitCommentNow l comment

src/Ormolu/Printer/Meat/Module.hs+2−2

@@ -34,9 +34,9 @@ p_hsModule ::

34 -- | Whether to use postfix qualified imports

35 Bool ->

36 -- | AST to print

37− ParsedSource ->

37+ HsModule GhcPs ->

38 R ()

39−p_hsModule mstackHeader shebangs pragmas qualifiedPost (L _ HsModule {..}) = do

39+p_hsModule mstackHeader shebangs pragmas qualifiedPost HsModule {..} = do

40 let deprecSpan = maybe [] (\(L s _) -> [s]) hsmodDeprecMessage

41 exportSpans = maybe [] (\(L s _) -> [s]) hsmodExports

42 switchLayout (deprecSpan <> exportSpans) $ do

src/Ormolu/Utils.hs−6

@@ -6,7 +6,6 @@ module Ormolu.Utils

6 ( RelativePos (..),

7 attachRelativePos,

8 combineSrcSpans',

9− isModule,

10 notImplemented,

9 notImplemented,

11 showOutputable,

10 showOutputable,

12 splitDocString,

11 splitDocString,

@@ -18,7 +17,6 @@ module Ormolu.Utils

18 )

17 )

19where

18where

21−import Data.Data (Data, showConstr, toConstr)

22import Data.List (dropWhileEnd)

20import Data.List (dropWhileEnd)

23import qualified Data.List.NonEmpty as NE

21import qualified Data.List.NonEmpty as NE

24import Data.List.NonEmpty (NonEmpty (..))

22import Data.List.NonEmpty (NonEmpty (..))

@@ -52,10 +50,6 @@ attachRelativePos = \case

52combineSrcSpans' :: NonEmpty SrcSpan -> SrcSpan

50combineSrcSpans' :: NonEmpty SrcSpan -> SrcSpan

53combineSrcSpans' (x :| xs) = foldr combineSrcSpans x xs

51combineSrcSpans' (x :| xs) = foldr combineSrcSpans x xs

55−-- | Return 'True' if given element of AST is module.

56−isModule :: Data a => a -> Bool

57−isModule x = showConstr (toConstr x) == "HsModule"

58−

59-- | Placeholder for things that are not yet implemented.

53-- | Placeholder for things that are not yet implemented.

60notImplemented :: String -> a

54notImplemented :: String -> a

61notImplemented msg = error $ "not implemented yet: " ++ msg

55notImplemented msg = error $ "not implemented yet: " ++ msg