b6d49bb · ormolu · git.iko.soy

data/examples/import/comments-per-import-out.hsnew file+4

compare with master

unifiedsplit

@@ -0,0 +1,4 @@

1+import Bar

2+import Baz

3+import Foo

4+-- (3)

data/examples/import/comments-per-import.hsnew file+3

@@ -0,0 +1,3 @@

1+import Foo -- (1)

2+import Bar -- (2)

3+import Baz -- (3)

data/examples/import/explicit-imports-out.hsnew file+12

@@ -0,0 +1,12 @@

1+import qualified MegaModule as M

2+ ( (<<<)

3+ , (>>>)

4+ , Either

5+ , Maybe (Just, Nothing)

6+ , MaybeT (..)

7+ , Monad ((>>), (>>=), return)

8+ , MonadBaseControl

9+ , join

10+ , liftIO

11+ , void

12+ )

data/examples/import/explicit-imports-with-comments-out.hsnew file+5

@@ -0,0 +1,5 @@

1+import qualified MegaModule as M

2+ ( (<<<)

3+ , (>>>)

4+ , Either

5+ )

data/examples/import/explicit-imports-with-comments.hsnew file+5

@@ -0,0 +1,5 @@

1+import qualified MegaModule as M

2+ ( (>>>) -- (1)

3+ , (<<<) -- (2)

4+ , Either -- (3)

5+ )

data/examples/import/explicit-imports.hsnew file+2

@@ -0,0 +1,2 @@

1+import qualified MegaModule as M

2+ ((>>>), MonadBaseControl, void, MaybeT(..), join, Maybe(Nothing, Just), liftIO, Either, (<<<), Monad(return, (>>=), (>>)))

data/examples/import/explicit-prelude-out.hsnew file+3

@@ -0,0 +1,3 @@

1+import Aaa

2+import Zzz

3+import Prelude

data/examples/import/explicit-prelude.hsnew file+3

@@ -0,0 +1,3 @@

1+import Aaa

2+import Prelude

3+import Zzz

data/examples/import/misc-out.hsnew file+11

@@ -0,0 +1,11 @@

1+import A hiding

2+ ( foobarbazqux

3+ , foobarbazqux

4+ , foobarbazqux

5+ , foobarbazqux

6+ , foobarbazqux

7+ , foobarbazqux

8+ , foobarbazqux

9+ )

10+import {-# SOURCE #-} safe qualified Module as M hiding (a, b, c, d, e, f)

11+import Name hiding ()

data/examples/import/misc.hsnew file+13

@@ -0,0 +1,13 @@

1+import A hiding

2+ ( foobarbazqux

3+ , foobarbazqux

4+ , foobarbazqux

5+ , foobarbazqux

6+ , foobarbazqux

7+ , foobarbazqux

8+ , foobarbazqux

9+ )

10+

11+import Name hiding ()

12+

13+import {-# SOURCE #-} safe qualified Module as M hiding (a, b, c, d, e, f)

data/examples/import/nested-explicit-imports-out.hsnew file+10

@@ -0,0 +1,10 @@

1+import qualified MegaModule as M

2+ ( (<<<)

3+ , (>>>)

4+ , Either

5+ , Monad

6+ ( (>>)

7+ , (>>=)

8+ , return

9+ )

10+ )

data/examples/import/nested-explicit-imports.hsnew file+2

@@ -0,0 +1,2 @@

1+import qualified MegaModule as M ((>>>), Either, (<<<), Monad(

2+ return, (>>=), (>>)))

data/examples/import/simple-out.hsnew file+6

@@ -0,0 +1,6 @@

1+import Data.Text

2+import Data.Text

3+import qualified Data.Text as T

4+import qualified Data.Text (a, b, c)

5+import Data.Text (a, b, c)

6+import Data.Text hiding (a, b, c)

data/examples/import/simple.hsnew file+6

@@ -0,0 +1,6 @@

1+import Data.Text

2+import Data.Text

3+import qualified Data.Text as T

4+import qualified Data.Text (a, c, b)

5+import Data.Text (a, b, c)

6+import Data.Text hiding (c, b, a)

data/examples/import/sorted-out.hsnew file+3

@@ -0,0 +1,3 @@

1+import A

2+import B

3+import C

data/examples/import/sorted.hsnew file+3

@@ -0,0 +1,3 @@

1+import B

2+import A

3+import C

ormolu.cabal+1

@@ -42,6 +42,7 @@ library

42 , Ormolu.Config

43 , Ormolu.Diff

44 , Ormolu.Exception

45+ , Ormolu.Imports

45 , Ormolu.Parser

46 , Ormolu.Parser

46 , Ormolu.Printer

47 , Ormolu.Printer

47 , Ormolu.Printer.Combinators

48 , Ormolu.Printer.Combinators

src/Ormolu/Diff.hs+18−7

@@ -11,12 +11,13 @@ where

11

12import Data.Generics

13import Data.Maybe (mapMaybe)

14−import GHC

14+import GHC hiding (GhcPs)

15import Language.Haskell.GHC.ExactPrint.Types

16import Ormolu.Comments

17+import Ormolu.Imports (sortImports)

17import qualified Data.Map.Strict as M

18import qualified Data.Map.Strict as M

18

19

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

20+-- | Return 'False' if two annotated ASTs are the same modulo span

20-- positions.

21-- positions.

21

22

22diff

23diff

@@ -28,17 +29,27 @@ diff (anns0, ps0) (anns1, ps1) =

28 || not (matchIgnoringSrcSpans ps0 ps1)

29 || not (matchIgnoringSrcSpans ps0 ps1)

29

30

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

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

31−-- 'SrcSpan's.

32+-- 'SrcSpan's and the ordering of import lists.

32

33

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

34matchIgnoringSrcSpans :: Data a => a -> a -> Bool

34−matchIgnoringSrcSpans x0 y0 = geq' x0 y0

35+matchIgnoringSrcSpans = genericQuery

35 where

36 where

36− geq' :: GenericQ (GenericQ Bool)

37+ genericQuery :: GenericQ (GenericQ Bool)

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

38+ genericQuery x y = (toConstr x == toConstr y)

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

39+ && and (gzipWithQ (genericQuery `extQ` srcSpanEq `extQ` hsModuleEq) x y)

40+

39 srcSpanEq :: SrcSpan -> GenericQ Bool

41 srcSpanEq :: SrcSpan -> GenericQ Bool

40 srcSpanEq _ _ = True

42 srcSpanEq _ _ = True

41

43

44+ hsModuleEq :: HsModule GhcPs -> GenericQ Bool

45+ hsModuleEq hs0 hs1' =

46+ case cast hs1' :: Maybe (HsModule GhcPs) of

47+ Nothing -> False

48+ Just hs1 ->

49+ matchIgnoringSrcSpans

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

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

52+

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

53-- | Simplified collection of 'Comment's.

43

54

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

55data Comments = Comments [Comment] [Comment] [Comment]

src/Ormolu/Exception.hs+7−4

@@ -33,11 +33,14 @@ instance Exception OrmoluException where

33 displayException = \case

34 OrmoluCppEnabled -> "CPP is not supported"

35 OrmoluParsingFailed s e ->

36− showParsingErr "parsing of source code failed:" s e

36+ showParsingErr "Parsing of source code failed:" s e

37 OrmoluOutputParsingFailed s e ->

38− showParsingErr "parsing of formatted code failed (report the bug):" s e

38+ showParsingErr "Parsing of formatted code failed:" s e ++

39+ "Please, consider reporting the bug."

39− OrmoluASTDiffers _ _ ->

40+ OrmoluASTDiffers _ _ -> unlines

40− "AST of input and AST of formatted code differ, report the bug"

41+ [ "AST of input and AST of formatted code differ."

42+ , "Please, consider reporting the bug."

43+ ]

41

44

42-- | Inside this wrapper 'OrmoluException' will be caught and displayed

45-- | Inside this wrapper 'OrmoluException' will be caught and displayed

43-- nicely using 'displayException'.

46-- nicely using 'displayException'.

src/Ormolu/Imports.hsnew file+90

@@ -0,0 +1,90 @@

1+{-# LANGUAGE LambdaCase #-}

2+{-# LANGUAGE RankNTypes #-}

3+

4+-- | Manipulations on import lists.

5+

6+module Ormolu.Imports

7+ ( sortImports

8+ )

9+where

10+

11+import Data.Bifunctor

12+import Data.Function (on)

13+import Data.List (sortBy)

14+import GHC hiding (GhcPs, IE)

15+import HsImpExp (IE (..))

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

17+

18+-- | Sort imports by module name. This also sorts explicit import lists for

19+-- each declaration.

20+

21+sortImports :: [LImportDecl GhcPs] -> [LImportDecl GhcPs]

22+sortImports = sortBy compareIdecl . fmap (fmap sortImportLists)

23+ where

24+ sortImportLists :: ImportDecl GhcPs -> ImportDecl GhcPs

25+ sortImportLists decl =

26+ decl { ideclHiding = second (fmap sortLies) <$> ideclHiding decl

27+ }

28+

29+-- | Compare two @'LImportDecl' 'GhcPs'@ things.

30+

31+compareIdecl :: LImportDecl GhcPs -> LImportDecl GhcPs -> Ordering

32+compareIdecl (L _ m0) (L _ m1) =

33+ if isPrelude n0

34+ then GT

35+ else if isPrelude n1

36+ then LT

37+ else n0 `compare` n1

38+ where

39+ n0 = unL (ideclName m0)

40+ n1 = unL (ideclName m1)

41+ isPrelude = (== "Prelude") . moduleNameString

42+

43+-- | Sort located import or export.

44+

45+sortLies :: [LIE GhcPs] -> [LIE GhcPs]

46+sortLies = sortBy (compareIE `on` unL) . fmap (fmap sortThings)

47+

48+-- | Sort imports\/exports inside of 'IEThingWith'.

49+

50+sortThings :: IE GhcPs -> IE GhcPs

51+sortThings = \case

52+ IEThingWith x w xs fl ->

53+ IEThingWith x w (sortBy (compareIewn `on` unL) xs) fl

54+ other -> other

55+

56+-- | Compare two located imports or exports.

57+

58+compareIE :: IE GhcPs -> IE GhcPs -> Ordering

59+compareIE = compareIewn `on` getIewn

60+

61+-- | Project @'IEWrappedName' 'RdrName'@ from @'IE' 'GhcPs'@.

62+

63+getIewn :: IE GhcPs -> IEWrappedName RdrName

64+getIewn = \case

65+ IEVar x -> unL x

66+ IEThingAbs x -> unL x

67+ IEThingAll x -> unL x

68+ IEThingWith x _ _ _ -> unL x

69+ IEModuleContents _ -> error "Ormolu.Imports.projectName: IEModuleContents"

70+ IEGroup _ _ -> error "Ormolu.Imports.projectName: IEGroup"

71+ IEDoc _ -> error "Ormolu.Imports.projectName: IEGroup"

72+ IEDocNamed _ -> error "Ormolu.Imports.projectName: IEGroup"

73+

74+-- | Compare two @'IEWrapppedName' 'RdrName'@ things.

75+

76+compareIewn :: IEWrappedName RdrName -> IEWrappedName RdrName -> Ordering

77+compareIewn (IEName x) (IEName y) = unL x `compare` unL y

78+compareIewn (IEName _) (IEPattern _) = LT

79+compareIewn (IEName _) (IEType _) = LT

80+compareIewn (IEPattern _) (IEName _) = GT

81+compareIewn (IEPattern x) (IEPattern y) = unL x `compare` unL y

82+compareIewn (IEPattern _) (IEType _) = LT

83+compareIewn (IEType _) (IEName _) = GT

84+compareIewn (IEType _) (IEPattern _) = GT

85+compareIewn (IEType x) (IEType y) = unL x `compare` unL y

86+

87+-- | Exact inner value from 'Located'.

88+

89+unL :: Located e -> e

90+unL (L _ e) = e

src/Ormolu/Parser.hs+67−3

@@ -1,3 +1,5 @@

1+{-# LANGUAGE RecordWildCards #-}

2+

1-- | Parser for Haskell source code.

3-- | Parser for Haskell source code.

2

4

3module Ormolu.Parser

5module Ormolu.Parser

@@ -8,14 +10,16 @@ where

8import Control.Exception

10import Control.Exception

9import Control.Monad

11import Control.Monad

10import Control.Monad.IO.Class

12import Control.Monad.IO.Class

13+import Data.Generics

14+import GHC hiding (GhcPs, IE, parseModule)

11import GHC.LanguageExtensions.Type (Extension (Cpp))

15import GHC.LanguageExtensions.Type (Extension (Cpp))

12import Language.Haskell.GHC.ExactPrint.Parsers hiding (parseModule)

16import Language.Haskell.GHC.ExactPrint.Parsers hiding (parseModule)

13import Language.Haskell.GHC.ExactPrint.Types

17import Language.Haskell.GHC.ExactPrint.Types

14import Ormolu.Config

18import Ormolu.Config

15import Ormolu.Exception

19import Ormolu.Exception

16import qualified CmdLineParser as GHC

20import qualified CmdLineParser as GHC

21+import qualified Data.Map.Strict as M

17import qualified DynFlags as GHC

22import qualified DynFlags as GHC

18−import qualified GHC hiding (parseModule)

19

23

20-- | Parse a complete module from string.

24-- | Parse a complete module from string.

21

25

@@ -24,7 +28,7 @@ parseModule

24 => [DynOption] -- ^ Dynamic options that affect parsing

28 => [DynOption] -- ^ Dynamic options that affect parsing

25 -> FilePath -- ^ File name (only for source location annotations)

29 -> FilePath -- ^ File name (only for source location annotations)

26 -> String -- ^ Input for parser

30 -> String -- ^ Input for parser

27− -> m ([GHC.Warn], Either (GHC.SrcSpan, String) (Anns, GHC.ParsedSource))

31+ -> m ([GHC.Warn], Either (SrcSpan, String) (Anns, ParsedSource))

28parseModule dynOpts path input = liftIO $ do

32parseModule dynOpts path input = liftIO $ do

29 (ws, dynFlags) <- ghcWrapper $ do

33 (ws, dynFlags) <- ghcWrapper $ do

30 dynFlags0 <- initDynFlagsPure path input

34 dynFlags0 <- initDynFlagsPure path input

@@ -36,4 +40,64 @@ parseModule dynOpts path input = liftIO $ do

36 -- want.

40 -- want.

37 when (GHC.xopt Cpp dynFlags) $

41 when (GHC.xopt Cpp dynFlags) $

38 throwIO OrmoluCppEnabled

42 throwIO OrmoluCppEnabled

39− return (ws, parseModuleFromStringInternal dynFlags path input)

43+ let r = case parseModuleFromStringInternal dynFlags path input of

44+ Left e -> Left e

45+ Right (anns, psrc) ->

46+ Right (dropImportComments anns psrc, psrc)

47+ return (ws, r)

48+

49+-- | Drop comments associated with elements of import lists. The reason we

50+-- do this is that those comments are not associated as user would expect.

51+--

52+-- For example:

53+--

54+-- > import Foo -- (1)

55+-- > import Bar -- (2)

56+-- > import Baz -- (3)

57+--

58+-- Here, @(1)@ is considered preceding comment of @Baz@ import, in fact, it

59+-- has nothing to do with @Foo@. Similarly, @(2)@ is associted with @Baz@,

60+-- not @Bar@. Finally @(3)@ is actually preceeding comment for the thing

61+-- that follows the import list, or if nothing follows, it's a trailing

62+-- comment of the whole module.

63+--

64+-- Since we do sorting of imports when we print them, we would need to do

65+-- sorting of corresponding annotations as well (because we do checking of

66+-- annotations and AST in "Ormolu.Diff" as part of the self-check), and this

67+-- is hard. Even if we manage to do that the result will be totally

68+-- confusing, e.g. for the example above:

69+--

70+-- > -- (1)

71+-- > import Bar

72+-- > -- (2)

73+-- > import Baz

74+-- > import Foo

75+-- > -- (3)

76+--

77+-- The solution is to drop the tricky comments right after parsing, so we

78+-- don't need to deal with them at all, including the need to update

79+-- annotations for the correctness checking we do in "Ormolu.Diff".

80+--

81+-- The solution is not perfect, but practical.

82+

83+dropImportComments

84+ :: Anns

85+ -> ParsedSource

86+ -> Anns

87+dropImportComments anns (L _ HsModule {..}) =

88+ foldr M.delete anns (hsmodImports >>= keyAnnsFor)

89+

90+-- | Extract all 'AnnKey's from given 'Data'.

91+

92+keyAnnsFor :: GenericQ [AnnKey]

93+keyAnnsFor a = everything mappend (const id `ext2Q` queryLocated) a []

94+ where

95+ queryLocated

96+ :: (Data e0, Data e1)

97+ => GenLocated e0 e1

98+ -> [AnnKey]

99+ -> [AnnKey]

100+ queryLocated (L mspn x) =

101+ case cast mspn :: Maybe SrcSpan of

102+ Nothing -> id

103+ Just spn -> (mkAnnKey (L spn x) :)

src/Ormolu/Printer.hs+56−19

@@ -9,14 +9,15 @@ module Ormolu.Printer

9 )

10where

11

12+import Control.Monad

12import Data.Char (isAlphaNum)

13import Data.Char (isAlphaNum)

13import Data.Text (Text)

14import Data.Text (Text)

14−import FieldLabel (FieldLbl (..))

15import GHC hiding (GhcPs, IE)

16import HsImpExp (IE (..))

17import Language.Haskell.GHC.ExactPrint.Types

18import Module (Module (..))

19import OccName (OccName (..))

20+import Ormolu.Imports (sortImports)

20import Ormolu.Printer.Combinators

21import Ormolu.Printer.Combinators

21import Outputable (Outputable (..), showSDocUnsafe)

22import Outputable (Outputable (..), showSDocUnsafe)

22import RdrName (RdrName (..), rdrNameOcc)

23import RdrName (RdrName (..), rdrNameOcc)

@@ -41,18 +42,21 @@ p_HsModule loc@(L moduleSpan hsModule) = do

41 case hsmodExports hsModule of

42 case hsmodExports hsModule of

42 Nothing -> moduleSpan

43 Nothing -> moduleSpan

43 Just (L exportsSpan _) -> combineSrcSpans moduleSpan exportsSpan

44 Just (L exportsSpan _) -> combineSrcSpans moduleSpan exportsSpan

44− locatedVia spn loc $ \HsModule {..} ->

45+ locatedVia (Just spn) loc $ \HsModule {..} -> do

45 case hsmodName of

46 case hsmodName of

46 Nothing -> pure ()

47 Nothing -> pure ()

47− Just hsmodName' -> line . velt' $

48+ Just hsmodName' -> do

49+ line . velt' $

48− [ located hsmodName' p_hsmodName ] ++

50+ [ located hsmodName' p_hsmodName ] ++

49− (case hsmodExports of

51+ (case hsmodExports of

50− Nothing -> []

52+ Nothing -> []

51− Just hsmodExports' ->

53+ Just hsmodExports' ->

52− [ inci (locatedVia spn hsmodExports' p_hsmodExports)

54+ [ inci (locatedVia Nothing hsmodExports' p_hsmodExports)

53− ])

55+ ])

54− ++ [ txt "where"

56+ ++ [ txt "where"

55− ]

57+ ]

58+ unless (null hsmodImports) newline

59+ forM_ (sortImports hsmodImports) (located' p_hsmodImports)

56

60

57p_hsmodName :: ModuleName -> R ()

61p_hsmodName :: ModuleName -> R ()

58p_hsmodName mname = do

62p_hsmodName mname = do

@@ -70,18 +74,51 @@ p_lie = \case

70 IEThingAll l1 -> do

74 IEThingAll l1 -> do

71 located l1 p_ieWrappedName

75 located l1 p_ieWrappedName

72 txt " (..)"

76 txt " (..)"

73− IEThingWith l1 w xs fls -> do

77+ IEThingWith l1 w xs _ -> velt'

74− located l1 p_ieWrappedName

78+ [ located l1 p_ieWrappedName

75− space

79+ , inci $ do

76− p_ieWildcard w

80+ p_ieWildcard w

77− parens . velt $ withSep comma (located' p_ieWrappedName) xs

81+ parens . velt $ withSep comma (located' p_ieWrappedName) xs

82+ ]

83+ -- XXX I have no idea what field labels are in this context.

78− parens . velt $ withSep comma (located' p_FieldLbl) fls

84+ -- parens . velt $ withSep comma (located' p_FieldLbl) fls

79 IEModuleContents l1 -> located l1 p_hsmodName

85 IEModuleContents l1 -> located l1 p_hsmodName

80 -- XXX I have no idea what these things are for.

86 -- XXX I have no idea what these things are for.

81 IEGroup _ _ -> return ()

87 IEGroup _ _ -> return ()

82 IEDoc _ -> return ()

88 IEDoc _ -> return ()

83 IEDocNamed _ -> return ()

89 IEDocNamed _ -> return ()

84

90

91+p_hsmodImports :: ImportDecl GhcPs -> R ()

92+p_hsmodImports ImportDecl {..} = line . velt' $

93+ [ do txt "import "

94+ when ideclSource $

95+ txt "{-# SOURCE #-} "

96+ when ideclSafe $

97+ txt "safe "

98+ when ideclQualified $

99+ txt "qualified "

100+ case ideclPkgQual of

101+ Nothing -> return ()

102+ Just slit -> do

103+ atom slit

104+ space

105+ located ideclName atom

106+ case ideclAs of

107+ Nothing -> return ()

108+ Just l -> do

109+ txt " as "

110+ located l atom

111+ case ideclHiding of

112+ Nothing -> return ()

113+ Just (hiding, _) ->

114+ when hiding $

115+ txt " hiding"

116+ ] ++ (case ideclHiding of

117+ Nothing -> []

118+ Just (_, l) ->

119+ [ inci . locatedVia Nothing l $ parens . velt . withSep comma (located' p_lie)

120+ ])

121+

85p_ieWrappedName :: IEWrappedName RdrName -> R ()

122p_ieWrappedName :: IEWrappedName RdrName -> R ()

86p_ieWrappedName = \case

123p_ieWrappedName = \case

87 IEName l2 -> located l2 p_rdrName

124 IEName l2 -> located l2 p_rdrName

@@ -99,8 +136,8 @@ p_rdrName x = opParens (rdrNameOcc x) $ case x of

99 Orig (Module _ mname) occName -> p_qualName mname occName

136 Orig (Module _ mname) occName -> p_qualName mname occName

100 Exact name -> atom name

137 Exact name -> atom name

101

138

102−p_FieldLbl :: FieldLbl RdrName -> R ()

139+-- p_FieldLbl :: FieldLbl RdrName -> R ()

103−p_FieldLbl (FieldLabel x _ _) = atom x

140+-- p_FieldLbl (FieldLabel x _ _) = atom x

104

141

105p_qualName :: ModuleName -> OccName -> R ()

142p_qualName :: ModuleName -> OccName -> R ()

106p_qualName mname occName = do

143p_qualName mname occName = do

src/Ormolu/Printer/Combinators.hs+11−9

@@ -67,23 +67,27 @@ located

67 => Located a -- ^ Thing to enter

68 -> (a -> R ()) -- ^ How to render inner value

69 -> R ()

70−located loc@(L l _) = locatedVia l loc

70+located loc@(L l _) = locatedVia (Just l) loc

71

72-- | A special version of 'located' that allows to control layout using

73−-- externally provided span.

73+-- externally provided span. 'Nothing' means that layout won't be changed.

74

75locatedVia

76 :: Data a

77− => SrcSpan -- ^ Span that controls layout selection

77+ => Maybe SrcSpan -- ^ Span that controls layout selection

78 -> Located a -- ^ Thing to enter

79 -> (a -> R ()) -- ^ How to renedr inner value

80 -> R ()

81−locatedVia l' loc@(L l a) f = do

81+locatedVia ml loc@(L l a) f = do

82 mann <- lookupAnn loc

83+ layout <- currentLayout

83 let m = enterLayout

84 let m = enterLayout

85+ (case ml of

86+ Nothing -> layout

87+ Just l' ->

84− (if isOneLineSpan l'

88+ if isOneLineSpan l'

85− then SingleLine

89+ then SingleLine

86− else MultiLine)

90+ else MultiLine)

87 (f a)

91 (f a)

88 case mann of

92 case mann of

89 Nothing -> m

93 Nothing -> m

@@ -110,8 +114,6 @@ locatedVia l' loc@(L l a) f = do

110 -- comments that go before things. Exact location can only be

114 -- comments that go before things. Exact location can only be

111 -- deduced by analyzing the associated span.

115 -- deduced by analyzing the associated span.

112

116

113− -- traceShowM (before,after, decoratedElt)

114−

115 spitComments before

117 spitComments before

116 m

118 m

117 spitComments after

119 spitComments after

src/Ormolu/Printer/Comments.hs+7−3

@@ -95,9 +95,13 @@ partitionDPsModule

95 :: SrcSpan -- ^ Span of element the comments are attached to

96 -> [(KeywordId, DeltaPos)] -- ^ Annotations

97 -> ([(Comment, Decoration)], [(Comment, Decoration)])

98−partitionDPsModule refSpan

98+partitionDPsModule refSpan xs

99− = bimap (takeComments Before) (takeComments After)

99+ = bimap (takeComments Before) (takeComments After) $

100+ -- NOTE If there is no annotation corresponding to module keyword, then

101+ -- the module doesn't have a header and all comments shoud go after.

102+ if G AnnModule `elem` fmap fst xs

100− . break ((== G AnnModule) . fst)

103+ then break ((== G AnnModule) . fst) xs

104+ else ([], xs)

101 where

105 where

102 takeComments pos = mapMaybe $ \(keywordId, dpos) -> do

106 takeComments pos = mapMaybe $ \(keywordId, dpos) -> do

103 c <- annComment keywordId

107 c <- annComment keywordId

src/Ormolu/Printer/Internal.hs+8−5

@@ -19,6 +19,7 @@ module Ormolu.Printer.Internal

19 , Layout (..)

20 , enterLayout

21 , vlayout

22+ , currentLayout

22 , lookupAnn

23 , lookupAnn

23 )

24 )

24where

25where

@@ -189,18 +190,20 @@ vlayout

189 -> R () -- ^ Multi line

190 -> R () -- ^ Multi line

190 -> R ()

191 -> R ()

191vlayout sline mline = do

192vlayout sline mline = do

192− l <- R (asks rcLayout)

193+ l <- currentLayout

193 case l of

194 case l of

194 SingleLine -> sline

195 SingleLine -> sline

195 MultiLine -> mline

196 MultiLine -> mline

196

197

198+-- | Return current layout.

199+

200+currentLayout :: R Layout

201+currentLayout = R (asks rcLayout)

202+

197-- | Lookup an annotation.

203-- | Lookup an annotation.

198

204

199lookupAnn :: Data a => Located a -> R (Maybe Annotation)

205lookupAnn :: Data a => Located a -> R (Maybe Annotation)

200−lookupAnn (L s d) = do

201− anns <- R (asks rcAnns)

206+lookupAnn l = M.lookup (mkAnnKey l) <$> R (asks rcAnns)

202− let k = AnnKey s (annGetConstr d)

203− return (M.lookup k anns)

204

207

205----------------------------------------------------------------------------

208----------------------------------------------------------------------------

206-- Debug helpers

209-- Debug helpers

tests/Ormolu/PrinterSpec.hs+1−1

@@ -68,7 +68,7 @@ shouldMatch actual expected =

68 when (actual /= expected) . expectationFailure $ unlines

69 [ "expected:"

70 , T.unpack expected

71− , "bot got:"

71+ , "but got:"

72 , T.unpack actual

73 ]

74