cabal-gild 0.3.0.0 → 0.3.0.1

raw patch · 42 files changed

+338/−43 lines, 42 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• README.md +6/−1
• cabal-gild.cabal +1/−1
• source/library/CabalGild/Action/AttachComments.hs +18/−0
• source/library/CabalGild/Action/Discover.hs +18/−7
• source/library/CabalGild/Action/ExtractComments.hs +9/−0
• source/library/CabalGild/Action/Format.hs +22/−12
• source/library/CabalGild/Action/GetCabalVersion.hs +6/−0
• source/library/CabalGild/Action/Reindent.hs +25/−4
• source/library/CabalGild/Action/RemovePositions.hs +12/−0
• source/library/CabalGild/Action/Render.hs +19/−4
• source/library/CabalGild/Class/MonadLog.hs +4/−0
• source/library/CabalGild/Class/MonadRead.hs +5/−0
• source/library/CabalGild/Class/MonadWalk.hs +7/−0
• source/library/CabalGild/Class/MonadWrite.hs +5/−0
• source/library/CabalGild/Compat/Cabal.hs +2/−0
• source/library/CabalGild/Exception/CheckFailure.hs +1/−0
• source/library/CabalGild/Exception/InvalidMode.hs +3/−0
• source/library/CabalGild/Exception/InvalidOption.hs +2/−0
• source/library/CabalGild/Exception/ParseError.hs +2/−2
• source/library/CabalGild/Exception/UnexpectedArgument.hs +3/−0
• source/library/CabalGild/Exception/UnknownOption.hs +2/−0
• source/library/CabalGild/Extra/Either.hs +1/−0
• source/library/CabalGild/Extra/Field.hs +1/−0
• source/library/CabalGild/Extra/FieldLine.hs +4/−0
• source/library/CabalGild/Extra/List.hs +3/−0
• source/library/CabalGild/Extra/ModuleName.hs +2/−0
• source/library/CabalGild/Extra/Name.hs +2/−0
• source/library/CabalGild/Extra/SectionArg.hs +1/−0
• source/library/CabalGild/Extra/String.hs +1/−0
• source/library/CabalGild/Main.hs +11/−0
• source/library/CabalGild/Type/Block.hs +17/−1
• source/library/CabalGild/Type/Chunk.hs +15/−1
• source/library/CabalGild/Type/Comment.hs +5/−0
• source/library/CabalGild/Type/Config.hs +7/−0
• source/library/CabalGild/Type/Flag.hs +7/−0
• source/library/CabalGild/Type/Line.hs +7/−1
• source/library/CabalGild/Type/List.hs +5/−0
• source/library/CabalGild/Type/Mode.hs +6/−2
• source/library/CabalGild/Type/Pragma.hs +3/−1
• source/library/CabalGild/Type/Set.hs +7/−0
• source/library/CabalGild/Type/SomeParsecParser.hs +22/−6
• source/test-suite/Main.hs +39/−0

@@ -7,6 +7,11 @@ Gild is an opinionated command line utility that formats Haskell package descriptions, which are also known as `*.cabal` files. +Gild started as a fork of [cabal-fmt][] by @phadej, but is now totally+separate.++[cabal-fmt]: https://github.com/phadej/cabal-fmt+ ## Summary  Given a package description like this:@@ -18,7 +23,7 @@  library   build-depends: mtl>=2.3, base-  ghc-options: -Wall+  ghc-options:-Wall   if impl(ghc>=9.8)     ghc-options: -Wmissing-role-annotations ```

@@ -11,7 +11,7 @@ maintainer: Taylor Fausak name: cabal-gild synopsis: Formats package descriptions.-version: 0.3.0.0+version: 0.3.0.1  source-repository head   type: git

@@ -4,18 +4,26 @@ import qualified Control.Monad.Trans.State as StateT import qualified Distribution.Fields as Fields +-- | 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 (fields fs) cs +-- | Given a bunch of fields and comments, attaches each comment to the field+-- that it belongs to. It is assumed that both the fields and comments are+-- already sorted by their position @p@. This precondition is not checked. fields ::   (Ord p) =>   [Fields.Field p] ->   StateT.State [Comment.Comment p] [Fields.Field (p, [Comment.Comment p])] fields = traverse field +-- | Attaches comments to a single field. 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. field ::   (Ord p) =>   Fields.Field p ->@@ -31,6 +39,8 @@       <*> traverse sectionArg sas       <*> traverse field fs +-- | Attaches comments to a name. Note that this could be a field name or a+-- section name. name ::   (Ord p) =>   Fields.Name p ->@@ -40,6 +50,7 @@     <$> toPosition p     <*> pure fn +-- | Attach comments to a field line. fieldLine ::   (Ord p) =>   Fields.FieldLine p ->@@ -49,6 +60,10 @@     <$> toPosition p     <*> pure bs +-- | Attaches comments to a section argument. Note that section arguments+-- cannot actually have comments attached. That's because section arguments+-- 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 ->@@ -67,6 +82,9 @@       <$> toPosition p       <*> pure bs +-- | Attaches comments to a position. This is the workhorse of the module.+-- 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 ->

@@ -7,7 +7,6 @@ import qualified CabalGild.Type.Comment as Comment import qualified CabalGild.Type.Pragma as Pragma import qualified Control.Monad as Monad-import qualified Control.Monad.Catch as Exception import qualified Control.Monad.Trans.Class as Trans import qualified Control.Monad.Trans.Maybe as MaybeT import qualified Data.Maybe as Maybe@@ -17,22 +16,30 @@ import qualified Distribution.Utils.Generic as Utils import qualified System.FilePath as FilePath +-- | High level wrapper around 'fields' that makes this action easier to+-- compose with other actions. run ::-  (Exception.MonadThrow m, MonadWalk.MonadWalk m) =>+  (MonadWalk.MonadWalk m) =>   FilePath ->   ([Fields.Field [Comment.Comment a]], cs) ->   m ([Fields.Field [Comment.Comment a]], cs) run p (fs, cs) = (,) <$> fields p fs <*> pure cs +-- | Discovers modules within the given fields. fields ::-  (Exception.MonadThrow m, MonadWalk.MonadWalk m) =>+  (MonadWalk.MonadWalk m) =>   FilePath ->   [Fields.Field [Comment.Comment a]] ->   m [Fields.Field [Comment.Comment a]] fields = mapM . field +-- | Discovers modules within the given field. Or, if the field is a section,+-- discover modules recursively within the fields of the section. If modules+-- are discovered for a field, that fields lines are completely replaced. If+-- anything goes wrong while discovering modules, the original field is+-- returned. field ::-  (Exception.MonadThrow m, MonadWalk.MonadWalk m) =>+  (MonadWalk.MonadWalk m) =>   FilePath ->   Fields.Field [Comment.Comment a] ->   m (Fields.Field [Comment.Comment a])@@ -40,8 +47,10 @@   Fields.Field n _ -> fmap (Maybe.fromMaybe f) . MaybeT.runMaybeT $ do     Monad.guard $ Set.member (Name.value n) relevantFieldNames     c <- hoistMaybe . Utils.safeLast $ Name.annotation n-    Pragma.Discover x <- hoistMaybe . Parsec.simpleParsecBS $ Comment.value c-    let d = FilePath.combine (FilePath.takeDirectory p) x+    x <- hoistMaybe . Parsec.simpleParsecBS $ Comment.value c+    y <- case x of+      Pragma.Discover y -> pure y+    let d = FilePath.combine (FilePath.takeDirectory p) y     fs <- Trans.lift $ MonadWalk.walk d     pure       . Fields.Field n@@ -50,6 +59,8 @@       $ Maybe.mapMaybe (FilePath.stripExtension "hs") fs   Fields.Section n sas fs -> Fields.Section n sas <$> fields p fs +-- | These are the names of the fields that can have this action applied to+-- them. relevantFieldNames :: Set.Set Fields.FieldName relevantFieldNames =   Set.fromList $@@ -59,7 +70,7 @@         "other-modules"       ] --- This was added in transformers-0.6.0.0. See+-- | This was added in @transformers-0.6.0.0@. See -- <https://hub.darcs.net/ross/transformers/issue/49>. hoistMaybe :: (Applicative f) => Maybe a -> MaybeT.MaybeT f a hoistMaybe = MaybeT.MaybeT . pure

@@ -10,12 +10,16 @@ import qualified Data.Word as Word import qualified Distribution.Parsec.Position as Position +-- | Extracts comments from the given byte string. This is a wrapper around+-- 'fromLine', where lines are split using 'Latin1.lines'. fromByteString :: ByteString.ByteString -> [Comment.Comment Position.Position] fromByteString =   Maybe.mapMaybe (uncurry fromLine)     . zip [1 ..]     . Latin1.lines +-- | Extracts a comment from the given line. If the line does not contain a+-- comment, the result will be 'Alternative.empty'. fromLine ::   (Applicative.Alternative m, Monad m) =>   Int ->@@ -33,8 +37,13 @@         Comment.value = ByteString.dropWhileEnd isBlank rest       } +-- | Breaks a byte string into two parts: the part before the comment delimiter+-- and the part after. If there is no comment, the part after will be empty. breakComment :: ByteString.ByteString -> (ByteString.ByteString, ByteString.ByteString) breakComment = ByteString.breakSubstring Comment.delimiter +-- | Returns true if the given byte is a blank character. Currently this is a+-- wrapper around 'ByteStringInternal.isSpaceWord8'. Perhaps it should only+-- check for spaces and tabs though. isBlank :: Word.Word8 -> Bool isBlank = ByteStringInternal.isSpaceWord8

@@ -14,7 +14,6 @@ import qualified Distribution.Fields as Fields import qualified Distribution.ModuleName as ModuleName import qualified Distribution.Parsec as Parsec-import qualified Distribution.Pretty as Pretty import qualified Distribution.Types.Dependency as Dependency import qualified Distribution.Types.ExeDependency as ExeDependency import qualified Distribution.Types.ForeignLibOption as ForeignLibOption@@ -25,6 +24,7 @@ import qualified Language.Haskell.Extension as Extension import qualified Text.PrettyPrint as PrettyPrint +-- | A wrapper around 'fields' to allow this to be composed with other actions. run ::   (Applicative m, Monoid cs) =>   CabalSpecVersion.CabalSpecVersion ->@@ -32,6 +32,7 @@   m ([Fields.Field cs], cs) run csv (fs, cs) = pure (fields csv fs, cs) +-- | A wrapper around 'field'. fields ::   (Monoid cs) =>   CabalSpecVersion.CabalSpecVersion ->@@ -39,6 +40,9 @@   [Fields.Field cs] fields = fmap . field +-- | Formats the given field, if applicable. Otherwise returns the field as is.+-- If the field is a section, the fields within the section will be recursively+-- formatted. field ::   (Monoid cs) =>   CabalSpecVersion.CabalSpecVersion ->@@ -50,39 +54,45 @@     Just spp -> Fields.Field n $ fieldLines csv fls spp   Fields.Section n sas fs -> Fields.Section n sas $ fields csv fs +-- | Attempts to parse the given field lines using the given parser. If parsing+-- fails, the field lines will be returned as is. Comments within the field+-- lines will be preserved but "float" up to the top. fieldLines ::   (Monoid cs) =>   CabalSpecVersion.CabalSpecVersion ->   [Fields.FieldLine cs] ->   SPP.SomeParsecParser ->   [Fields.FieldLine cs]-fieldLines csv fls (SPP.SomeParsecParser pp) =-  case Parsec.runParsecParser' csv pp "" $ FieldLine.toFieldLineStream fls of-    Left _ ->-      -- Parsing failed, so simply return the field lines as is.-      fls+fieldLines csv fls SPP.SomeParsecParser {SPP.parsec = parsec, SPP.pretty = pretty} =+  case Parsec.runParsecParser' csv parsec "" $ FieldLine.toFieldLineStream fls of+    Left _ -> fls     Right r ->       fmap (\(c, l) -> Fields.FieldLine c $ String.toUtf8 l)         . zip (foldMap FieldLine.annotation fls : repeat mempty)         . lines         . PrettyPrint.renderStyle style-        $ Pretty.prettyVersioned csv r+        $ pretty csv r +-- | This style attempts to force everything to be on its own line. style :: PrettyPrint.Style style =-  -- Everything should be on its own line.   PrettyPrint.Style     { PrettyPrint.mode = PrettyPrint.PageMode,       PrettyPrint.lineLength = 0,       PrettyPrint.ribbonsPerLine = 1     } +-- | A map from field names to parsers. This determines which parser should be+-- used for which field. And consequently this determines which fields will be+-- formatted.+--+-- Perhaps instead of being keyed on 'Fields.FieldName', this should be keyed+-- on a path (list of field names) instead. That's because a field like+-- @build-depends@ only really makes sense within a section like @library@.+-- Fortunately field names are unique enough that this hasn't been a problem+-- yet. parsers :: Map.Map Fields.FieldName SPP.SomeParsecParser parsers =-  -- Perhaps these should use paths as keys rather than field names. That's-  -- because some fields are only supposed to occur within certain sections.-  -- For example, `exposed-modules` occurs in (at least) `library`. Fortunately-  -- field names are unique enough for this not to be a problem.   let (=:) :: String -> SPP.SomeParsecParser -> (Fields.FieldName, SPP.SomeParsecParser)       (=:) = (,) . String.toUtf8    in Map.fromList

@@ -11,22 +11,28 @@ import qualified Distribution.Fields as Fields import qualified Distribution.Parsec as Parsec +-- | Gets the Cabal spec version from a list of fields. If multiple fields+-- define the version, the first one is used. fromFields :: [Fields.Field a] -> CabalSpecVersion.CabalSpecVersion fromFields fs = Maybe.fromMaybe CabalSpecVersion.CabalSpecV1_0 $ do   f <- List.find isCabalVersion fs   fls <- getFieldLines f   Newtypes.getSpecVersion <$> fromFieldLines fls +-- | Returns true if the field is named @cabal-version@. isCabalVersion :: Fields.Field a -> Bool isCabalVersion f = case f of   Fields.Field n _ -> Name.value n == String.toUtf8 "cabal-version"   Fields.Section {} -> False +-- | Gets the field lines from a field. If the field is a section, this returns+-- 'Nothing'. getFieldLines :: Fields.Field a -> Maybe [Fields.FieldLine a] getFieldLines f = case f of   Fields.Field _ fls -> Just fls   Fields.Section {} -> Nothing +-- | Attempts to parse the given field lines as a Cabal spec version. fromFieldLines :: [Fields.FieldLine a] -> Maybe Newtypes.SpecVersion fromFieldLines =   Either.hush

@@ -12,6 +12,7 @@ import qualified Distribution.Fields as Fields import qualified Distribution.Parsec.Position as Position +-- | A wrapper around 'fields' to allow this to be composed with other actions. run ::   (Applicative m) =>   CabalSpecVersion.CabalSpecVersion ->@@ -19,18 +20,24 @@   m ([Fields.Field (Position.Position, [Comment.Comment Position.Position])], cs) run csv (fs, cs) = pure (fields csv fs, cs) +-- | Reindents the free text field values if the Cabal spec version is recent+-- enough (at least @3.0@).+--+-- Note that this requires comments to be already attached. That's because+-- comments should not be attached to blank lines, which this function will+-- insert. fields ::   CabalSpecVersion.CabalSpecVersion ->   [Fields.Field (Position.Position, [Comment.Comment Position.Position])] ->   [Fields.Field (Position.Position, [Comment.Comment Position.Position])] fields csv fs =-  -- Note that we want to do this after comments have been attached because we-  -- want comments to come as late as possible. In other words, we don't want a-  -- comment attached to a blank line.   if csv >= CabalSpecVersion.CabalSpecV3_0     then fmap field fs     else fs +-- | Reindents the free text field value if applicable. Otherwise returns the+-- field as is. If the field is a section, the fields within the section will+-- be recursively reindented. field ::   Fields.Field (Position.Position, [Comment.Comment Position.Position]) ->   Fields.Field (Position.Position, [Comment.Comment Position.Position])@@ -41,6 +48,7 @@       else f   Fields.Section n sas fs -> Fields.Section n sas $ fmap field fs +-- | The names of the fields that should be reindented. relevantFieldNames :: Set.Set Fields.FieldName relevantFieldNames =   Set.fromList $@@ -49,12 +57,15 @@       [ "description"       ] +-- | Reindents 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])] 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])]@@ -65,6 +76,9 @@         <> fixRows (y : zs)   _ -> fls +-- | Reindents field lines by finding the least indented line and adjusting the+-- 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])] ->@@ -77,24 +91,30 @@           then x : fmap (reindent col) xs           else fmap (reindent col) fls +-- | Extracts the column number from a field line. fieldLineToCol :: Fields.FieldLine (Position.Position, cs) -> Int fieldLineToCol = Position.positionCol . fst . FieldLine.annotation +-- | 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]) ->   Int fieldLineToFirstRow =-  -- A field line's first row might belong to one of its comments.   Position.positionRow     . uncurry (foldr (min . Comment.annotation))     . FieldLine.annotation +-- | Extracts the /last/ row number from a field line, which will not belong to+-- any of its comments. fieldLineToLastRow :: Fields.FieldLine (Position.Position, cs) -> Int fieldLineToLastRow = Position.positionRow . fst . FieldLine.annotation +-- | Extracts the row number from a field. fieldToRow :: Fields.Field (Position.Position, cs) -> Int fieldToRow = Position.positionRow . fst . Name.annotation . Field.name +-- | Reindents the field line using the given column number. reindent ::   Int ->   Fields.FieldLine (Position.Position, cs) ->@@ -102,6 +122,7 @@ reindent col (Fields.FieldLine (p, cs) b) =   Fields.FieldLine (p, cs) $ ByteString.replicate (Position.positionCol p - col) 0x20 <> b +-- | Creates a blank field line at the given row number. rowToFieldLine ::   Int ->   Fields.FieldLine (Position.Position, [c])

@@ -3,17 +3,22 @@ import qualified CabalGild.Type.Comment as Comment import qualified Distribution.Fields as Fields +-- | A wrapper around 'fields' to allow this to be composed with other actions. run ::   (Applicative m) =>   ([Fields.Field (p, [Comment.Comment p])], [Comment.Comment p]) ->   m ([Fields.Field [Comment.Comment ()]], [Comment.Comment ()]) run (fs, cs) = pure (fields fs, comments cs) +-- | Removes the positions from some fields and their comments. This is useful+-- for two reasons: the annotations become simpler, and it's clear that the+-- positions won't be used for anything else. fields ::   [Fields.Field (p, [Comment.Comment p])] ->   [Fields.Field [Comment.Comment ()]] fields = fmap field +-- | Removes the positions from a field and its comments. field ::   Fields.Field (p, [Comment.Comment p]) ->   Fields.Field [Comment.Comment ()]@@ -21,26 +26,31 @@   Fields.Field n fls -> Fields.Field (name n) $ fieldLines fls   Fields.Section n sas fs -> Fields.Section (name n) (sectionArgs sas) $ fields fs +-- | Removes the positions from a name and its comments. name ::   Fields.Name (p, [Comment.Comment p]) ->   Fields.Name [Comment.Comment ()] name (Fields.Name (_, cs) x) = Fields.Name (comments cs) x +-- | Removes the positions from field lines and their comments. fieldLines ::   [Fields.FieldLine (p, [Comment.Comment p])] ->   [Fields.FieldLine [Comment.Comment ()]] fieldLines = fmap fieldLine +-- | Removes the positions from a field line and its comments. fieldLine ::   Fields.FieldLine (p, [Comment.Comment p]) ->   Fields.FieldLine [Comment.Comment ()] fieldLine (Fields.FieldLine (_, cs) x) = Fields.FieldLine (comments cs) x +-- | Removes the positions from some section arguments and their comments. sectionArgs ::   [Fields.SectionArg (p, [Comment.Comment p])] ->   [Fields.SectionArg [Comment.Comment ()]] sectionArgs = fmap sectionArg +-- | Removes the positions from a section argument and its comments. sectionArg ::   Fields.SectionArg (p, [Comment.Comment p]) ->   Fields.SectionArg [Comment.Comment ()]@@ -49,11 +59,13 @@   Fields.SecArgStr (_, cs) x -> Fields.SecArgStr (comments cs) x   Fields.SecArgOther (_, cs) x -> Fields.SecArgOther (comments cs) x +-- | Removes the positions from some comments. comments ::   [Comment.Comment p] ->   [Comment.Comment ()] comments = fmap comment +-- | Removes the position from a comment. comment ::   Comment.Comment p ->   Comment.Comment ()

@@ -11,12 +11,15 @@ import qualified Distribution.Compat.Lens as Lens import qualified Distribution.Fields as Fields +-- | A wrapper around 'toByteString' to allow this to be composed with other+-- actions. run ::   (Applicative m) =>   ([Fields.Field [Comment.Comment a]], [Comment.Comment a]) ->   m ByteString.ByteString run = pure . uncurry toByteString +-- | Renders the given fields and comments to a byte string. toByteString ::   [Fields.Field [Comment.Comment a]] ->   [Comment.Comment a] ->@@ -28,16 +31,19 @@         . Lens.set Block.lineAfterLens True         $ fields i fs <> comments i cs +-- | Renders the given fields to a block at the given indentation level. fields :: Int -> [Fields.Field [Comment.Comment a]] -> Block.Block fields = foldMap . field +-- | 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 :: Int -> Fields.Field [Comment.Comment a] -> Block.Block field i f = case f of   Fields.Field n fls -> case fls of     [fl]       | null $ FieldLine.annotation fl ->-          -- If the field only has one line and no comments, then it can be-          -- rendered all on one line.           comments i (Name.annotation n)             <> ( Block.fromLine                    . Lens.over Line.chunkLens (mappend $ name n <> Chunk.colon)@@ -56,8 +62,6 @@     Lens.set Block.lineBeforeLens True       . Lens.set Block.lineAfterLens True       $ comments i (Name.annotation n)-        -- Section arguments should never have comments in practice. This is-        -- here simply to ensure that they aren't lost.         <> comments i (concatMap SectionArg.annotation sas)         <> Block.fromLine           Line.Line@@ -66,17 +70,22 @@             }         <> Lens.set Block.lineBeforeLens False (fields (i + 1) fs) +-- | Renders the given name to a chunk. name :: Fields.Name a -> Chunk.Chunk name = Chunk.fromByteString . Name.value +-- | Renders the given field lines to a block at the given indentation level. fieldLines :: Int -> [Fields.FieldLine [Comment.Comment a]] -> 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 [Comment.Comment a] -> Block.Block fieldLineC i fl =   comments i (FieldLine.annotation fl)     <> Block.fromLine (fieldLine i fl) +-- | Renders the given field line to a line at the given indentation level. fieldLine :: Int -> Fields.FieldLine a -> Line.Line fieldLine i =   Line.Line i@@ -84,9 +93,13 @@     . Chunk.fromByteString     . FieldLine.value +-- | Renders the given section arguments to a chunk. Note that comments are+-- ignored. In practice this isn't a problem because section arguments can't+-- have comments attached anyway. sectionArgs :: [Fields.SectionArg a] -> Chunk.Chunk sectionArgs = Lens.set Chunk.spaceBeforeLens True . foldMap sectionArg +-- | Renders the given section argument to a chunk. sectionArg :: Fields.SectionArg a -> Chunk.Chunk sectionArg sa = case sa of   Fields.SecArgName _ bs ->@@ -108,9 +121,11 @@           . Lens.set Chunk.spaceAfterLens b           $ Chunk.fromByteString bs +-- | Renders the given comments to a block at the given indentation level. comments :: Int -> [Comment.Comment a] -> Block.Block comments i cs = mempty {Block.lines = fmap (comment i) cs} +-- | Renders the given comment to a line at the given indentation level. comment :: Int -> Comment.Comment a -> Line.Line comment i =   Line.Line i

@@ -1,10 +1,14 @@ module CabalGild.Class.MonadLog where +-- | A 'Monad' that can also log messages. class (Monad m) => MonadLog m where+  -- | Logs the given message. Typical usage should prefer 'logLn'.   log :: String -> m () +-- | Uses 'putStr'. instance MonadLog IO where   log = putStr +-- | Logs the message followed by a newline. logLn :: (MonadLog m) => String -> m () logLn = CabalGild.Class.MonadLog.log . (<> "\n")

@@ -2,8 +2,13 @@  import qualified Data.ByteString as ByteString +-- | A 'Monad' that can also read input, either from standard input (STDIN) or+-- from a file. class (Monad m) => MonadRead m where+  -- | Reads input from the given file, or from STDIN if the given file is+  -- 'Nothing'.   read :: Maybe FilePath -> m ByteString.ByteString +-- | Uses 'ByteString.getContents' or 'ByteString.readFile'. instance MonadRead IO where   read = maybe ByteString.getContents ByteString.readFile

@@ -3,12 +3,19 @@ import qualified System.Directory as Directory import qualified System.FilePath as FilePath +-- | A 'Monad' that can also walk the file system. class (Monad m) => MonadWalk m where+  -- | Lists all files in the given directory and its subdirectories+  -- recursively.   walk :: FilePath -> m [FilePath] +-- | Uses 'listDirectoryRecursively'. instance MonadWalk IO where   walk = listDirectoryRecursively +-- | Lists all files in the given directory and its subdirectories recursively.+-- The order is not guaranteed and may change between different calls. It's+-- also not specified if the results are breadth-first or depth-first. listDirectoryRecursively :: FilePath -> IO [FilePath] listDirectoryRecursively d = do   es <- Directory.listDirectory d

@@ -2,8 +2,13 @@  import qualified Data.ByteString as ByteString +-- | A 'Monad' that can also write output, either to standard output (STDOUT)+-- or to a file. class (Monad m) => MonadWrite m where+  -- | Writes output to the given file, or to STDOUT if the given file is+  -- 'Nothing'.   write :: Maybe FilePath -> ByteString.ByteString -> m () +-- | Uses 'ByteString.putStr' or 'ByteString.writeFile'. instance MonadWrite IO where   write = maybe ByteString.putStr ByteString.writeFile

@@ -2,6 +2,8 @@ {-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -Wno-orphans #-} +-- | This module defines orphan instances for some Cabal types. These instances+-- are defined in more recent versions of the @Cabal-syntax@ library. module CabalGild.Compat.Cabal where  #if !MIN_VERSION_Cabal_syntax(3, 10, 1)

@@ -2,6 +2,7 @@  import qualified Control.Monad.Catch as Exception +-- | This exception is thrown when the input is not formatted correctly. data CheckFailure   = CheckFailure   deriving (Eq, Show)

@@ -2,6 +2,8 @@  import qualified Control.Monad.Catch as Exception +-- | This exception is thrown when the given 'CabalGild.Type.Mode.Mode' is+-- invalid. newtype InvalidMode   = InvalidMode String   deriving (Eq, Show)@@ -9,5 +11,6 @@ instance Exception.Exception InvalidMode where   displayException (InvalidMode s) = "invalid mode: " <> s +-- | Constructs an 'InvalidMode' from the given 'String'. fromString :: String -> InvalidMode fromString = InvalidMode

@@ -4,6 +4,7 @@ import qualified Data.Char as Char import qualified Data.List as List +-- | This exception is thrown when a command line option is invalid. newtype InvalidOption   = InvalidOption String   deriving (Eq, Show)@@ -11,5 +12,6 @@ instance Exception.Exception InvalidOption where   displayException (InvalidOption s) = "invalid option: " <> s +-- | Constructs an 'InvalidOption' from the given 'String'. fromString :: String -> InvalidOption fromString = InvalidOption . List.dropWhileEnd Char.isSpace

@@ -3,8 +3,8 @@ import qualified Control.Monad.Catch as Exception import qualified Text.Parsec.Error as Parsec --- This type only exists to add an `Exception` instance to the `ParseError`--- type. That instance was added in parsec-3.17.0.0. See:+-- | This type only exists to add an 'Exception.Exception' instance to the+-- 'Parsec.ParseError' type. That instance was added in @parsec-3.1.17.0@. See: -- <https://github.com/haskell/parsec/pull/178>. newtype ParseError = ParseError   { unwrap :: Parsec.ParseError

@@ -2,6 +2,8 @@  import qualified Control.Monad.Catch as Exception +-- | This exception is thrown when an unexpected command line argument is+-- encountered. newtype UnexpectedArgument   = UnexpectedArgument String   deriving (Eq, Show)@@ -9,5 +11,6 @@ instance Exception.Exception UnexpectedArgument where   displayException (UnexpectedArgument s) = "unexpected argument: " <> s +-- | Constructs an 'UnexpectedArgument' from the given 'String'. fromString :: String -> UnexpectedArgument fromString = UnexpectedArgument

@@ -2,6 +2,7 @@  import qualified Control.Monad.Catch as Exception +-- | This exception is thrown when a command line option is not known. newtype UnknownOption   = UnknownOption String   deriving (Eq, Show)@@ -9,5 +10,6 @@ instance Exception.Exception UnknownOption where   displayException (UnknownOption s) = "unknown option: " <> s +-- | Constructs an 'UnknownOption' from the given 'String'. fromString :: String -> UnknownOption fromString = UnknownOption

@@ -1,4 +1,5 @@ module CabalGild.Extra.Either where +-- | Converts an 'Either' to a 'Maybe'. hush :: Either x a -> Maybe a hush = either (const Nothing) Just

@@ -2,6 +2,7 @@  import qualified Distribution.Fields as Fields +-- | Extracts the name of a 'Fields.Field'. name :: Fields.Field a -> Fields.Name a name f = case f of   Fields.Field n _ -> n

@@ -4,12 +4,16 @@ import qualified Distribution.Fields as Fields import qualified Distribution.Parsec.FieldLineStream as FieldLineStream +-- | Extracts the annotation of a 'Fields.FieldLine'. annotation :: Fields.FieldLine a -> a annotation (Fields.FieldLine x _) = x +-- | Extracts the value of a 'Fields.FieldLine'. value :: Fields.FieldLine a -> ByteString.ByteString value (Fields.FieldLine _ x) = x +-- | Converts a list of 'Fields.FieldLine's into a+-- 'FieldLineStream.FieldLineStream'. toFieldLineStream :: [Fields.FieldLine a] -> FieldLineStream.FieldLineStream toFieldLineStream fls = case fls of   [] -> FieldLineStream.FLSLast ByteString.empty

@@ -1,5 +1,8 @@ module CabalGild.Extra.List where +-- | Compares the length of the given list to the given integer. This is+-- equivalent to @compare (length xs) n@, but it can be more efficient if @n@+-- is less than @length xs@. compareLength :: [a] -> Int -> Ordering compareLength xs n =   if n < 0

@@ -8,8 +8,10 @@ import qualified Distribution.Pretty as Pretty import qualified System.FilePath as FilePath +-- | Parses a 'FilePath' as a 'ModuleName.ModuleName'. fromFilePath :: FilePath -> Maybe ModuleName.ModuleName fromFilePath = Parsec.simpleParsec . List.intercalate "." . FilePath.splitDirectories +-- | Converts a 'ModuleName.ModuleName' into a 'Fields.FieldLine'. toFieldLine :: a -> ModuleName.ModuleName -> Fields.FieldLine a toFieldLine a = Fields.FieldLine a . String.toUtf8 . Pretty.prettyShow

@@ -2,8 +2,10 @@  import qualified Distribution.Fields as Fields +-- | Extracts the annotation from the given 'Fields.Name'. annotation :: Fields.Name a -> a annotation (Fields.Name x _) = x +-- | Extracts the value from the given 'Fields.Name'. value :: Fields.Name a -> Fields.FieldName value (Fields.Name _ x) = x

@@ -2,6 +2,7 @@  import qualified Distribution.Fields as Fields +-- | Extracts the annotation from the given 'Fields.SectionArg'. annotation :: Fields.SectionArg a -> a annotation sa = case sa of   Fields.SecArgName x _ -> x

@@ -4,5 +4,6 @@ import qualified Data.Text as Text import qualified Data.Text.Encoding as Encoding +-- | Converts the given 'String' into a UTF-8 encoded 'ByteString.ByteString'. toUtf8 :: String -> ByteString.ByteString toUtf8 = Encoding.encodeUtf8 . Text.pack

@@ -1,3 +1,4 @@+-- | This module defines the main entry point for the application. module CabalGild.Main where  import qualified CabalGild.Action.AttachComments as AttachComments@@ -28,12 +29,19 @@ import qualified System.Exit as Exit import qualified System.IO as IO +-- | This is the main entry point for the application. It gets the command line+-- arguments and then hands things off to 'mainWith'. If any exceptions are+-- thrown, they will be handled by 'onException'. defaultMain :: IO () defaultMain = Exception.handle onException $ do   name <- Environment.getProgName   arguments <- Environment.getArgs   mainWith name arguments +-- | If the exception was an 'Exit.ExitCode', simply exit with that code.+-- Otherwise handle exceptions by printing them to STDERR using+-- 'Exception.displayException' instead of 'show'. Then exit with a failing+-- status code. onException :: Exception.SomeException -> IO a onException e = case Exception.fromException e of   Just exitCode -> Exit.exitWith exitCode@@ -41,6 +49,9 @@     IO.hPutStrLn IO.stderr $ Exception.displayException e     Exit.exitFailure +-- | The actual logic for the command line application. This is written using+-- constraints so that it can be run in pure code if so desired. But most often+-- this will be run in 'IO'. mainWith ::   ( MonadLog.MonadLog m,     MonadRead.MonadRead m,

@@ -1,3 +1,4 @@+-- | This module defines the 'Block' data type. module CabalGild.Type.Block where  import qualified CabalGild.Type.Line as Line@@ -5,13 +6,20 @@ import qualified Distribution.Compat.Lens as Lens import Prelude hiding (lines) +-- | A block of text, which is made up of multiple lines and can have blank+-- lines before and/or after it. data Block = Block-  { lineBefore :: Bool,+  { -- | Does this block have a blank line before it?+    lineBefore :: Bool,     lines :: [Line.Line],+    -- | Does this block have a blank line after it?     lineAfter :: Bool   }   deriving (Eq, Show) +-- | Joins two blocks together by adding a blank line between them if+-- necessary. (A blank line is necessary if /either/ block needs a space.) If+-- either block is empty, the other block is returned. instance Semigroup Block where   x <> y =     let s = [Line.empty | lineAfter x || lineBefore y]@@ -23,6 +31,7 @@             }      in if isEmpty x then y else if isEmpty y then x else z +-- | The empty block has no lines and also no blank lines before or after. instance Monoid Block where   mempty =     Block@@ -31,18 +40,25 @@         lineAfter = False       } +-- | Converts a single line into a block without blank lines before or after. fromLine :: Line.Line -> Block fromLine l = mempty {lines = [l]} +-- | Returns 'True' if the block has no lines. isEmpty :: Block -> Bool isEmpty = null . lines +-- | A lens for the 'lineAfter' field. lineAfterLens :: Lens.Lens' Block Bool lineAfterLens f s = fmap (\a -> s {lineAfter = a}) . f $ lineAfter s +-- | A lens for the 'lineBefore' field. lineBeforeLens :: Lens.Lens' Block Bool lineBeforeLens f s = fmap (\a -> s {lineBefore = a}) . f $ lineBefore s +-- | Converts a block into a 'ByteString.ByteString' by joining the lines+-- together with newline characters. Note that unline 'unlines', there will be+-- no trailing newline unless 'lineAfter' is 'True'. toByteString :: Block -> ByteString.ByteString toByteString b =   if isEmpty b

@@ -1,15 +1,23 @@+-- | This module defines the 'Chunk' data type. module CabalGild.Type.Chunk where  import qualified Data.ByteString as ByteString import qualified Distribution.Compat.Lens as Lens +-- | A chunk of text, which is made up of a byte string and can have blank+-- spaces before and/or after it. data Chunk = Chunk-  { spaceBefore :: Bool,+  { -- | Does this chunk have a blank space before it?+    spaceBefore :: Bool,     value :: ByteString.ByteString,+    -- | Does this chunk have a blank space after it?     spaceAfter :: Bool   }   deriving (Eq, Show) +-- | Joins two chunks together by adding a blank space between them if+-- necessary. (A blank space is necessary if /both/ chunks need a space.) If+-- either chunk is empty, the other chunk is returned. instance Semigroup Chunk where   x <> y =     let s =@@ -24,6 +32,7 @@             }      in if isEmpty x then y else if isEmpty y then x else z +-- | The empty chunk has no value and also no blank spaces before or after. instance Monoid Chunk where   mempty =     Chunk@@ -32,17 +41,22 @@         spaceAfter = False       } +-- | A colon with a space after. colon :: Chunk colon = Lens.set spaceAfterLens True . fromByteString $ ByteString.singleton 0x3a +-- | Converts a byte string into a chunk without blank spaces before or after. fromByteString :: ByteString.ByteString -> Chunk fromByteString bs = mempty {value = bs} +-- | Returns 'True' if the chunk's byte string is empty. isEmpty :: Chunk -> Bool isEmpty = ByteString.null . value +-- | A lens for the 'spaceAfter' field. spaceAfterLens :: Lens.Lens' Chunk Bool spaceAfterLens f s = fmap (\a -> s {spaceAfter = a}) . f $ spaceAfter s +-- | A lens for the 'spaceBefore' field. spaceBeforeLens :: Lens.Lens' Chunk Bool spaceBeforeLens f s = fmap (\a -> s {spaceBefore = a}) . f $ spaceBefore s

@@ -1,13 +1,18 @@+-- | This module defines the 'Comment' data type. module CabalGild.Type.Comment where  import qualified CabalGild.Extra.String as String import qualified Data.ByteString as ByteString +-- | A comment with corresponding annotation. Leading blank space is preserved,+-- but trailing blank space is not. data Comment a = Comment   { annotation :: a,+    -- | Does /not/ include the 'delimiter'.     value :: ByteString.ByteString   }   deriving (Eq, Show) +-- | The start of a comment, which is @--@. delimiter :: ByteString.ByteString delimiter = String.toUtf8 "--"

@@ -1,3 +1,4 @@+-- | This module defines the 'Config' data type. module CabalGild.Type.Config where  import qualified CabalGild.Type.Flag as Flag@@ -5,6 +6,8 @@ import qualified Control.Monad as Monad import qualified Control.Monad.Catch as Exception +-- | This data type represents the configuration for the command line utility.+-- Each field typically corresponds to a flag. data Config = Config   { help :: Bool,     input :: Maybe FilePath,@@ -15,6 +18,7 @@   }   deriving (Eq, Show) +-- | The default config. initial :: Config initial =   Config@@ -26,6 +30,7 @@       version = False     } +-- | Applies a flag to the config, returning the new config. applyFlag :: (Exception.MonadThrow m) => Config -> Flag.Flag -> m Config applyFlag config flag = case flag of   Flag.Help b -> pure config {help = b}@@ -41,5 +46,7 @@   Flag.Stdin s -> pure config {stdin = s}   Flag.Version b -> pure config {version = b} +-- | Converts a list of flags into a config by starting with 'initial' and+-- repeatedly calling 'applyFlag'. fromFlags :: (Exception.MonadThrow m) => [Flag.Flag] -> m Config fromFlags = Monad.foldM applyFlag initial

@@ -6,6 +6,9 @@ import qualified Control.Monad.Catch as Exception import qualified System.Console.GetOpt as GetOpt +-- | A flag, which represents a command line option. The values associated with+-- the flags are typically not parsed. These just handle the structure of+-- command line options. data Flag   = Help Bool   | Input String@@ -15,6 +18,7 @@   | Version Bool   deriving (Eq, Show) +-- | The command line options the correspond to the flags. options :: [GetOpt.OptDescr Flag] options =   [ GetOpt.Option@@ -59,6 +63,9 @@       "Sets the path to the input file when using STDIN.\nDefault: '.'"   ] +-- | Converts a list of command line arguments into a list of flags. If there+-- are any unexpected arguments, invalid options, or unknown options, an+-- exception will be thrown. fromArguments :: (Exception.MonadThrow m) => [String] -> m [Flag] fromArguments arguments = do   let (flgs, args, opts, errs) = GetOpt.getOpt' GetOpt.Permute options arguments

@@ -4,15 +4,19 @@ import qualified Data.ByteString as ByteString import qualified Distribution.Compat.Lens as Lens +-- | A line of text, which is made up of a chunk and an indent level. data Line = Line-  { indent :: Int,+  { -- | Number of times the chunk should be indented.+    indent :: Int,     chunk :: Chunk.Chunk   }   deriving (Eq, Show) +-- | A lens for the 'chunk' field. chunkLens :: Lens.Lens' Line Chunk.Chunk chunkLens f s = fmap (\a -> s {chunk = a}) . f $ chunk s +-- | An empty line, which is an empty chunk with no indentation. empty :: Line empty =   Line@@ -20,9 +24,11 @@       chunk = mempty     } +-- | Returns 'True' if the line's chunk is empty. isEmpty :: Line -> Bool isEmpty = Chunk.isEmpty . chunk +-- | Converts a line to a 'ByteString' by indenting the chunk. toByteString :: Line -> ByteString.ByteString toByteString l =   if isEmpty l

@@ -14,6 +14,9 @@ import qualified Distribution.Pretty as Pretty import qualified Text.PrettyPrint as PrettyPrint +-- | A thin wrapper around 'Newtypes.List'. This is used to define custom+-- instances of 'Pretty.Pretty' that use trailing commas when the Cabal spec+-- version is recent enough (at least @2.2@). newtype List s b a = List   { unwrap :: Newtypes.List s b a   }@@ -44,6 +47,8 @@       . fmap (Pretty.prettyVersioned @b v . Newtype.pack)       . Newtype.unpack +-- | Overlaps the more general instance in order to use trailing commas when+-- possible. instance   {-# OVERLAPPING #-}   ( Newtype.Newtype a b,

@@ -3,11 +3,15 @@ import qualified CabalGild.Exception.InvalidMode as InvalidMode import qualified Control.Monad.Catch as Exception +-- | Represents the mode of the command line utility. data Mode-  = Check-  | Format+  = -- | Just determine if the input is already formatted.+    Check+  | -- | Format the input.+    Format   deriving (Eq, Show) +-- | Attempts to parse a string as a mode. fromString :: (Exception.MonadThrow m) => String -> m Mode fromString s = case s of   "check" -> pure Check

@@ -5,8 +5,10 @@ import qualified Distribution.FieldGrammar.Newtypes as Newtypes import qualified Distribution.Parsec as Parsec +-- | A pragma, which is a special comment used to customize behavior. newtype Pragma-  = Discover FilePath+  = -- | Discover modules within the given directory.+    Discover FilePath   deriving (Eq, Show)  instance Parsec.Parsec Pragma where

@@ -15,6 +15,9 @@ import qualified Distribution.Pretty as Pretty import qualified Text.PrettyPrint as PrettyPrint +-- | A thin wrapper around 'Newtypes.Set''. This is used to define custom+-- instances of 'Pretty.Pretty' that use trailing commas when the Cabal spec+-- version is recent enough (at least @2.2@). newtype Set s b a = Set   { unwrap :: Newtypes.Set' s b a   }@@ -47,6 +50,8 @@       . Set.toAscList       . Newtype.unpack +-- | Overlaps the more general instance in order to use trailing commas when+-- possible. instance   {-# OVERLAPPING #-}   ( Newtype.Newtype a b,@@ -65,6 +70,8 @@       . Set.toAscList       . Newtype.unpack +-- | Overlaps the more general instance in order to use trailing commas when+-- possible. instance   {-# OVERLAPPING #-}   ( Newtype.Newtype a b,

@@ -9,22 +9,38 @@  import qualified CabalGild.Type.List as List import qualified CabalGild.Type.Set as Set+import qualified Distribution.CabalSpecVersion as CabalSpecVersion import qualified Distribution.Parsec as Parsec import qualified Distribution.Pretty as Pretty+import qualified Text.PrettyPrint as PrettyPrint -data SomeParsecParser-  = forall c s b a.-    (Parsec.Parsec (c s b a), Pretty.Pretty (c s b a)) =>-    SomeParsecParser (Parsec.ParsecParser (c s b a))+-- | This type bundles up a parser and a pretty printer for some type.+-- Typically they will just be monomorphic versions of 'Parsec.parsec' and+-- 'Pretty.prettyVersioned'.+data SomeParsecParser = forall a.+  SomeParsecParser+  { parsec :: Parsec.ParsecParser a,+    pretty :: CabalSpecVersion.CabalSpecVersion -> a -> PrettyPrint.Doc+  } +-- | Creates a new parser for the given 'List.List' of values. list ::   forall s b a.   (Parsec.Parsec (List.List s b a), Pretty.Pretty (List.List s b a)) =>   SomeParsecParser-list = SomeParsecParser $ Parsec.parsec @(List.List s b a)+list =+  SomeParsecParser+    { parsec = Parsec.parsec @(List.List s b a),+      pretty = Pretty.prettyVersioned+    } +-- | Creates a new parser for the given 'Set.Set' of values. set ::   forall s b a.   (Parsec.Parsec (Set.Set s b a), Pretty.Pretty (Set.Set s b a)) =>   SomeParsecParser-set = SomeParsecParser $ Parsec.parsec @(Set.Set s b a)+set =+  SomeParsecParser+    { parsec = Parsec.parsec @(Set.Set s b a),+      pretty = Pretty.prettyVersioned+    }

@@ -764,6 +764,45 @@     w `Hspec.shouldBe` []     s `Hspec.shouldBe` Map.singleton Nothing (String.toUtf8 "library\n  -- cabal-gild: discover .\n  other-modules: M\n") +  Hspec.it "discovers a nested module" $ do+    let (a, s, w) =+          runTest+            (Gild.mainWith "" [])+            ( Map.singleton Nothing (String.toUtf8 "library\n -- cabal-gild: discover .\n exposed-modules:"),+              Map.singleton (FilePath.combine "." ".") [FilePath.combine "N" "O.hs"]+            )+            Map.empty+    a `Hspec.shouldBe` Right ()+    w `Hspec.shouldBe` []+    s `Hspec.shouldBe` Map.singleton Nothing (String.toUtf8 "library\n  -- cabal-gild: discover .\n  exposed-modules: N.O\n")++  Hspec.it "discovers multiple modules" $ do+    let (a, s, w) =+          runTest+            (Gild.mainWith "" [])+            ( Map.singleton Nothing (String.toUtf8 "library\n -- cabal-gild: discover .\n exposed-modules:"),+              Map.singleton (FilePath.combine "." ".") ["M.hs", "N.hs"]+            )+            Map.empty+    a `Hspec.shouldBe` Right ()+    w `Hspec.shouldBe` []+    s `Hspec.shouldBe` Map.singleton Nothing (String.toUtf8 "library\n  -- cabal-gild: discover .\n  exposed-modules:\n    M\n    N\n")++  Hspec.it "ignores discover pragma separated by comment" $ do+    expectGilded+      "library\n -- cabal-gild: discover .\n -- foo\n exposed-modules: M"+      "library\n  -- cabal-gild: discover .\n  -- foo\n  exposed-modules: M\n"++  Hspec.it "ignores misplaced discover pragma" $ do+    expectGilded+      "-- cabal-gild: discover .\nname: p"+      "-- cabal-gild: discover .\nname: p\n"++  Hspec.it "ignores unknown pragma" $ do+    expectGilded+      "-- cabal-gild: unknown"+      "-- cabal-gild: unknown\n"+ expectGilded :: (Stack.HasCallStack) => String -> String -> Hspec.Expectation expectGilded input expected = do   let (a, s, w) =