Partition haddocks

Author: philderbeast

src/Hint/Comment.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE LambdaCase #-}
 
 {-
 <TEST>
@@ -35,18 +36,23 @@ directives = words $
 
 data Comments = Comments
     { commPragma :: ![LEpaComment]
+    , commBlockHaddocks :: ![LEpaComment]
     , commBlocks :: ![LEpaComment]
     -- TODO: Process the different types of block comments; [" |",""].
     -- * Haddock comments
     -- * Simple comments
+    , commRunHaddocks :: ![[LEpaComment]]
     , commRuns :: ![[LEpaComment]]
+    , commLineHaddocks :: ![LEpaComment]
     , commLines :: ![LEpaComment]
     }
 
 classifyComments :: [LEpaComment] -> Comments
-classifyComments xs = Comments pragmas blocks runs lines where
-  (partition isCommentPragma -> (pragmas, blocks), singles) = partition isCommentMultiline xs
-  (concat -> lines, runs) = partition ((== 1) . length) $ commentRuns singles
+classifyComments xs = Comments pragmas blockHaddocks blocks runHaddocks runs lineHaddocks lines where
+  (partition isCommentPragma -> (pragmas, partition isCommentHaddock -> (blockHaddocks, blocks)), singles) = partition isCommentMultiline xs
+  (concat -> singles', rawRuns) = partition ((== 1) . length) $ commentRuns singles
+  (runHaddocks, runs) = partition (\case x : _  -> isCommentHaddock x; _ -> False) rawRuns
+  (lineHaddocks, lines) = partition isCommentHaddock singles'
 
 commentRuns :: [LEpaComment] -> [[LEpaComment]]
 commentRuns comments =
@@ -114,11 +120,14 @@ commentHint _ m =
   -- c) single-line comments
   -- TODO: Remove (True, _) runs and then run the other checks on the rest.
   traceShow ("pragmas", commentText <$> pragmas) $
+  traceShow ("blockHaddocks", commentText <$> blockHaddocks) $
   traceShow ("blocks", commentText <$> blocks) $
-  traceShow ("runs", fmap commentText <$> rawRuns) $
+  traceShow ("runHaddocks", fmap commentText <$> runHaddocks) $
+  traceShow ("runs", fmap commentText <$> runs) $
+  traceShow ("lineHaddocks", commentText <$> lineHaddocks) $
   traceShow ("lines", commentText <$> lines) $
-  if any fst runs
-    then concatMap snd runs
+  if any fst runReplacements
+    then concatMap snd runReplacements
     else concatMap (check singleLines someLines) comments
   where
     -- Comments need to be sorted by line number for detecting runs of single
@@ -130,9 +139,12 @@ commentHint _ m =
     singleLines = sort $ commentLine <$> filter isSingle comments
     someLines = sort $ commentLine <$> filter isSingleSome comments
 
-    Comments pragmas blocks rawRuns lines = classifyComments comments
+    Comments pragmas blockHaddocks blocks runHaddocks runs lineHaddocks lines = classifyComments comments
 
-    runs = dropBlankLinesHint <$> rawRuns
+    runReplacements =
+      (dropBlankLinesHint <$> runHaddocks)
+      ++
+      (dropBlankLinesHint <$> runs)
 
 -- | Does the commment start with "--"? Can be empty. Excludes haddock single
 -- line comments, "-- |" and "-- ^".