fixing issue with data comments

Author: GuillaumedeVolpiano

Diff for: lib/Language/Haskell/Stylish/Step/Data.hs

@@ -2,7 +2,6 @@
 {-# LANGUAGE DataKinds        #-}
 {-# LANGUAGE DoAndIfThenElse  #-}
 {-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE LambdaCase       #-}
 {-# LANGUAGE MultiWayIf       #-}
 {-# LANGUAGE NamedFieldPuns   #-}
 {-# LANGUAGE RecordWildCards  #-}
@@ -38,7 +37,7 @@ import           Language.Haskell.Stylish.Printer
 import           Language.Haskell.Stylish.Step
 import           Language.Haskell.Stylish.Util
 
-
+import Debug.Trace
 --------------------------------------------------------------------------------
 data Indent
     = SameLine
@@ -93,16 +92,17 @@ step cfg = makeStep "Data" \ls m -> Editor.apply (changes m) ls
     changes :: Module -> Editor.Edits
     changes = foldMap (formatDataDecl cfg) . dataDecls
 
+    getComments :: GHC.SrcSpanAnnA -> [GHC.LEpaComment]
+    getComments (GHC.EpAnn _ _ c)= GHC.priorComments c
+
     dataDecls :: Module -> [DataDecl]
     dataDecls m = do
-        let hsModule = GHC.unLoc m
-            modAnns = GHC.anns . GHC.hsmodAnn . GHC.hsmodExt $ hsModule
-        ldecl <- GHC.hsmodDecls hsModule
-        GHC.TyClD _ tycld <- pure $ GHC.unLoc ldecl
+        ldecl <- GHC.hsmodDecls . GHC.unLoc $ m
+        (GHC.TyClD _ tycld, annos) <- pure $ (\(GHC.L anno ty) -> (ty, anno)) ldecl
         loc <- maybeToList $ GHC.srcSpanToRealSrcSpan $ GHC.getLocA ldecl
         case tycld of
             GHC.DataDecl {..} -> pure $ MkDataDecl
-                { dataComments = GHC.am_cs modAnns
+                { dataComments = getComments annos
                 , dataLoc      = loc
                 , dataDeclName = tcdLName
                 , dataTypeVars = tcdTyVars
@@ -147,7 +147,7 @@ putDataDecl cfg@Config {..} decl = do
 
         onelineEnum =
             isEnum decl && not cBreakEnums &&
-            all (not . commentGroupHasComments) constructorComments
+            (not . any commentGroupHasComments) constructorComments
 
     putText $ newOrData decl
     space
@@ -176,9 +176,14 @@ putDataDecl cfg@Config {..} decl = do
                 forM_ (GHC.dd_cons defn) $ putNewtypeConstructor cfg
             | not . null $ GHC.dd_cons defn -> do
                 forM_ (flagEnds constructorComments) $ \(CommentGroup {..}, firstGroup, lastGroup) -> do
-                    forM_ cgPrior $ \lc -> do
-                        putComment $ GHC.unLoc lc
-                        consIndent lineLengthAfterEq
+                    forM_ cgPrior $ \(GHC.L l c) -> do
+                      -- ugly workaround to make sure we don't reprint a haddock
+                      -- comment before a data declaration after a data
+                      -- declaration…
+                      let GHC.EpaSpan (GHC.RealSrcSpan comLoc _) = l
+                      when (GHC.srcSpanStartLine comLoc  >= GHC.srcSpanStartLine (dataLoc decl)) $ do
+                          putComment c 
+                          consIndent lineLengthAfterEq
 
                     forM_ (flagEnds cgItems) $ \((lcon, mbInlineComment), firstItem, lastItem) -> do
                         unless (isGADT decl) $ do
@@ -332,7 +337,7 @@ putConstructor cfg consIndent lcons = case GHC.unLoc lcons of
   GHC.ConDeclGADT {..} -> do
     -- Put argument to constructor first:
     case con_g_args of
-      GHC.PrefixConGADT _ _ -> sep (comma >> space) $ fmap putRdrName $ toList con_names
+      GHC.PrefixConGADT _ _ -> sep (comma >> space) (putRdrName <$> toList con_names)
       GHC.RecConGADT _ _ -> error . mconcat $
           [ "Language.Haskell.Stylish.Step.Data.putConstructor: "
           , "encountered a GADT with record constructors, not supported yet"

Diff for: lib/Language/Haskell/Stylish/Step/ModuleHeader.hs

@@ -32,7 +32,6 @@ import qualified Language.Haskell.Stylish.Step.Imports as Imports
 import           Language.Haskell.Stylish.Util         (flagEnds)
 import qualified GHC.Unit.Module.Warnings as GHC
 
-
 data Config = Config
     { indent        :: Int
     , sort          :: Bool
@@ -152,7 +151,7 @@ printHeader conf mbName mbDeprec mbExps mbModuleComment mbWhereComment = do
                 attachModuleComment
             Single  | [egroup] <- exports
                     , not (commentGroupHasComments egroup)
-                    , [(export, _)] <- (cgItems egroup) -> do
+                    , [(export, _)] <- cgItems egroup -> do
                 printSingleLineExportList conf [export]
                 attachModuleComment
             Inline  | [] <- exports -> do