cabal-gild 1.6.0.4 → 1.7.0.0

raw patch · 8 files changed

+355/−174 lines, 8 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• cabal-gild.cabal +2/−1
• source/library/CabalGild/Unstable/Action/AttachComments.hs +79/−32
• source/library/CabalGild/Unstable/Action/EvaluatePragmas.hs +12/−11
• source/library/CabalGild/Unstable/Action/FormatFields.hs +15/−13
• source/library/CabalGild/Unstable/Action/ReflowText.hs +19/−18
• source/library/CabalGild/Unstable/Action/Render.hs +18/−12
• source/library/CabalGild/Unstable/Type/Comments.hs +30/−0
• source/test-suite/Main.hs +180/−87

@@ -11,7 +11,7 @@ maintainer: Taylor Fausak name: cabal-gild synopsis: Formats package descriptions.-version: 1.6.0.4+version: 1.7.0.0  source-repository head   type: git@@ -107,6 +107,7 @@     CabalGild.Unstable.Type.Block     CabalGild.Unstable.Type.Chunk     CabalGild.Unstable.Type.Comment+    CabalGild.Unstable.Type.Comments     CabalGild.Unstable.Type.Condition     CabalGild.Unstable.Type.Config     CabalGild.Unstable.Type.Context

@@ -1,43 +1,70 @@ module CabalGild.Unstable.Action.AttachComments where +import qualified CabalGild.Unstable.Extra.Field as Field+import qualified CabalGild.Unstable.Extra.Name as Name import qualified CabalGild.Unstable.Type.Comment as Comment+import qualified CabalGild.Unstable.Type.Comments as Comments import qualified Control.Monad.Trans.State as StateT+import qualified Data.Maybe as Maybe+import qualified Distribution.Compat.Lens as Lens import qualified Distribution.Fields as Fields+import qualified Distribution.Parsec.Position as Position --- | High level wrapper around 'field' that makes this action easier to compose+-- | High level wrapper around 'fields' that makes this action easier to compose -- with other actions. run ::-  (Applicative m, Ord p) =>-  ([Fields.Field p], [Comment.Comment p]) ->-  m ([Fields.Field (p, [Comment.Comment p])], [Comment.Comment p])-run (fs, cs) = pure $ StateT.runState (traverse field fs) cs+  (Applicative m) =>+  ([Fields.Field Position.Position], [Comment.Comment Position.Position]) ->+  m ([Fields.Field (Position.Position, Comments.Comments Position.Position)], [Comment.Comment Position.Position])+run (fs, cs) = pure $ StateT.runState (fields Nothing fs) cs +-- | Attaches comments to a list of fields, with awareness of sibling positions.+-- The first argument is the boundary position (e.g., from a parent's next sibling).+fields ::+  Maybe Position.Position ->+  [Fields.Field Position.Position] ->+  StateT.State [Comment.Comment Position.Position] [Fields.Field (Position.Position, Comments.Comments Position.Position)]+fields p fs = case fs of+  [] -> pure []+  f : gs -> do+    let q = maybe p (Just . Name.annotation . Field.name) $ Maybe.listToMaybe gs+    (:)+      <$> field q f+      <*> fields p gs+ -- | Attaches comments to a single field. It is assumed that both the fields--- and comments are already sorted by their position @p@. This precondition is+-- and comments are already sorted by their position. This precondition is -- not checked. Note that comments actually end up attached to the field's -- name. That's because the 'Field.Field' type doesn't have any annotations -- directly on it.+--+-- Comments that are indented beyond the field's starting column are attached+-- as trailing comments (in 'Comments.after'), but only if they appear before+-- the next sibling's position. field ::-  (Ord p) =>-  Fields.Field p ->-  StateT.State [Comment.Comment p] (Fields.Field (p, [Comment.Comment p]))-field f = case f of-  Fields.Field n fls ->-    Fields.Field-      <$> name n-      <*> traverse fieldLine fls-  Fields.Section n sas fs ->-    Fields.Section-      <$> name n-      <*> traverse sectionArg sas-      <*> traverse field fs+  Maybe Position.Position ->+  Fields.Field Position.Position ->+  StateT.State [Comment.Comment Position.Position] (Fields.Field (Position.Position, Comments.Comments Position.Position))+field p f = case f of+  Fields.Field n1 fls1 -> do+    let col = Position.positionCol $ Name.annotation n1+    n2 <- name n1+    fls2 <- traverse fieldLine fls1+    cs <- attachTrailing col p+    pure $ Fields.Field (addAfterComments n2 cs) fls2+  Fields.Section n1 sas1 fs1 -> do+    let col = Position.positionCol $ Name.annotation n1+    n2 <- name n1+    sas2 <- traverse sectionArg sas1+    fs2 <- fields p fs1+    cs <- attachTrailing col p+    pure $ Fields.Section (addAfterComments n2 cs) sas2 fs2  -- | Attaches comments to a name. Note that this could be a field name or a -- section name. name ::-  (Ord p) =>-  Fields.Name p ->-  StateT.State [Comment.Comment p] (Fields.Name (p, [Comment.Comment p]))+  Fields.Name Position.Position ->+  StateT.State [Comment.Comment Position.Position] (Fields.Name (Position.Position, Comments.Comments Position.Position)) name (Fields.Name p fn) =   Fields.Name     <$> toPosition p@@ -45,9 +72,8 @@  -- | Attach comments to a field line. fieldLine ::-  (Ord p) =>-  Fields.FieldLine p ->-  StateT.State [Comment.Comment p] (Fields.FieldLine (p, [Comment.Comment p]))+  Fields.FieldLine Position.Position ->+  StateT.State [Comment.Comment Position.Position] (Fields.FieldLine (Position.Position, Comments.Comments Position.Position)) fieldLine (Fields.FieldLine p bs) =   Fields.FieldLine     <$> toPosition p@@ -58,9 +84,8 @@ -- must be on the same line as the section name, so all comments will end up -- attached to the name. sectionArg ::-  (Ord p) =>-  Fields.SectionArg p ->-  StateT.State [Comment.Comment p] (Fields.SectionArg (p, [Comment.Comment p]))+  Fields.SectionArg Position.Position ->+  StateT.State [Comment.Comment Position.Position] (Fields.SectionArg (Position.Position, Comments.Comments Position.Position)) sectionArg sa = case sa of   Fields.SecArgName p bs ->     Fields.SecArgName@@ -79,11 +104,33 @@ -- Comments are attached when their position is less than or equal to the given -- position. The comments are removed from the state as they are attached. toPosition ::-  (Ord p) =>-  p ->-  StateT.State [Comment.Comment p] (p, [Comment.Comment p])+  Position.Position ->+  StateT.State [Comment.Comment Position.Position] (Position.Position, Comments.Comments Position.Position) toPosition p = do   cs <- StateT.get   let (xs, ys) = span ((<= p) . Comment.annotation) cs   StateT.put ys-  pure (p, xs)+  pure (p, Comments.MkComments {Comments.before = xs, Comments.after = []})++-- | Attaches trailing comments based on column indentation. Comments that are+-- indented beyond the given column are considered trailing, but only up to+-- the boundary position (if specified). Comments are removed from the state.+attachTrailing ::+  Int ->+  Maybe Position.Position ->+  StateT.State [Comment.Comment Position.Position] [Comment.Comment Position.Position]+attachTrailing col boundary = do+  cs <- StateT.get+  let isTrailing c =+        let p = Comment.annotation c+         in Position.positionCol p > col && maybe True (p <) boundary+      (xs, ys) = span isTrailing cs+  StateT.put ys+  pure xs++-- | Adds trailing comments to the 'after' field of a Name's Comments.+addAfterComments ::+  Fields.Name (Position.Position, Comments.Comments Position.Position) ->+  [Comment.Comment Position.Position] ->+  Fields.Name (Position.Position, Comments.Comments Position.Position)+addAfterComments n cs = Lens.over (Name.annotationLens . Lens._2 . Comments.afterLens) (<> cs) n

@@ -9,6 +9,7 @@ import qualified CabalGild.Unstable.Extra.Name as Name import qualified CabalGild.Unstable.Extra.String as String import qualified CabalGild.Unstable.Type.Comment as Comment+import qualified CabalGild.Unstable.Type.Comments as Comments import qualified CabalGild.Unstable.Type.DiscoverTarget as DiscoverTarget import qualified CabalGild.Unstable.Type.Pragma as Pragma import qualified Control.Applicative as Applicative@@ -33,8 +34,8 @@ run ::   (Exception.MonadThrow m, MonadWalk.MonadWalk m) =>   FilePath ->-  ([Fields.Field (p, [Comment.Comment q])], cs) ->-  m ([Fields.Field (p, [Comment.Comment q])], cs)+  ([Fields.Field (p, Comments.Comments q)], cs) ->+  m ([Fields.Field (p, Comments.Comments q)], cs) run p (fs, cs) = (,) <$> traverse (field p) fs <*> pure cs  -- | Evaluates pragmas within the given field. Or, if the field is a section,@@ -42,14 +43,14 @@ field ::   (Exception.MonadThrow m, MonadWalk.MonadWalk m) =>   FilePath ->-  Fields.Field (p, [Comment.Comment q]) ->-  m (Fields.Field (p, [Comment.Comment q]))+  Fields.Field (p, Comments.Comments q) ->+  m (Fields.Field (p, Comments.Comments q)) field p f = case f of   Fields.Field n fls -> fmap (Maybe.fromMaybe f) . MaybeT.runMaybeT $ do     dt <-       maybe Applicative.empty pure $         Map.lookup (Name.value n) relevantFieldNames-    comment <- hoistMaybe . Utils.safeLast . snd $ Name.annotation n+    comment <- hoistMaybe . Utils.safeLast . Comments.toList . snd $ Name.annotation n     pragma <- hoistMaybe . Parsec.simpleParsecBS $ Comment.value comment     case pragma of       Pragma.Discover ds -> discover p n fls dt ds@@ -60,11 +61,11 @@ discover ::   (Exception.MonadThrow m, MonadWalk.MonadWalk m) =>   FilePath ->-  Fields.Name (p, [c]) ->-  [Fields.FieldLine (p, [c])] ->+  Fields.Name (p, Comments.Comments q) ->+  [Fields.FieldLine (p, Comments.Comments q)] ->   DiscoverTarget.DiscoverTarget ->   [String] ->-  MaybeT.MaybeT m (Fields.Field (p, [c]))+  MaybeT.MaybeT m (Fields.Field (p, Comments.Comments q)) discover p n fls dt ds = do   let (flgs, args, opts, errs) =         GetOpt.getOpt'@@ -87,19 +88,19 @@           . fmap clean           $ if null incs then fmap (`FilePath.combine` "**") directories else incs   files <- Trans.lift $ MonadWalk.walk root inclusions exclusions-  let comments = concatMap (snd . FieldLine.annotation) fls+  let comments = foldMap (snd . FieldLine.annotation) fls       position =         maybe (fst $ Name.annotation n) (fst . FieldLine.annotation) $           Maybe.listToMaybe fls       fieldLines = case dt of         DiscoverTarget.Modules ->-          zipWith ModuleName.toFieldLine ((,) position <$> comments : repeat [])+          zipWith ModuleName.toFieldLine ((,) position <$> comments : repeat Comments.empty)             . Maybe.mapMaybe (toModuleName directories)             $ Maybe.mapMaybe (stripAnyExtension extensions . clean) files         DiscoverTarget.Files ->           zipWith             (\a -> Fields.FieldLine a . String.toUtf8)-            ((,) position <$> comments : repeat [])+            ((,) position <$> comments : repeat Comments.empty)             files       -- This isn't great, but the comments have to go /somewhere/.       name =

@@ -6,6 +6,8 @@ import qualified CabalGild.Unstable.Extra.Name as Name import qualified CabalGild.Unstable.Extra.SectionArg as SectionArg import qualified CabalGild.Unstable.Extra.String as String+import qualified CabalGild.Unstable.Type.Comment as Comment+import qualified CabalGild.Unstable.Type.Comments as Comments import qualified CabalGild.Unstable.Type.Condition as Condition import qualified CabalGild.Unstable.Type.Dependency as Dependency import qualified CabalGild.Unstable.Type.Extension as Extension@@ -35,8 +37,8 @@ run ::   (Applicative m) =>   CabalSpecVersion.CabalSpecVersion ->-  ([Fields.Field (p, [c])], [c]) ->-  m ([Fields.Field (p, [c])], [c])+  ([Fields.Field (p, Comments.Comments q)], [Comment.Comment q]) ->+  m ([Fields.Field (p, Comments.Comments q)], [Comment.Comment q]) run csv (fs, cs) = pure (fmap (field csv) fs, cs)  -- | Formats the given field, if applicable. Otherwise returns the field as is.@@ -44,8 +46,8 @@ -- formatted. field ::   CabalSpecVersion.CabalSpecVersion ->-  Fields.Field (p, [c]) ->-  Fields.Field (p, [c])+  Fields.Field (p, Comments.Comments q) ->+  Fields.Field (p, Comments.Comments q) field csv f = case f of   Fields.Field n fls ->     let position =@@ -70,7 +72,7 @@               Left _ -> sas               Right c ->                 pure-                  . Fields.SecArgName (position, [])+                  . Fields.SecArgName (position, Comments.empty)                   . String.toUtf8                   . PrettyPrint.renderStyle style                   $ Condition.prettyCondition Variable.prettyVariable c@@ -90,15 +92,15 @@ fieldLines ::   CabalSpecVersion.CabalSpecVersion ->   p ->-  [Fields.FieldLine (p, [c])] ->+  [Fields.FieldLine (p, Comments.Comments q)] ->   SPP.SomeParsecParser ->-  [Fields.FieldLine (p, [c])]+  [Fields.FieldLine (p, Comments.Comments q)] fieldLines csv position fls SPP.SomeParsecParser {SPP.parsec = parsec, SPP.pretty = pretty} =   case Parsec.runParsecParser' csv parsec "" $ FieldLine.toFieldLineStream fls of     Left _ -> floatComments position fls     Right r ->       zipWith-        (\b l -> Fields.FieldLine (position, if b then collectComments fls else []) $ String.toUtf8 l)+        (\b l -> Fields.FieldLine (position, if b then collectComments fls else Comments.empty) $ String.toUtf8 l)         (True : repeat False)         . lines         . PrettyPrint.renderStyle style@@ -108,18 +110,18 @@ -- attaches them all to the first one. floatComments ::   p ->-  [Fields.FieldLine (p, [c])] ->-  [Fields.FieldLine (p, [c])]+  [Fields.FieldLine (p, Comments.Comments q)] ->+  [Fields.FieldLine (p, Comments.Comments q)] floatComments p fls =   zipWith-    (\b -> Fields.FieldLine (p, if b then collectComments fls else []) . FieldLine.value)+    (\b -> Fields.FieldLine (p, if b then collectComments fls else Comments.empty) . FieldLine.value)     (True : repeat False)     fls  -- | Collects all comments from the given field lines. Their relative order -- will be maintained.-collectComments :: [Fields.FieldLine (p, [c])] -> [c]-collectComments = concatMap (snd . FieldLine.annotation)+collectComments :: [Fields.FieldLine (p, Comments.Comments q)] -> Comments.Comments q+collectComments = foldMap (snd . FieldLine.annotation)  -- | This style attempts to force everything to be on its own line. style :: PrettyPrint.Style

@@ -6,6 +6,7 @@ import qualified CabalGild.Unstable.Extra.Name as Name import qualified CabalGild.Unstable.Extra.String as String import qualified CabalGild.Unstable.Type.Comment as Comment+import qualified CabalGild.Unstable.Type.Comments as Comments import qualified Data.ByteString as ByteString import qualified Data.Set as Set import qualified Distribution.CabalSpecVersion as CabalSpecVersion@@ -16,8 +17,8 @@ run ::   (Applicative m) =>   CabalSpecVersion.CabalSpecVersion ->-  ([Fields.Field (Position.Position, [Comment.Comment Position.Position])], cs) ->-  m ([Fields.Field (Position.Position, [Comment.Comment Position.Position])], cs)+  ([Fields.Field (Position.Position, Comments.Comments Position.Position)], cs) ->+  m ([Fields.Field (Position.Position, Comments.Comments Position.Position)], cs) run csv (fs, cs) = pure (fields csv fs, cs)  -- | Reflows the free text field values if the Cabal spec version is recent@@ -28,8 +29,8 @@ -- insert. fields ::   CabalSpecVersion.CabalSpecVersion ->-  [Fields.Field (Position.Position, [Comment.Comment Position.Position])] ->-  [Fields.Field (Position.Position, [Comment.Comment Position.Position])]+  [Fields.Field (Position.Position, Comments.Comments Position.Position)] ->+  [Fields.Field (Position.Position, Comments.Comments Position.Position)] fields csv fs =   if csv >= CabalSpecVersion.CabalSpecV3_0     then fmap field fs@@ -39,8 +40,8 @@ -- field as is. If the field is a section, the fields within the section will -- be recursively reflowed. field ::-  Fields.Field (Position.Position, [Comment.Comment Position.Position]) ->-  Fields.Field (Position.Position, [Comment.Comment Position.Position])+  Fields.Field (Position.Position, Comments.Comments Position.Position) ->+  Fields.Field (Position.Position, Comments.Comments Position.Position) field f = case f of   Fields.Field n fls ->     if Set.member (Name.value n) relevantFieldNames && List.compareLength fls 1 == GT@@ -60,15 +61,15 @@ -- | Reflows the field lines for the given field. This is just a wrapper around -- 'fixRows' and 'fixCols'. fieldLines ::-  Fields.Field (Position.Position, [Comment.Comment Position.Position]) ->-  [Fields.FieldLine (Position.Position, [Comment.Comment Position.Position])] ->-  [Fields.FieldLine (Position.Position, [Comment.Comment Position.Position])]+  Fields.Field (Position.Position, Comments.Comments Position.Position) ->+  [Fields.FieldLine (Position.Position, Comments.Comments Position.Position)] ->+  [Fields.FieldLine (Position.Position, Comments.Comments Position.Position)] fieldLines f = fixRows . fixCols f  -- | Inserts blank lines between field lines if necessary. fixRows ::-  [Fields.FieldLine (Position.Position, [Comment.Comment Position.Position])] ->-  [Fields.FieldLine (Position.Position, [Comment.Comment Position.Position])]+  [Fields.FieldLine (Position.Position, Comments.Comments Position.Position)] ->+  [Fields.FieldLine (Position.Position, Comments.Comments Position.Position)] fixRows fls = case fls of   x : y : zs ->     x@@ -80,9 +81,9 @@ -- other lines relative to that one. Note that if the first field line is on -- the same line as the field itself, it will never be reindented. fixCols ::-  Fields.Field (Position.Position, [Comment.Comment Position.Position]) ->-  [Fields.FieldLine (Position.Position, [Comment.Comment Position.Position])] ->-  [Fields.FieldLine (Position.Position, [Comment.Comment Position.Position])]+  Fields.Field (Position.Position, Comments.Comments Position.Position) ->+  [Fields.FieldLine (Position.Position, Comments.Comments Position.Position)] ->+  [Fields.FieldLine (Position.Position, Comments.Comments Position.Position)] fixCols f fls = case fls of   [] -> fls   x : xs ->@@ -98,11 +99,11 @@ -- | Extracts the /first/ row number from a field line, which might belong to -- one of its comments. fieldLineToFirstRow ::-  Fields.FieldLine (Position.Position, [Comment.Comment Position.Position]) ->+  Fields.FieldLine (Position.Position, Comments.Comments Position.Position) ->   Int fieldLineToFirstRow =   Position.positionRow-    . uncurry (foldr (min . Comment.annotation))+    . (\(p, cs) -> foldr (min . Comment.annotation) p $ Comments.toList cs)     . FieldLine.annotation  -- | Extracts the /last/ row number from a field line, which will not belong to@@ -125,5 +126,5 @@ -- | Creates a blank field line at the given row number. rowToFieldLine ::   Int ->-  Fields.FieldLine (Position.Position, [c])-rowToFieldLine r = Fields.FieldLine (Position.Position r 1, []) ByteString.empty+  Fields.FieldLine (Position.Position, Comments.Comments Position.Position)+rowToFieldLine r = Fields.FieldLine (Position.Position r 1, Comments.empty) ByteString.empty

@@ -6,6 +6,7 @@ import qualified CabalGild.Unstable.Type.Block as Block import qualified CabalGild.Unstable.Type.Chunk as Chunk import qualified CabalGild.Unstable.Type.Comment as Comment+import qualified CabalGild.Unstable.Type.Comments as Comments import qualified CabalGild.Unstable.Type.Line as Line import qualified Data.ByteString as ByteString import qualified Data.Function as Function@@ -19,14 +20,14 @@ run ::   (Applicative m) =>   CabalSpecVersion.CabalSpecVersion ->-  ([Fields.Field (Position.Position, [Comment.Comment p])], [Comment.Comment p]) ->+  ([Fields.Field (Position.Position, Comments.Comments p)], [Comment.Comment p]) ->   m ByteString.ByteString run csv = pure . uncurry (toByteString csv)  -- | Renders the given fields and comments to a byte string. toByteString ::   CabalSpecVersion.CabalSpecVersion ->-  [Fields.Field (Position.Position, [Comment.Comment p])] ->+  [Fields.Field (Position.Position, Comments.Comments p)] ->   [Comment.Comment p] ->   ByteString.ByteString toByteString csv fs cs =@@ -37,44 +38,48 @@         $ fields csv i fs <> comments i cs  -- | Renders the given fields to a block at the given indentation level.-fields :: CabalSpecVersion.CabalSpecVersion -> Int -> [Fields.Field (Position.Position, [Comment.Comment p])] -> Block.Block+fields :: CabalSpecVersion.CabalSpecVersion -> Int -> [Fields.Field (Position.Position, Comments.Comments p)] -> Block.Block fields csv = foldMap . field csv  -- | Renders the given field to a block at the given indentation level. -- -- If a field only has one line and no comments, then it can be rendered all on -- one line.-field :: CabalSpecVersion.CabalSpecVersion -> Int -> Fields.Field (Position.Position, [Comment.Comment p]) -> Block.Block+field :: CabalSpecVersion.CabalSpecVersion -> Int -> Fields.Field (Position.Position, Comments.Comments p) -> Block.Block field csv i f = case f of   Fields.Field n fls -> case fls of     [fl]-      | null . snd $ FieldLine.annotation fl,+      | null . Comments.after . snd $ Name.annotation n,+        null . Comments.toList . snd $ FieldLine.annotation fl,         sameRow (Name.annotation n) (FieldLine.annotation fl) ->-          comments i (snd $ Name.annotation n)+          comments i (Comments.before . snd $ Name.annotation n)             <> ( Block.fromLine                    . Lens.over Line.chunkLens (mappend $ name n <> Chunk.colon)                    $ fieldLine i fl                )     _ ->       Lens.set Block.lineAfterLens (not $ null fls) $-        comments i (snd $ Name.annotation n)+        comments i (Comments.before . snd $ Name.annotation n)           <> Block.fromLine             Line.Line               { Line.indent = i,                 Line.chunk = name n <> Chunk.colon               }           <> fieldLines (i + 1) fls+          <> comments (i + 1) (Comments.after . snd $ Name.annotation n)   Fields.Section n sas fs ->     Lens.set Block.lineBeforeLens (not $ Name.isElif csv n || Name.isElse n)       . Lens.set Block.lineAfterLens (not $ Name.isIf n || Name.isElif csv n)-      $ comments i (snd $ Name.annotation n)-        <> comments i (concatMap (snd . SectionArg.annotation) sas)+      $ comments i (Comments.before . snd $ Name.annotation n)+        <> comments i (Comments.before $ foldMap (snd . SectionArg.annotation) sas)         <> Block.fromLine           Line.Line             { Line.indent = i,               Line.chunk = Lens.set Chunk.spaceAfterLens True (name n) <> sectionArgs sas             }         <> Lens.set Block.lineBeforeLens False (fields csv (i + 1) fs)+        <> comments (i + 1) (Comments.after . snd $ Name.annotation n)+        <> comments (i + 1) (Comments.after $ foldMap (snd . SectionArg.annotation) sas)  -- | Returns true if the two positions are on the same row. sameRow :: (Position.Position, cs) -> (Position.Position, cs) -> Bool@@ -85,15 +90,16 @@ name = Chunk.fromByteString . Name.value  -- | Renders the given field lines to a block at the given indentation level.-fieldLines :: Int -> [Fields.FieldLine (p, [Comment.Comment q])] -> Block.Block+fieldLines :: Int -> [Fields.FieldLine (p, Comments.Comments q)] -> Block.Block fieldLines = foldMap . fieldLineC  -- | Renders the given field line and its comments to a block at the given -- indentation level.-fieldLineC :: Int -> Fields.FieldLine (p, [Comment.Comment q]) -> Block.Block+fieldLineC :: Int -> Fields.FieldLine (p, Comments.Comments q) -> Block.Block fieldLineC i fl =-  comments i (snd $ FieldLine.annotation fl)+  comments i (Comments.before . snd $ FieldLine.annotation fl)     <> Block.fromLine (fieldLine i fl)+    <> comments (i + 1) (Comments.after . snd $ FieldLine.annotation fl)  -- | Renders the given field line to a line at the given indentation level. fieldLine :: Int -> Fields.FieldLine a -> Line.Line

@@ -0,0 +1,30 @@+-- | This module defines the 'Comments' newtype wrapper.+module CabalGild.Unstable.Type.Comments where++import qualified CabalGild.Unstable.Type.Comment as Comment+import qualified Distribution.Compat.Lens as Lens++data Comments p = MkComments+  { before :: [Comment.Comment p],+    after :: [Comment.Comment p]+  }+  deriving (Eq, Show)++instance Semigroup (Comments p) where+  xs <> ys =+    MkComments+      { before = before xs <> before ys,+        after = after ys <> after xs+      }++instance Monoid (Comments p) where+  mempty = empty++toList :: Comments p -> [Comment.Comment p]+toList x = before x <> after x++empty :: Comments p+empty = MkComments {before = [], after = []}++afterLens :: Lens.Lens' (Comments p) [Comment.Comment p]+afterLens f s = fmap (\x -> s {after = x}) . f $ after s

@@ -286,46 +286,194 @@       "\t\r\n \r\n"       "" -  Hspec.it "formats a comment" $ do-    expectGilded-      "-- c"-      "-- c\n"+  Hspec.describe "comments" $ do+    Hspec.it "formats a comment" $ do+      expectGilded+        "-- c"+        "-- c\n" -  Hspec.it "keeps a blank comment" $ do-    expectGilded-      "--"-      "--\n"+    Hspec.it "keeps a blank comment" $ do+      expectGilded+        "--"+        "--\n" -  Hspec.it "formats multiple comments" $ do-    expectGilded-      "-- c\n-- d"-      "-- c\n-- d\n"+    Hspec.it "formats multiple comments" $ do+      expectGilded+        "-- c\n-- d"+        "-- c\n-- d\n" -  Hspec.it "removes blank lines between comments" $ do-    expectGilded-      "-- c\n\n-- d"-      "-- c\n-- d\n"+    Hspec.it "removes blank lines between comments" $ do+      expectGilded+        "-- c\n\n-- d"+        "-- c\n-- d\n" -  Hspec.it "does not require a space after the comment start" $ do-    expectGilded-      "--c"-      "--c\n"+    Hspec.it "does not require a space after the comment start" $ do+      expectGilded+        "--c"+        "--c\n" -  Hspec.it "leaves leading blank space in comments" $ do-    expectGilded-      "--\t c"-      "--\t c\n"+    Hspec.it "leaves leading blank space in comments" $ do+      expectGilded+        "--\t c"+        "--\t c\n" -  Hspec.it "trims trailing blank space from comments" $ do-    expectGilded-      "-- c\t \n"-      "-- c\n"+    Hspec.it "trims trailing blank space from comments" $ do+      expectGilded+        "-- c\t \n"+        "-- c\n" -  Hspec.it "normalizes Windows line endings in comments" $ do-    expectGilded-      "-- c\r\n"-      "-- c\n"+    Hspec.it "normalizes Windows line endings in comments" $ do+      expectGilded+        "-- c\r\n"+        "-- c\n" +    Hspec.it "formats a comment before a field" $ do+      expectGilded+        "-- c\nf: 1"+        "-- c\nf: 1\n"++    Hspec.it "formats a comment after a field" $ do+      expectGilded+        "f: 1\n-- c"+        "f: 1\n-- c\n"++    Hspec.it "formats a comment before a field's value" $ do+      expectGilded+        "f:\n -- c\n 1"+        "f:\n  -- c\n  1\n"++    Hspec.it "formats a comment in a field's value" $ do+      expectGilded+        "f:\n 1\n -- c\n 2"+        "f:\n  -- c\n  1\n  2\n"++    Hspec.it "formats a comment trailing an inline field's value" $ do+      -- This comment is indented beyond the beginning of the field, so it+      -- belongs to the field. That forces the field value into block mode,+      -- even though the input was inline.+      expectGilded+        "f: 1\n -- c"+        "f:\n  1\n  -- c\n"++    Hspec.it "formats a comment trailing an inline field's value with an extra blank line" $ do+      -- Even though there's an extra blank line separating the field from the+      -- comment, the comment is still indented past the field.+      expectGilded+        "f: 1\n\n -- c"+        "f:\n  1\n  -- c\n"++    Hspec.it "formats a comment after an inline field's value" $ do+      expectGilded+        "f: 1\n-- c"+        "f: 1\n-- c\n"++    Hspec.it "formats a comment trailing a block field's value" $ do+      expectGilded+        "f:\n 1\n -- c"+        "f:\n  1\n  -- c\n"++    Hspec.it "formats a comment trailing a block field's value with an extra blank line" $ do+      -- Same as above, but there's an extra blank line.+      expectGilded+        "f:\n 1\n\n -- c"+        "f:\n  1\n  -- c\n"++    Hspec.it "formats a comment after a block field's value" $ do+      expectGilded+        "f:\n 1\n-- c"+        "f:\n  1\n\n-- c\n"++    Hspec.it "formats a comment trailing a field with multiple values" $ do+      expectGilded+        "f: 1\n 2\n -- c"+        "f:\n  1\n  2\n  -- c\n"++    Hspec.it "formats a comment trailing a field with multiple values with an extra blank line" $ do+      -- Same as above, but there's an extra blank line.+      expectGilded+        "f: 1\n 2\n\n -- c"+        "f:\n  1\n  2\n  -- c\n"++    Hspec.it "formats a comment after a field with multiple values" $ do+      expectGilded+        "f: 1\n 2\n-- c"+        "f:\n  1\n  2\n\n-- c\n"++    Hspec.it "formats a comment before a section" $ do+      expectGilded+        "-- c\ns"+        "-- c\ns\n"++    Hspec.it "formats a comment trailing a section" $ do+      -- This comment is indented beyond the beginning of the section, so it+      -- belongs to the section.+      expectGilded+        "s\n -- c"+        "s\n  -- c\n"++    Hspec.it "formats a comment trailing a section with extra blank line" $ do+      -- Same as above, but there's an extra blank line.+      expectGilded+        "s\n\n -- c"+        "s\n  -- c\n"++    Hspec.it "formats a comment after a section's value" $ do+      -- This is a minimal reproduction of the issue reported here:+      -- <https://github.com/tfausak/cabal-gild/issues/122>.+      expectGilded+        "s\n f: 1\n -- c"+        "s\n  f: 1\n  -- c\n"++    Hspec.it "formats a comment after a section" $ do+      expectGilded+        "s\n-- c"+        "s\n\n-- c\n"++    Hspec.it "correctly indents a comment in a section" $ do+      expectGilded+        "s\n -- c\n f: 1"+        "s\n  -- c\n  f: 1\n"++    Hspec.it "floats comments on unknown fields" $ do+      expectGilded+        "unknown-field:\n the\n -- some comment\n value"+        "unknown-field:\n  -- some comment\n  the\n  value\n"++    Hspec.it "floats comments when parsing field fails" $ do+      expectGilded+        "build-depends:\n >> no\n -- comment\n parse"+        "build-depends:\n  -- comment\n  >> no\n  parse\n"++    Hspec.it "does not move an indented comment inside a field" $ do+      -- Even though the comment is indented beyond the beginning of the field,+      -- it does not belong to the field because it comes before the field.+      expectGilded+        " -- c\nf: 1"+        "-- c\nf: 1\n"++    Hspec.it "does not move an indented comment inside a section" $ do+      -- Even though the comment is indented beyond the beginning of the+      -- section, it does not belong to the section because it comes before the+      -- section.+      expectGilded+        " -- c\ns"+        "-- c\ns\n"++    Hspec.it "sorts inline field comments correctly" $ do+      expectGilded+        "-- a\n-- b\nf: 1\n -- c\n -- d"+        "-- a\n-- b\nf:\n  1\n  -- c\n  -- d\n"++    Hspec.it "sorts block field comments correctly" $ do+      expectGilded+        "-- a\n-- b\nf:\n -- c\n -- d\n 1\n -- e\n -- f\n 2\n -- g\n -- h"+        "-- a\n-- b\nf:\n  -- c\n  -- d\n  -- e\n  -- f\n  1\n  2\n  -- g\n  -- h\n"++    Hspec.it "sorts section comments correctly" $ do+      expectGilded+        "-- a\n-- b\ns\n -- c\n -- d"+        "-- a\n-- b\ns\n  -- c\n  -- d\n"+   Hspec.it "formats a field without a value" $ do     expectGilded       "f:"@@ -453,51 +601,6 @@       "s\n f:\n  1\n  2"       "s\n  f:\n    1\n    2\n" -  Hspec.it "formats a comment before a field" $ do-    expectGilded-      "-- c\nf: 1"-      "-- c\nf: 1\n"--  Hspec.it "formats a comment after a field" $ do-    expectGilded-      "f: 1\n-- c"-      "f: 1\n-- c\n"--  Hspec.it "formats a comment before a field's value" $ do-    expectGilded-      "f:\n -- c\n 1"-      "f:\n  -- c\n  1\n"--  Hspec.it "formats a comment in a field's value" $ do-    expectGilded-      "f:\n 1\n -- c\n 2"-      "f:\n  -- c\n  1\n  2\n"--  Hspec.it "formats a comment after a field's value" $ do-    expectGilded-      "f:\n 1\n -- c"-      "f:\n  1\n\n-- c\n"--  Hspec.it "formats a comment after a field with multiple values" $ do-    expectGilded-      "f: 1\n 2\n-- c"-      "f:\n  1\n  2\n\n-- c\n"--  Hspec.it "formats a comment before a section" $ do-    expectGilded-      "-- c\ns"-      "-- c\ns\n"--  Hspec.it "formats a comment after a section" $ do-    expectGilded-      "s\n-- c"-      "s\n\n-- c\n"--  Hspec.it "correctly indents a comment in a section" $ do-    expectGilded-      "s\n -- c\n f: 1"-      "s\n  -- c\n  f: 1\n"-   Hspec.describe "description" $ do     -- These tests apply to other "free text" fields as well. The description     -- field is just a representative example.@@ -1582,16 +1685,6 @@       (".", [["example.txt"]])       "-- cabal-gild: discover\nlicense-files:"       "-- cabal-gild: discover\nlicense-files: example.txt\n"--  Hspec.it "floats comments on unknown fields" $ do-    expectGilded-      "unknown-field:\n the\n -- some comment\n value"-      "unknown-field:\n  -- some comment\n  the\n  value\n"--  Hspec.it "floats comments when parsing field fails" $ do-    expectGilded-      "build-depends:\n >> no\n -- comment\n parse"-      "build-depends:\n  -- comment\n  >> no\n  parse\n"    Hspec.it "only discovers modules in given directories" $ do     expectDiscover