cabal-gild 1.0.0.0 → 1.0.0.1
raw patch · 10 files changed
+398/−373 lines, 10 filesPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
API changes (from Hackage documentation)
- CabalGild.Action.Discover: field :: MonadWalk m => FilePath -> Field [Comment a] -> m (Field [Comment a])
- CabalGild.Action.Discover: fields :: MonadWalk m => FilePath -> [Field [Comment a]] -> m [Field [Comment a]]
- CabalGild.Action.Discover: hoistMaybe :: Applicative f => Maybe a -> MaybeT f a
- CabalGild.Action.Discover: relevantFieldNames :: Set FieldName
- CabalGild.Action.Discover: run :: MonadWalk m => FilePath -> ([Field [Comment a]], cs) -> m ([Field [Comment a]], cs)
- CabalGild.Action.Format: field :: Monoid cs => CabalSpecVersion -> Field cs -> Field cs
- CabalGild.Action.Format: fieldLines :: Monoid cs => CabalSpecVersion -> [FieldLine cs] -> SomeParsecParser -> [FieldLine cs]
- CabalGild.Action.Format: fields :: Monoid cs => CabalSpecVersion -> [Field cs] -> [Field cs]
- CabalGild.Action.Format: parsers :: Map FieldName SomeParsecParser
- CabalGild.Action.Format: run :: (Applicative m, Monoid cs) => CabalSpecVersion -> ([Field cs], cs) -> m ([Field cs], cs)
- CabalGild.Action.Format: style :: Style
- CabalGild.Action.Reindent: field :: Field (Position, [Comment Position]) -> Field (Position, [Comment Position])
- CabalGild.Action.Reindent: fieldLineToCol :: FieldLine (Position, cs) -> Int
- CabalGild.Action.Reindent: fieldLineToFirstRow :: FieldLine (Position, [Comment Position]) -> Int
- CabalGild.Action.Reindent: fieldLineToLastRow :: FieldLine (Position, cs) -> Int
- CabalGild.Action.Reindent: fieldLines :: Field (Position, [Comment Position]) -> [FieldLine (Position, [Comment Position])] -> [FieldLine (Position, [Comment Position])]
- CabalGild.Action.Reindent: fieldToRow :: Field (Position, cs) -> Int
- CabalGild.Action.Reindent: fields :: CabalSpecVersion -> [Field (Position, [Comment Position])] -> [Field (Position, [Comment Position])]
- CabalGild.Action.Reindent: fixCols :: Field (Position, [Comment Position]) -> [FieldLine (Position, [Comment Position])] -> [FieldLine (Position, [Comment Position])]
- CabalGild.Action.Reindent: fixRows :: [FieldLine (Position, [Comment Position])] -> [FieldLine (Position, [Comment Position])]
- CabalGild.Action.Reindent: reindent :: Int -> FieldLine (Position, cs) -> FieldLine (Position, cs)
- CabalGild.Action.Reindent: relevantFieldNames :: Set FieldName
- CabalGild.Action.Reindent: rowToFieldLine :: Int -> FieldLine (Position, [c])
- CabalGild.Action.Reindent: run :: Applicative m => CabalSpecVersion -> ([Field (Position, [Comment Position])], cs) -> m ([Field (Position, [Comment Position])], cs)
+ CabalGild.Action.EvaluatePragmas: field :: MonadWalk m => FilePath -> Field [Comment a] -> m (Field [Comment a])
+ CabalGild.Action.EvaluatePragmas: fields :: MonadWalk m => FilePath -> [Field [Comment a]] -> m [Field [Comment a]]
+ CabalGild.Action.EvaluatePragmas: hoistMaybe :: Applicative f => Maybe a -> MaybeT f a
+ CabalGild.Action.EvaluatePragmas: relevantFieldNames :: Set FieldName
+ CabalGild.Action.EvaluatePragmas: run :: MonadWalk m => FilePath -> ([Field [Comment a]], cs) -> m ([Field [Comment a]], cs)
+ CabalGild.Action.FormatFields: field :: Monoid cs => CabalSpecVersion -> Field cs -> Field cs
+ CabalGild.Action.FormatFields: fieldLines :: Monoid cs => CabalSpecVersion -> [FieldLine cs] -> SomeParsecParser -> [FieldLine cs]
+ CabalGild.Action.FormatFields: fields :: Monoid cs => CabalSpecVersion -> [Field cs] -> [Field cs]
+ CabalGild.Action.FormatFields: parsers :: Map FieldName SomeParsecParser
+ CabalGild.Action.FormatFields: run :: (Applicative m, Monoid cs) => CabalSpecVersion -> ([Field cs], cs) -> m ([Field cs], cs)
+ CabalGild.Action.FormatFields: style :: Style
+ CabalGild.Action.ReflowText: field :: Field (Position, [Comment Position]) -> Field (Position, [Comment Position])
+ CabalGild.Action.ReflowText: fieldLineToCol :: FieldLine (Position, cs) -> Int
+ CabalGild.Action.ReflowText: fieldLineToFirstRow :: FieldLine (Position, [Comment Position]) -> Int
+ CabalGild.Action.ReflowText: fieldLineToLastRow :: FieldLine (Position, cs) -> Int
+ CabalGild.Action.ReflowText: fieldLines :: Field (Position, [Comment Position]) -> [FieldLine (Position, [Comment Position])] -> [FieldLine (Position, [Comment Position])]
+ CabalGild.Action.ReflowText: fieldToRow :: Field (Position, cs) -> Int
+ CabalGild.Action.ReflowText: fields :: CabalSpecVersion -> [Field (Position, [Comment Position])] -> [Field (Position, [Comment Position])]
+ CabalGild.Action.ReflowText: fixCols :: Field (Position, [Comment Position]) -> [FieldLine (Position, [Comment Position])] -> [FieldLine (Position, [Comment Position])]
+ CabalGild.Action.ReflowText: fixRows :: [FieldLine (Position, [Comment Position])] -> [FieldLine (Position, [Comment Position])]
+ CabalGild.Action.ReflowText: reindent :: Int -> FieldLine (Position, cs) -> FieldLine (Position, cs)
+ CabalGild.Action.ReflowText: relevantFieldNames :: Set FieldName
+ CabalGild.Action.ReflowText: rowToFieldLine :: Int -> FieldLine (Position, [c])
+ CabalGild.Action.ReflowText: run :: Applicative m => CabalSpecVersion -> ([Field (Position, [Comment Position])], cs) -> m ([Field (Position, [Comment Position])], cs)
Files
- README.md +3/−0
- cabal-gild.cabal +4/−4
- source/library/CabalGild/Action/Discover.hs +0/−76
- source/library/CabalGild/Action/EvaluatePragmas.hs +77/−0
- source/library/CabalGild/Action/Format.hs +0/−156
- source/library/CabalGild/Action/FormatFields.hs +156/−0
- source/library/CabalGild/Action/ReflowText.hs +129/−0
- source/library/CabalGild/Action/Reindent.hs +0/−129
- source/library/CabalGild/Main.hs +19/−8
- source/test-suite/Main.hs +10/−0
README.md view
@@ -12,8 +12,11 @@ [cabal-gild-setup-action]: https://github.com/tfausak/cabal-gild-setup-action Gild started as a fork of [phadej/cabal-fmt][], but is now totally separate.+For a brief summary of the differences between Gild and `cabal-fmt`, read [the+announcement post][]. [phadej/cabal-fmt]: https://github.com/phadej/cabal-fmt+[the announcement post]: https://taylor.fausak.me/2024/02/17/gild/ ## Summary
cabal-gild.cabal view
@@ -11,7 +11,7 @@ maintainer: Taylor Fausak name: cabal-gild synopsis: Formats package descriptions.-version: 1.0.0.0+version: 1.0.0.1 source-repository head type: git@@ -69,11 +69,11 @@ -- cabal-gild: discover source/library exposed-modules: CabalGild.Action.AttachComments- CabalGild.Action.Discover+ CabalGild.Action.EvaluatePragmas CabalGild.Action.ExtractComments- CabalGild.Action.Format+ CabalGild.Action.FormatFields CabalGild.Action.GetCabalVersion- CabalGild.Action.Reindent+ CabalGild.Action.ReflowText CabalGild.Action.RemovePositions CabalGild.Action.Render CabalGild.Class.MonadLog
− source/library/CabalGild/Action/Discover.hs
@@ -1,76 +0,0 @@-module CabalGild.Action.Discover where--import qualified CabalGild.Class.MonadWalk as MonadWalk-import qualified CabalGild.Extra.ModuleName as ModuleName-import qualified CabalGild.Extra.Name as Name-import qualified CabalGild.Extra.String as String-import qualified CabalGild.Type.Comment as Comment-import qualified CabalGild.Type.Pragma as Pragma-import qualified Control.Monad as Monad-import qualified Control.Monad.Trans.Class as Trans-import qualified Control.Monad.Trans.Maybe as MaybeT-import qualified Data.Maybe as Maybe-import qualified Data.Set as Set-import qualified Distribution.Fields as Fields-import qualified Distribution.Parsec as Parsec-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 ::- (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 ::- (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 ::- (MonadWalk.MonadWalk m) =>- FilePath ->- Fields.Field [Comment.Comment a] ->- m (Fields.Field [Comment.Comment a])-field p f = case f of- 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- 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- . fmap (ModuleName.toFieldLine [])- . Maybe.mapMaybe (ModuleName.fromFilePath . FilePath.makeRelative d)- $ 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 $- fmap- String.toUtf8- [ "exposed-modules",- "other-modules"- ]---- | 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
+ source/library/CabalGild/Action/EvaluatePragmas.hs view
@@ -0,0 +1,77 @@+module CabalGild.Action.EvaluatePragmas where++import qualified CabalGild.Class.MonadWalk as MonadWalk+import qualified CabalGild.Extra.ModuleName as ModuleName+import qualified CabalGild.Extra.Name as Name+import qualified CabalGild.Extra.String as String+import qualified CabalGild.Type.Comment as Comment+import qualified CabalGild.Type.Pragma as Pragma+import qualified Control.Monad as Monad+import qualified Control.Monad.Trans.Class as Trans+import qualified Control.Monad.Trans.Maybe as MaybeT+import qualified Data.Maybe as Maybe+import qualified Data.Set as Set+import qualified Distribution.Fields as Fields+import qualified Distribution.Parsec as Parsec+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 ::+ (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++-- | Evaluates pragmas modules within the given fields.+fields ::+ (MonadWalk.MonadWalk m) =>+ FilePath ->+ [Fields.Field [Comment.Comment a]] ->+ m [Fields.Field [Comment.Comment a]]+fields = mapM . field++-- | Evaluates pragmas within the given field. Or, if the field is a section,+-- evaluates pragmas 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 ::+ (MonadWalk.MonadWalk m) =>+ FilePath ->+ Fields.Field [Comment.Comment a] ->+ m (Fields.Field [Comment.Comment a])+field p f = case f of+ 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+ 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+ . fmap (ModuleName.toFieldLine [])+ . Maybe.mapMaybe (ModuleName.fromFilePath . FilePath.makeRelative d)+ $ 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 $+ fmap+ String.toUtf8+ [ "exposed-modules",+ "other-modules"+ ]++-- | 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
− source/library/CabalGild/Action/Format.hs
@@ -1,156 +0,0 @@-{-# LANGUAGE TypeApplications #-}--module CabalGild.Action.Format where--import CabalGild.Compat.Cabal ()-import qualified CabalGild.Extra.FieldLine as FieldLine-import qualified CabalGild.Extra.Name as Name-import qualified CabalGild.Extra.String as String-import qualified CabalGild.Type.SomeParsecParser as SPP-import qualified Data.Functor.Identity as Identity-import qualified Data.Map as Map-import qualified Distribution.CabalSpecVersion as CabalSpecVersion-import qualified Distribution.FieldGrammar.Newtypes as Newtypes-import qualified Distribution.Fields as Fields-import qualified Distribution.ModuleName as ModuleName-import qualified Distribution.Parsec as Parsec-import qualified Distribution.Types.Dependency as Dependency-import qualified Distribution.Types.ExeDependency as ExeDependency-import qualified Distribution.Types.ForeignLibOption as ForeignLibOption-import qualified Distribution.Types.LegacyExeDependency as LegacyExeDependency-import qualified Distribution.Types.Mixin as Mixin-import qualified Distribution.Types.ModuleReexport as ModuleReexport-import qualified Distribution.Types.PkgconfigDependency as PkgconfigDependency-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 ->- ([Fields.Field cs], cs) ->- m ([Fields.Field cs], cs)-run csv (fs, cs) = pure (fields csv fs, cs)---- | A wrapper around 'field'.-fields ::- (Monoid cs) =>- CabalSpecVersion.CabalSpecVersion ->- [Fields.Field cs] ->- [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 ->- Fields.Field cs ->- Fields.Field cs-field csv f = case f of- Fields.Field n fls -> case Map.lookup (Name.value n) parsers of- Nothing -> f- 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 {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 csv r---- | This style attempts to force everything to be on its own line.-style :: PrettyPrint.Style-style =- 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 =- let (=:) :: String -> SPP.SomeParsecParser -> (Fields.FieldName, SPP.SomeParsecParser)- (=:) = (,) . String.toUtf8- in Map.fromList- [ "asm-options" =: SPP.list @Newtypes.NoCommaFSep @Newtypes.Token',- "asm-sources" =: SPP.set @Newtypes.VCat @Newtypes.FilePathNT,- "autogen-includes" =: SPP.set @Newtypes.FSep @Newtypes.FilePathNT,- "autogen-modules" =: SPP.set @Newtypes.VCat @(Newtypes.MQuoted ModuleName.ModuleName),- "build-depends" =: SPP.set @Newtypes.CommaVCat @(Identity.Identity Dependency.Dependency),- "build-tool-depends" =: SPP.set @Newtypes.CommaFSep @(Identity.Identity ExeDependency.ExeDependency),- "build-tools" =: SPP.set @Newtypes.CommaFSep @(Identity.Identity LegacyExeDependency.LegacyExeDependency),- "c-sources" =: SPP.set @Newtypes.VCat @Newtypes.FilePathNT,- "cc-options" =: SPP.list @Newtypes.NoCommaFSep @Newtypes.Token',- "cmm-options" =: SPP.list @Newtypes.NoCommaFSep @Newtypes.Token',- "cmm-sources" =: SPP.set @Newtypes.VCat @Newtypes.FilePathNT,- "code-generators" =: SPP.list @Newtypes.CommaFSep @Newtypes.Token,- "cpp-options" =: SPP.list @Newtypes.NoCommaFSep @Newtypes.Token',- "cxx-options" =: SPP.list @Newtypes.NoCommaFSep @Newtypes.Token',- "cxx-sources" =: SPP.set @Newtypes.VCat @Newtypes.FilePathNT,- "data-files" =: SPP.set @Newtypes.VCat @Newtypes.FilePathNT,- "default-extensions" =: SPP.set @Newtypes.FSep @(Newtypes.MQuoted Extension.Extension),- "exposed-modules" =: SPP.set @Newtypes.VCat @(Newtypes.MQuoted ModuleName.ModuleName),- "extensions" =: SPP.set @Newtypes.FSep @(Newtypes.MQuoted Extension.Extension),- "extra-bundled-libraries" =: SPP.set @Newtypes.VCat @Newtypes.Token,- "extra-doc-files" =: SPP.set @Newtypes.VCat @Newtypes.FilePathNT,- "extra-dynamic-library-flavours" =: SPP.set @Newtypes.VCat @Newtypes.Token,- "extra-framework-dirs" =: SPP.set @Newtypes.FSep @Newtypes.FilePathNT,- "extra-ghci-libraries" =: SPP.set @Newtypes.VCat @Newtypes.Token,- "extra-lib-dirs-static" =: SPP.set @Newtypes.FSep @Newtypes.FilePathNT,- "extra-lib-dirs" =: SPP.set @Newtypes.FSep @Newtypes.FilePathNT,- "extra-libraries-static" =: SPP.set @Newtypes.VCat @Newtypes.Token,- "extra-libraries" =: SPP.set @Newtypes.VCat @Newtypes.Token,- "extra-library-flavours" =: SPP.set @Newtypes.VCat @Newtypes.Token,- "extra-source-files" =: SPP.set @Newtypes.VCat @Newtypes.FilePathNT,- "extra-tmp-files" =: SPP.set @Newtypes.VCat @Newtypes.FilePathNT,- "frameworks" =: SPP.set @Newtypes.FSep @Newtypes.Token,- "ghc-options" =: SPP.list @Newtypes.NoCommaFSep @Newtypes.Token',- "ghc-prof-options" =: SPP.list @Newtypes.NoCommaFSep @Newtypes.Token',- "ghc-shared-options" =: SPP.list @Newtypes.NoCommaFSep @Newtypes.Token',- "ghcjs-options" =: SPP.list @Newtypes.NoCommaFSep @Newtypes.Token',- "ghcjs-prof-options" =: SPP.list @Newtypes.NoCommaFSep @Newtypes.Token',- "ghcjs-shared-options" =: SPP.list @Newtypes.NoCommaFSep @Newtypes.Token',- "hs-source-dirs" =: SPP.list @Newtypes.FSep @Newtypes.FilePathNT,- "hsc2hs-options" =: SPP.list @Newtypes.NoCommaFSep @Newtypes.Token',- "include-dirs" =: SPP.set @Newtypes.FSep @Newtypes.FilePathNT,- "includes" =: SPP.set @Newtypes.FSep @Newtypes.FilePathNT,- "install-includes" =: SPP.set @Newtypes.FSep @Newtypes.FilePathNT,- "js-sources" =: SPP.set @Newtypes.VCat @Newtypes.FilePathNT,- "ld-options" =: SPP.list @Newtypes.NoCommaFSep @Newtypes.Token',- "license-files" =: SPP.set @Newtypes.FSep @Newtypes.FilePathNT,- "mixins" =: SPP.set @Newtypes.CommaVCat @(Identity.Identity Mixin.Mixin),- "options" =: SPP.set @Newtypes.FSep @(Identity.Identity ForeignLibOption.ForeignLibOption),- "other-extensions" =: SPP.set @Newtypes.FSep @(Newtypes.MQuoted Extension.Extension),- "other-languages" =: SPP.set @Newtypes.FSep @(Newtypes.MQuoted Extension.Language),- "other-modules" =: SPP.set @Newtypes.VCat @(Newtypes.MQuoted ModuleName.ModuleName),- "pkgconfig-depends" =: SPP.set @Newtypes.CommaFSep @(Identity.Identity PkgconfigDependency.PkgconfigDependency),- "reexported-modules" =: SPP.set @Newtypes.CommaVCat @(Identity.Identity ModuleReexport.ModuleReexport),- "setup-depends" =: SPP.set @Newtypes.CommaVCat @(Identity.Identity Dependency.Dependency),- "signatures" =: SPP.set @Newtypes.VCat @(Newtypes.MQuoted ModuleName.ModuleName),- "tested-with" =: SPP.set @Newtypes.FSep @Newtypes.TestedWith,- "virtual-modules" =: SPP.set @Newtypes.VCat @(Newtypes.MQuoted ModuleName.ModuleName)- ]
+ source/library/CabalGild/Action/FormatFields.hs view
@@ -0,0 +1,156 @@+{-# LANGUAGE TypeApplications #-}++module CabalGild.Action.FormatFields where++import CabalGild.Compat.Cabal ()+import qualified CabalGild.Extra.FieldLine as FieldLine+import qualified CabalGild.Extra.Name as Name+import qualified CabalGild.Extra.String as String+import qualified CabalGild.Type.SomeParsecParser as SPP+import qualified Data.Functor.Identity as Identity+import qualified Data.Map as Map+import qualified Distribution.CabalSpecVersion as CabalSpecVersion+import qualified Distribution.FieldGrammar.Newtypes as Newtypes+import qualified Distribution.Fields as Fields+import qualified Distribution.ModuleName as ModuleName+import qualified Distribution.Parsec as Parsec+import qualified Distribution.Types.Dependency as Dependency+import qualified Distribution.Types.ExeDependency as ExeDependency+import qualified Distribution.Types.ForeignLibOption as ForeignLibOption+import qualified Distribution.Types.LegacyExeDependency as LegacyExeDependency+import qualified Distribution.Types.Mixin as Mixin+import qualified Distribution.Types.ModuleReexport as ModuleReexport+import qualified Distribution.Types.PkgconfigDependency as PkgconfigDependency+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 ->+ ([Fields.Field cs], cs) ->+ m ([Fields.Field cs], cs)+run csv (fs, cs) = pure (fields csv fs, cs)++-- | A wrapper around 'field'.+fields ::+ (Monoid cs) =>+ CabalSpecVersion.CabalSpecVersion ->+ [Fields.Field cs] ->+ [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 ->+ Fields.Field cs ->+ Fields.Field cs+field csv f = case f of+ Fields.Field n fls -> case Map.lookup (Name.value n) parsers of+ Nothing -> f+ 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 {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 csv r++-- | This style attempts to force everything to be on its own line.+style :: PrettyPrint.Style+style =+ 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 =+ let (=:) :: String -> SPP.SomeParsecParser -> (Fields.FieldName, SPP.SomeParsecParser)+ (=:) = (,) . String.toUtf8+ in Map.fromList+ [ "asm-options" =: SPP.list @Newtypes.NoCommaFSep @Newtypes.Token',+ "asm-sources" =: SPP.set @Newtypes.VCat @Newtypes.FilePathNT,+ "autogen-includes" =: SPP.set @Newtypes.FSep @Newtypes.FilePathNT,+ "autogen-modules" =: SPP.set @Newtypes.VCat @(Newtypes.MQuoted ModuleName.ModuleName),+ "build-depends" =: SPP.set @Newtypes.CommaVCat @(Identity.Identity Dependency.Dependency),+ "build-tool-depends" =: SPP.set @Newtypes.CommaFSep @(Identity.Identity ExeDependency.ExeDependency),+ "build-tools" =: SPP.set @Newtypes.CommaFSep @(Identity.Identity LegacyExeDependency.LegacyExeDependency),+ "c-sources" =: SPP.set @Newtypes.VCat @Newtypes.FilePathNT,+ "cc-options" =: SPP.list @Newtypes.NoCommaFSep @Newtypes.Token',+ "cmm-options" =: SPP.list @Newtypes.NoCommaFSep @Newtypes.Token',+ "cmm-sources" =: SPP.set @Newtypes.VCat @Newtypes.FilePathNT,+ "code-generators" =: SPP.list @Newtypes.CommaFSep @Newtypes.Token,+ "cpp-options" =: SPP.list @Newtypes.NoCommaFSep @Newtypes.Token',+ "cxx-options" =: SPP.list @Newtypes.NoCommaFSep @Newtypes.Token',+ "cxx-sources" =: SPP.set @Newtypes.VCat @Newtypes.FilePathNT,+ "data-files" =: SPP.set @Newtypes.VCat @Newtypes.FilePathNT,+ "default-extensions" =: SPP.set @Newtypes.FSep @(Newtypes.MQuoted Extension.Extension),+ "exposed-modules" =: SPP.set @Newtypes.VCat @(Newtypes.MQuoted ModuleName.ModuleName),+ "extensions" =: SPP.set @Newtypes.FSep @(Newtypes.MQuoted Extension.Extension),+ "extra-bundled-libraries" =: SPP.set @Newtypes.VCat @Newtypes.Token,+ "extra-doc-files" =: SPP.set @Newtypes.VCat @Newtypes.FilePathNT,+ "extra-dynamic-library-flavours" =: SPP.set @Newtypes.VCat @Newtypes.Token,+ "extra-framework-dirs" =: SPP.set @Newtypes.FSep @Newtypes.FilePathNT,+ "extra-ghci-libraries" =: SPP.set @Newtypes.VCat @Newtypes.Token,+ "extra-lib-dirs-static" =: SPP.set @Newtypes.FSep @Newtypes.FilePathNT,+ "extra-lib-dirs" =: SPP.set @Newtypes.FSep @Newtypes.FilePathNT,+ "extra-libraries-static" =: SPP.set @Newtypes.VCat @Newtypes.Token,+ "extra-libraries" =: SPP.set @Newtypes.VCat @Newtypes.Token,+ "extra-library-flavours" =: SPP.set @Newtypes.VCat @Newtypes.Token,+ "extra-source-files" =: SPP.set @Newtypes.VCat @Newtypes.FilePathNT,+ "extra-tmp-files" =: SPP.set @Newtypes.VCat @Newtypes.FilePathNT,+ "frameworks" =: SPP.set @Newtypes.FSep @Newtypes.Token,+ "ghc-options" =: SPP.list @Newtypes.NoCommaFSep @Newtypes.Token',+ "ghc-prof-options" =: SPP.list @Newtypes.NoCommaFSep @Newtypes.Token',+ "ghc-shared-options" =: SPP.list @Newtypes.NoCommaFSep @Newtypes.Token',+ "ghcjs-options" =: SPP.list @Newtypes.NoCommaFSep @Newtypes.Token',+ "ghcjs-prof-options" =: SPP.list @Newtypes.NoCommaFSep @Newtypes.Token',+ "ghcjs-shared-options" =: SPP.list @Newtypes.NoCommaFSep @Newtypes.Token',+ "hs-source-dirs" =: SPP.list @Newtypes.FSep @Newtypes.FilePathNT,+ "hsc2hs-options" =: SPP.list @Newtypes.NoCommaFSep @Newtypes.Token',+ "include-dirs" =: SPP.set @Newtypes.FSep @Newtypes.FilePathNT,+ "includes" =: SPP.set @Newtypes.FSep @Newtypes.FilePathNT,+ "install-includes" =: SPP.set @Newtypes.FSep @Newtypes.FilePathNT,+ "js-sources" =: SPP.set @Newtypes.VCat @Newtypes.FilePathNT,+ "ld-options" =: SPP.list @Newtypes.NoCommaFSep @Newtypes.Token',+ "license-files" =: SPP.set @Newtypes.FSep @Newtypes.FilePathNT,+ "mixins" =: SPP.set @Newtypes.CommaVCat @(Identity.Identity Mixin.Mixin),+ "options" =: SPP.set @Newtypes.FSep @(Identity.Identity ForeignLibOption.ForeignLibOption),+ "other-extensions" =: SPP.set @Newtypes.FSep @(Newtypes.MQuoted Extension.Extension),+ "other-languages" =: SPP.set @Newtypes.FSep @(Newtypes.MQuoted Extension.Language),+ "other-modules" =: SPP.set @Newtypes.VCat @(Newtypes.MQuoted ModuleName.ModuleName),+ "pkgconfig-depends" =: SPP.set @Newtypes.CommaFSep @(Identity.Identity PkgconfigDependency.PkgconfigDependency),+ "reexported-modules" =: SPP.set @Newtypes.CommaVCat @(Identity.Identity ModuleReexport.ModuleReexport),+ "setup-depends" =: SPP.set @Newtypes.CommaVCat @(Identity.Identity Dependency.Dependency),+ "signatures" =: SPP.set @Newtypes.VCat @(Newtypes.MQuoted ModuleName.ModuleName),+ "tested-with" =: SPP.set @Newtypes.FSep @Newtypes.TestedWith,+ "virtual-modules" =: SPP.set @Newtypes.VCat @(Newtypes.MQuoted ModuleName.ModuleName)+ ]
+ source/library/CabalGild/Action/ReflowText.hs view
@@ -0,0 +1,129 @@+module CabalGild.Action.ReflowText where++import qualified CabalGild.Extra.Field as Field+import qualified CabalGild.Extra.FieldLine as FieldLine+import qualified CabalGild.Extra.List as List+import qualified CabalGild.Extra.Name as Name+import qualified CabalGild.Extra.String as String+import qualified CabalGild.Type.Comment as Comment+import qualified Data.ByteString as ByteString+import qualified Data.Set as Set+import qualified Distribution.CabalSpecVersion as CabalSpecVersion+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 ->+ ([Fields.Field (Position.Position, [Comment.Comment Position.Position])], cs) ->+ m ([Fields.Field (Position.Position, [Comment.Comment 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+-- 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 =+ if csv >= CabalSpecVersion.CabalSpecV3_0+ then fmap field fs+ else fs++-- | Reflows 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 reflowed.+field ::+ Fields.Field (Position.Position, [Comment.Comment Position.Position]) ->+ Fields.Field (Position.Position, [Comment.Comment Position.Position])+field f = case f of+ Fields.Field n fls ->+ if Set.member (Name.value n) relevantFieldNames && List.compareLength fls 1 == GT+ then Fields.Field n $ fieldLines f fls+ else f+ Fields.Section n sas fs -> Fields.Section n sas $ fmap field fs++-- | The names of the fields that should be reflowed.+relevantFieldNames :: Set.Set Fields.FieldName+relevantFieldNames =+ Set.fromList $+ fmap+ String.toUtf8+ [ "description"+ ]++-- | 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])]+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])]+fixRows fls = case fls of+ x : y : zs ->+ x+ : fmap rowToFieldLine [fieldLineToLastRow x + 1 .. fieldLineToFirstRow y - 1]+ <> 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])] ->+ [Fields.FieldLine (Position.Position, [Comment.Comment Position.Position])]+fixCols f fls = case fls of+ [] -> fls+ x : xs ->+ let col = foldr (min . fieldLineToCol) (fieldLineToCol x) xs+ in if fieldToRow f == fieldLineToFirstRow x+ 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 =+ 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) ->+ Fields.FieldLine (Position.Position, cs)+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])+rowToFieldLine r = Fields.FieldLine (Position.Position r 1, []) ByteString.empty
− source/library/CabalGild/Action/Reindent.hs
@@ -1,129 +0,0 @@-module CabalGild.Action.Reindent where--import qualified CabalGild.Extra.Field as Field-import qualified CabalGild.Extra.FieldLine as FieldLine-import qualified CabalGild.Extra.List as List-import qualified CabalGild.Extra.Name as Name-import qualified CabalGild.Extra.String as String-import qualified CabalGild.Type.Comment as Comment-import qualified Data.ByteString as ByteString-import qualified Data.Set as Set-import qualified Distribution.CabalSpecVersion as CabalSpecVersion-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 ->- ([Fields.Field (Position.Position, [Comment.Comment Position.Position])], cs) ->- 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 =- 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])-field f = case f of- Fields.Field n fls ->- if Set.member (Name.value n) relevantFieldNames && List.compareLength fls 1 == GT- then Fields.Field n $ fieldLines f fls- 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 $- fmap- String.toUtf8- [ "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])]-fixRows fls = case fls of- x : y : zs ->- x- : fmap rowToFieldLine [fieldLineToLastRow x + 1 .. fieldLineToFirstRow y - 1]- <> 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])] ->- [Fields.FieldLine (Position.Position, [Comment.Comment Position.Position])]-fixCols f fls = case fls of- [] -> fls- x : xs ->- let col = foldr (min . fieldLineToCol) (fieldLineToCol x) xs- in if fieldToRow f == fieldLineToFirstRow x- 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 =- 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) ->- Fields.FieldLine (Position.Position, cs)-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])-rowToFieldLine r = Fields.FieldLine (Position.Position r 1, []) ByteString.empty
source/library/CabalGild/Main.hs view
@@ -2,11 +2,11 @@ module CabalGild.Main where import qualified CabalGild.Action.AttachComments as AttachComments-import qualified CabalGild.Action.Discover as Discover+import qualified CabalGild.Action.EvaluatePragmas as EvaluatePragmas import qualified CabalGild.Action.ExtractComments as ExtractComments-import qualified CabalGild.Action.Format as Format+import qualified CabalGild.Action.FormatFields as FormatFields import qualified CabalGild.Action.GetCabalVersion as GetCabalVersion-import qualified CabalGild.Action.Reindent as Reindent+import qualified CabalGild.Action.ReflowText as ReflowText import qualified CabalGild.Action.RemovePositions as RemovePositions import qualified CabalGild.Action.Render as Render import qualified CabalGild.Class.MonadLog as MonadLog@@ -20,6 +20,8 @@ import qualified CabalGild.Type.Mode as Mode import qualified Control.Monad as Monad import qualified Control.Monad.Catch as Exception+import qualified Data.ByteString as ByteString+import qualified Data.ByteString.Char8 as Latin1 import qualified Data.Maybe as Maybe import qualified Data.Version as Version import qualified Distribution.Fields as Fields@@ -89,16 +91,25 @@ comments = ExtractComments.fromByteString input output <- ( AttachComments.run- Monad.>=> Reindent.run csv+ Monad.>=> ReflowText.run csv Monad.>=> RemovePositions.run- Monad.>=> Discover.run (Maybe.fromMaybe (Config.stdin config) $ Config.input config)- Monad.>=> Format.run csv+ Monad.>=> EvaluatePragmas.run (Maybe.fromMaybe (Config.stdin config) $ Config.input config)+ Monad.>=> FormatFields.run csv Monad.>=> Render.run ) (fields, comments) case Config.mode config of- Mode.Check ->- Monad.when (output /= input) $+ Mode.Check -> do+ -- The input might have CRLF ("\r\n", 0x0d 0x0a) line endings, but the+ -- output will always have LF line endings. For the purposes of the check+ -- command, we'll consider the input formatted if it only differs from+ -- the output in line endings.+ let outputLines = Latin1.lines output+ stripCR x = case ByteString.unsnoc x of+ Just (y, 0x0d) -> y+ _ -> x+ inputLines = stripCR <$> Latin1.lines input+ Monad.when (outputLines /= inputLines) $ Exception.throwM CheckFailure.CheckFailure Mode.Format -> MonadWrite.write (Config.output config) output
source/test-suite/Main.hs view
@@ -81,6 +81,16 @@ w `Hspec.shouldBe` [] s `Hspec.shouldBe` Map.empty + Hspec.it "succeeds when checking CRLF input" $ do+ let (a, s, w) =+ runTest+ (Gild.mainWith "" ["--mode", "check"])+ (Map.singleton Nothing (String.toUtf8 "pass: yes\r\n"), Map.empty)+ Map.empty+ a `Hspec.shouldBe` Right ()+ w `Hspec.shouldBe` []+ s `Hspec.shouldBe` Map.empty+ Hspec.it "succeeds with empty input" $ do expectGilded ""