hpack 0.36.0 → 0.39.6
raw patch · 21 files changed
Files
- CHANGELOG.md +57/−12
- LICENSE +1/−1
- hpack.cabal +62/−59
- resources/test/hpack.cabal +62/−59
- src/Hpack/Config.hs +224/−124
- src/Hpack/Render.hs +145/−138
- src/Hpack/Render/Dsl.hs +69/−19
- src/Hpack/Render/Hints.hs +26/−11
- src/Hpack/Syntax/Dependencies.hs +11/−6
- src/Hpack/Syntax/DependencyVersion.hs +4/−0
- src/Hpack/Util.hs +4/−2
- src/Imports.hs +5/−0
- test/EndToEndSpec.hs +250/−41
- test/Hpack/ConfigSpec.hs +2/−2
- test/Hpack/DefaultsSpec.hs +0/−2
- test/Hpack/Render/DslSpec.hs +77/−5
- test/Hpack/Render/HintsSpec.hs +5/−4
- test/Hpack/RenderSpec.hs +20/−44
- test/Hpack/Syntax/DependenciesSpec.hs +3/−0
- test/Hpack/Syntax/GitSpec.hs +1/−1
- test/SpecHook.hs +8/−0
CHANGELOG.md view
@@ -1,20 +1,65 @@+## Changes in 0.39.6+ - Add support for top-level field `codeberg`++## Changes in 0.39.5+ - When rendering build dependencies in a Cabal file, Hpack no longer excludes+ the reference to the main library from the shorthand syntax such as+ `my-package:{my-package,my-library1,mylibrary2}`.++## Changes in 0.39.4+ - Remove upper on `crypton`++## Changes in 0.39.3+ - Add upper bound `crypton < 1.1`, as dependency `http-client-tls <= 0.3.6.4`+ does not support `crypton-1.1.0` but does not itself have an upper bound.++## Changes in 0.39.2+ - Depend on `cryptohash-sha256`, rather than `crypton`, for SHA256 hashes++## Changes in 0.39.1+ - Add support for `mhs-options` (MicroHs)++## Changes in 0.39.0+ - Handle multi-line values for the `description` field of `flags` (see #623) and other fields++## Changes in 0.38.3+ - Accept a list for `category` (see #624)++## Changes in 0.38.2+ - Infer `cabal-version: 3.12` when `PackageInfo_*` is used (see #620)++## Changes in 0.38.1+ - Add support for `extra-files` (see #603)+ - Preserve empty lines in `description` when `cabal-version >= 3` (see #612)++## Changes in 0.38.0+ - Generate `build-tool-depends` instead of `build-tools` starting with+ `cabal-version: 2` (fixes #596)++## Changes in 0.37.0+ - Add support for `asm-options` and `asm-sources` (see #573)++## Changes in 0.36.1+ - Allow `Cabal-3.12.*`+ - Support `base >= 4.20.0` (`Imports` does not re-export `Data.List.List`)+ ## Changes in 0.36.0- - Don't infer `Paths_`-module with `spec-version: 0.36.0` or later+ - Don't infer `Paths_`-module with `spec-version: 0.36.0` or later ## Changes in 0.35.5- - Add (undocumented) `list` command+ - Add (undocumented) `list` command ## Changes in 0.35.4- - Add `--canonical`, which can be used to produce canonical output instead of- trying to produce minimal diffs- - Avoid unnecessary writes on `--force` (see #555)- - When an existing `.cabal` does not align fields then do not align fields in- the generated `.cabal` file.- - Fix a bug related to git conflict markers in existing `.cabal` files: When a- `.cabal` file was essentially unchanged, but contained git conflict markers- then `hpack` did not write a new `.cabal` file at all. To address this- `hpack` now unconditionally writes a new `.cabal` file when the existing- `.cabal` file contains any git conflict markers.+ - Add `--canonical`, which can be used to produce canonical output instead of+ trying to produce minimal diffs+ - Avoid unnecessary writes on `--force` (see #555)+ - When an existing `.cabal` does not align fields then do not align fields in+ the generated `.cabal` file.+ - Fix a bug related to git conflict markers in existing `.cabal` files: When a+ `.cabal` file was essentially unchanged, but contained git conflict markers+ then `hpack` did not write a new `.cabal` file at all. To address this+ `hpack` now unconditionally writes a new `.cabal` file when the existing+ `.cabal` file contains any git conflict markers. ## Changes in 0.35.3 - Depend on `crypton` instead of `cryptonite`
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2014-2023 Simon Hengel <sol@typeful.net>+Copyright (c) 2014-2026 Simon Hengel <sol@typeful.net> Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal
hpack.cabal view
@@ -1,13 +1,13 @@ cabal-version: 2.0 --- This file has been generated from package.yaml by hpack version 0.36.0.+-- This file has been generated from package.yaml by hpack version 0.39.1. -- -- see: https://github.com/sol/hpack name: hpack-version: 0.36.0+version: 0.39.6 synopsis: A modern format for Haskell packages-description: See README at <https://github.com/sol/hpack#readme>+description: See the README at <https://github.com/sol/hpack#readme> category: Development homepage: https://github.com/sol/hpack#readme bug-reports: https://github.com/sol/hpack/issues@@ -17,41 +17,15 @@ license-file: LICENSE build-type: Simple extra-source-files:- CHANGELOG.md resources/test/hpack.cabal+extra-doc-files:+ CHANGELOG.md source-repository head type: git location: https://github.com/sol/hpack library- hs-source-dirs:- src- ghc-options: -Wall -fno-warn-incomplete-uni-patterns- build-depends:- Cabal >=3.0.0.0 && <3.11- , Glob >=0.9.0- , aeson >=1.4.3.0- , base >=4.13 && <5- , bifunctors- , bytestring- , containers- , crypton- , deepseq- , directory >=1.2.5.0- , filepath- , http-client- , http-client-tls >=0.3.6.2- , http-types- , infer-license >=0.2.0 && <0.3- , mtl- , pretty- , scientific- , text- , transformers- , unordered-containers- , vector- , yaml >=0.10.0 exposed-modules: Hpack Hpack.Config@@ -86,29 +60,21 @@ Paths_hpack autogen-modules: Paths_hpack- default-language: Haskell2010- if impl(ghc >= 9.4.5) && os(windows)- build-depends:- network >=3.1.2.9--executable hpack- main-is: Main.hs hs-source-dirs:- driver+ src ghc-options: -Wall -fno-warn-incomplete-uni-patterns build-depends:- Cabal >=3.0.0.0 && <3.11+ Cabal >=3.0.0.0 && <3.17 , Glob >=0.9.0 , aeson >=1.4.3.0 , base >=4.13 && <5 , bifunctors , bytestring , containers- , crypton+ , cryptohash-sha256 , deepseq , directory >=1.2.5.0 , filepath- , hpack , http-client , http-client-tls >=0.3.6.2 , http-types@@ -126,47 +92,44 @@ build-depends: network >=3.1.2.9 -test-suite spec- type: exitcode-stdio-1.0- main-is: Spec.hs+executable hpack+ main-is: Main.hs hs-source-dirs:- test- src+ driver ghc-options: -Wall -fno-warn-incomplete-uni-patterns- cpp-options: -DTEST build-depends:- Cabal >=3.0.0.0 && <3.11+ Cabal >=3.0.0.0 && <3.17 , Glob >=0.9.0- , HUnit >=1.6.0.0- , QuickCheck , aeson >=1.4.3.0 , base >=4.13 && <5 , bifunctors , bytestring , containers- , crypton+ , cryptohash-sha256 , deepseq , directory >=1.2.5.0 , filepath- , hspec ==2.*+ , hpack , http-client , http-client-tls >=0.3.6.2 , http-types , infer-license >=0.2.0 && <0.3- , interpolate- , mockery >=0.3 , mtl , pretty , scientific- , template-haskell- , temporary , text , transformers , unordered-containers , vector , yaml >=0.10.0- build-tool-depends:- hspec-discover:hspec-discover+ default-language: Haskell2010+ if impl(ghc >= 9.4.5) && os(windows)+ build-depends:+ network >=3.1.2.9++test-suite spec+ type: exitcode-stdio-1.0+ main-is: Spec.hs other-modules: Data.Aeson.Config.FromValueSpec Data.Aeson.Config.TypesSpec@@ -190,6 +153,7 @@ Hpack.Utf8Spec Hpack.UtilSpec HpackSpec+ SpecHook Data.Aeson.Config.FromValue Data.Aeson.Config.Key Data.Aeson.Config.KeyMap@@ -222,6 +186,45 @@ Paths_hpack autogen-modules: Paths_hpack+ hs-source-dirs:+ test+ src+ ghc-options: -Wall -fno-warn-incomplete-uni-patterns+ cpp-options: -DTEST+ build-tool-depends:+ hspec-discover:hspec-discover+ build-depends:+ Cabal >=3.0.0.0 && <3.17+ , Glob >=0.9.0+ , HUnit >=1.6.0.0+ , QuickCheck+ , aeson >=1.4.3.0+ , base >=4.13 && <5+ , bifunctors+ , bytestring+ , containers+ , cryptohash-sha256+ , deepseq+ , directory >=1.2.5.0+ , filepath+ , hspec ==2.*+ , http-client+ , http-client-tls >=0.3.6.2+ , http-types+ , infer-license >=0.2.0 && <0.3+ , interpolate+ , mockery >=0.3+ , mtl+ , pretty+ , scientific+ , template-haskell+ , temporary+ , text+ , transformers+ , unordered-containers+ , vcr+ , vector+ , yaml >=0.10.0 default-language: Haskell2010 if impl(ghc >= 9.4.5) && os(windows) build-depends:
resources/test/hpack.cabal view
@@ -1,13 +1,13 @@ cabal-version: 2.0 --- This file has been generated from package.yaml by hpack version 0.36.0.+-- This file has been generated from package.yaml by hpack version 0.39.1. -- -- see: https://github.com/sol/hpack name: hpack-version: 0.36.0+version: 0.39.6 synopsis: A modern format for Haskell packages-description: See README at <https://github.com/sol/hpack#readme>+description: See the README at <https://github.com/sol/hpack#readme> category: Development homepage: https://github.com/sol/hpack#readme bug-reports: https://github.com/sol/hpack/issues@@ -17,41 +17,15 @@ license-file: LICENSE build-type: Simple extra-source-files:- CHANGELOG.md resources/test/hpack.cabal+extra-doc-files:+ CHANGELOG.md source-repository head type: git location: https://github.com/sol/hpack library- hs-source-dirs:- src- ghc-options: -Wall -fno-warn-incomplete-uni-patterns- build-depends:- Cabal >=3.0.0.0 && <3.11- , Glob >=0.9.0- , aeson >=1.4.3.0- , base >=4.13 && <5- , bifunctors- , bytestring- , containers- , crypton- , deepseq- , directory >=1.2.5.0- , filepath- , http-client- , http-client-tls >=0.3.6.2- , http-types- , infer-license >=0.2.0 && <0.3- , mtl- , pretty- , scientific- , text- , transformers- , unordered-containers- , vector- , yaml >=0.10.0 exposed-modules: Hpack Hpack.Config@@ -86,29 +60,21 @@ Paths_hpack autogen-modules: Paths_hpack- default-language: Haskell2010- if impl(ghc >= 9.4.5) && os(windows)- build-depends:- network >=3.1.2.9--executable hpack- main-is: Main.hs hs-source-dirs:- driver+ src ghc-options: -Wall -fno-warn-incomplete-uni-patterns build-depends:- Cabal >=3.0.0.0 && <3.11+ Cabal >=3.0.0.0 && <3.17 , Glob >=0.9.0 , aeson >=1.4.3.0 , base >=4.13 && <5 , bifunctors , bytestring , containers- , crypton+ , cryptohash-sha256 , deepseq , directory >=1.2.5.0 , filepath- , hpack , http-client , http-client-tls >=0.3.6.2 , http-types@@ -126,47 +92,44 @@ build-depends: network >=3.1.2.9 -test-suite spec- type: exitcode-stdio-1.0- main-is: Spec.hs+executable hpack+ main-is: Main.hs hs-source-dirs:- test- src+ driver ghc-options: -Wall -fno-warn-incomplete-uni-patterns- cpp-options: -DTEST build-depends:- Cabal >=3.0.0.0 && <3.11+ Cabal >=3.0.0.0 && <3.17 , Glob >=0.9.0- , HUnit >=1.6.0.0- , QuickCheck , aeson >=1.4.3.0 , base >=4.13 && <5 , bifunctors , bytestring , containers- , crypton+ , cryptohash-sha256 , deepseq , directory >=1.2.5.0 , filepath- , hspec ==2.*+ , hpack , http-client , http-client-tls >=0.3.6.2 , http-types , infer-license >=0.2.0 && <0.3- , interpolate- , mockery >=0.3 , mtl , pretty , scientific- , template-haskell- , temporary , text , transformers , unordered-containers , vector , yaml >=0.10.0- build-tool-depends:- hspec-discover:hspec-discover+ default-language: Haskell2010+ if impl(ghc >= 9.4.5) && os(windows)+ build-depends:+ network >=3.1.2.9++test-suite spec+ type: exitcode-stdio-1.0+ main-is: Spec.hs other-modules: Data.Aeson.Config.FromValueSpec Data.Aeson.Config.TypesSpec@@ -190,6 +153,7 @@ Hpack.Utf8Spec Hpack.UtilSpec HpackSpec+ SpecHook Data.Aeson.Config.FromValue Data.Aeson.Config.Key Data.Aeson.Config.KeyMap@@ -222,6 +186,45 @@ Paths_hpack autogen-modules: Paths_hpack+ hs-source-dirs:+ test+ src+ ghc-options: -Wall -fno-warn-incomplete-uni-patterns+ cpp-options: -DTEST+ build-tool-depends:+ hspec-discover:hspec-discover+ build-depends:+ Cabal >=3.0.0.0 && <3.17+ , Glob >=0.9.0+ , HUnit >=1.6.0.0+ , QuickCheck+ , aeson >=1.4.3.0+ , base >=4.13 && <5+ , bifunctors+ , bytestring+ , containers+ , cryptohash-sha256+ , deepseq+ , directory >=1.2.5.0+ , filepath+ , hspec ==2.*+ , http-client+ , http-client-tls >=0.3.6.2+ , http-types+ , infer-license >=0.2.0 && <0.3+ , interpolate+ , mockery >=0.3+ , mtl+ , pretty+ , scientific+ , template-haskell+ , temporary+ , text+ , transformers+ , unordered-containers+ , vcr+ , vector+ , yaml >=0.10.0 default-language: Haskell2010 if impl(ghc >= 9.4.5) && os(windows) build-depends:
src/Hpack/Config.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-}@@ -41,6 +42,8 @@ , package , section , Package(..)+, CabalVersion(..)+, makeCabalVersion , Dependencies(..) , DependencyInfo(..) , VersionConstraint(..)@@ -67,6 +70,7 @@ , GhcProfOption , GhcjsOption , CppOption+, AsmOption , CcOption , LdOption , Path(..)@@ -103,7 +107,8 @@ import qualified Control.Monad.State as State import Control.Monad.Writer (MonadWriter, WriterT, runWriterT, tell) import Control.Monad.Except-import Data.Version (Version, makeVersion, showVersion)+import Data.Version (Version, showVersion)+import qualified Data.Version as Version import Distribution.Pretty (prettyShow) import qualified Distribution.SPDX.License as SPDX@@ -131,15 +136,19 @@ import qualified Paths_hpack as Hpack (version) +defaultCabalVersion :: Version+defaultCabalVersion = Version.makeVersion [1,12]+ package :: String -> String -> Package package name version = Package {- packageName = name+ packageCabalVersion = CabalVersion defaultCabalVersion+ , packageName = name , packageVersion = version , packageSynopsis = Nothing , packageDescription = Nothing , packageHomepage = Nothing , packageBugReports = Nothing- , packageCategory = Nothing+ , packageCategory = [] , packageStability = Nothing , packageAuthor = [] , packageMaintainer = []@@ -151,6 +160,7 @@ , packageFlags = [] , packageExtraSourceFiles = [] , packageExtraDocFiles = []+ , packageExtraFiles = [] , packageDataFiles = [] , packageDataDir = Nothing , packageSourceRepository = Nothing@@ -191,7 +201,7 @@ deps xs = [(name, info) | (name, info) <- (Map.toList . unDependencies . sectionDependencies) xs] section :: a -> Section a-section a = Section a [] mempty [] [] [] Nothing [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] Nothing [] mempty mempty []+section a = Section a [] mempty [] [] [] Nothing [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] Nothing [] mempty mempty [] packageConfig :: FilePath packageConfig = "package.yaml"@@ -271,19 +281,22 @@ Object _ -> VerbatimObject <$> fromValue v _ -> typeMismatch (formatOrList ["String", "Object"]) v -data CommonOptions cSources cxxSources jsSources a = CommonOptions {+data CommonOptions asmSources cSources cxxSources jsSources a = CommonOptions { commonOptionsSourceDirs :: Alias 'True "hs-source-dirs" (Maybe (List FilePath)) , commonOptionsDependencies :: Alias 'True "build-depends" (Maybe Dependencies) , commonOptionsPkgConfigDependencies :: Alias 'False "pkgconfig-depends" (Maybe (List String)) , commonOptionsDefaultExtensions :: Maybe (List String) , commonOptionsOtherExtensions :: Maybe (List String) , commonOptionsLanguage :: Alias 'True "default-language" (Last (Maybe Language))+, commonOptionsMhsOptions :: Maybe (List GhcOption) , commonOptionsGhcOptions :: Maybe (List GhcOption) , commonOptionsGhcProfOptions :: Maybe (List GhcProfOption) , commonOptionsGhcSharedOptions :: Maybe (List GhcOption) , commonOptionsGhcjsOptions :: Maybe (List GhcjsOption) , commonOptionsCppOptions :: Maybe (List CppOption) , commonOptionsCcOptions :: Maybe (List CcOption)+, commonOptionsAsmOptions :: Maybe (List AsmOption)+, commonOptionsAsmSources :: asmSources , commonOptionsCSources :: cSources , commonOptionsCxxOptions :: Maybe (List CxxOption) , commonOptionsCxxSources :: cxxSources@@ -296,16 +309,16 @@ , commonOptionsInstallIncludes :: Maybe (List FilePath) , commonOptionsLdOptions :: Maybe (List LdOption) , commonOptionsBuildable :: Last Bool-, commonOptionsWhen :: Maybe (List (ConditionalSection cSources cxxSources jsSources a))+, commonOptionsWhen :: Maybe (List (ConditionalSection asmSources cSources cxxSources jsSources a)) , commonOptionsBuildTools :: Alias 'True "build-tool-depends" (Maybe BuildTools) , commonOptionsSystemBuildTools :: Maybe SystemBuildTools , commonOptionsVerbatim :: Maybe (List Verbatim) } deriving (Functor, Generic) -type ParseCommonOptions = CommonOptions ParseCSources ParseCxxSources ParseJsSources+type ParseCommonOptions = CommonOptions ParseAsmSources ParseCSources ParseCxxSources ParseJsSources instance FromValue a => FromValue (ParseCommonOptions a) -instance (Semigroup cSources, Semigroup cxxSources, Semigroup jsSources, Monoid cSources, Monoid cxxSources, Monoid jsSources) => Monoid (CommonOptions cSources cxxSources jsSources a) where+instance (Semigroup asmSources, Semigroup cSources, Semigroup cxxSources, Semigroup jsSources, Monoid asmSources, Monoid cSources, Monoid cxxSources, Monoid jsSources) => Monoid (CommonOptions asmSources cSources cxxSources jsSources a) where mempty = CommonOptions { commonOptionsSourceDirs = Alias Nothing , commonOptionsDependencies = Alias Nothing@@ -313,11 +326,14 @@ , commonOptionsDefaultExtensions = Nothing , commonOptionsOtherExtensions = Nothing , commonOptionsLanguage = mempty+ , commonOptionsMhsOptions = Nothing , commonOptionsGhcOptions = Nothing , commonOptionsGhcProfOptions = Nothing , commonOptionsGhcSharedOptions = Nothing , commonOptionsGhcjsOptions = Nothing , commonOptionsCppOptions = Nothing+ , commonOptionsAsmOptions = Nothing+ , commonOptionsAsmSources = mempty , commonOptionsCcOptions = Nothing , commonOptionsCSources = mempty , commonOptionsCxxOptions = Nothing@@ -338,7 +354,7 @@ } mappend = (<>) -instance (Semigroup cSources, Semigroup cxxSources, Semigroup jsSources) => Semigroup (CommonOptions cSources cxxSources jsSources a) where+instance (Semigroup asmSources, Semigroup cSources, Semigroup cxxSources, Semigroup jsSources) => Semigroup (CommonOptions asmSources cSources cxxSources jsSources a) where a <> b = CommonOptions { commonOptionsSourceDirs = commonOptionsSourceDirs a <> commonOptionsSourceDirs b , commonOptionsDependencies = commonOptionsDependencies b <> commonOptionsDependencies a@@ -346,11 +362,14 @@ , commonOptionsDefaultExtensions = commonOptionsDefaultExtensions a <> commonOptionsDefaultExtensions b , commonOptionsOtherExtensions = commonOptionsOtherExtensions a <> commonOptionsOtherExtensions b , commonOptionsLanguage = commonOptionsLanguage a <> commonOptionsLanguage b+ , commonOptionsMhsOptions = commonOptionsMhsOptions a <> commonOptionsMhsOptions b , commonOptionsGhcOptions = commonOptionsGhcOptions a <> commonOptionsGhcOptions b , commonOptionsGhcProfOptions = commonOptionsGhcProfOptions a <> commonOptionsGhcProfOptions b , commonOptionsGhcSharedOptions = commonOptionsGhcSharedOptions a <> commonOptionsGhcSharedOptions b , commonOptionsGhcjsOptions = commonOptionsGhcjsOptions a <> commonOptionsGhcjsOptions b , commonOptionsCppOptions = commonOptionsCppOptions a <> commonOptionsCppOptions b+ , commonOptionsAsmOptions = commonOptionsAsmOptions a <> commonOptionsAsmOptions b+ , commonOptionsAsmSources = commonOptionsAsmSources a <> commonOptionsAsmSources b , commonOptionsCcOptions = commonOptionsCcOptions a <> commonOptionsCcOptions b , commonOptionsCSources = commonOptionsCSources a <> commonOptionsCSources b , commonOptionsCxxOptions = commonOptionsCxxOptions a <> commonOptionsCxxOptions b@@ -370,40 +389,45 @@ , commonOptionsVerbatim = commonOptionsVerbatim a <> commonOptionsVerbatim b } +type ParseAsmSources = Maybe (List FilePath) type ParseCSources = Maybe (List FilePath) type ParseCxxSources = Maybe (List FilePath) type ParseJsSources = Maybe (List FilePath) +type AsmSources = [Path] type CSources = [Path] type CxxSources = [Path] type JsSources = [Path] -type WithCommonOptions cSources cxxSources jsSources a = Product (CommonOptions cSources cxxSources jsSources a) a+type WithCommonOptions asmSources cSources cxxSources jsSources a = Product (CommonOptions asmSources cSources cxxSources jsSources a) a -data Traverse m cSources cSources_ cxxSources cxxSources_ jsSources jsSources_ = Traverse {- traverseCSources :: cSources -> m cSources_+data Traverse m asmSources asmSources_ cSources cSources_ cxxSources cxxSources_ jsSources jsSources_ = Traverse {+ traverseAsmSources :: asmSources -> m asmSources_+, traverseCSources :: cSources -> m cSources_ , traverseCxxSources :: cxxSources -> m cxxSources_ , traverseJsSources :: jsSources -> m jsSources_ } -type Traversal t = forall m cSources cSources_ cxxSources cxxSources_ jsSources jsSources_. Monad m- => Traverse m cSources cSources_ cxxSources cxxSources_ jsSources jsSources_- -> t cSources cxxSources jsSources- -> m (t cSources_ cxxSources_ jsSources_)+type Traversal t = forall m asmSources asmSources_ cSources cSources_ cxxSources cxxSources_ jsSources jsSources_. Monad m+ => Traverse m asmSources asmSources_ cSources cSources_ cxxSources cxxSources_ jsSources jsSources_+ -> t asmSources cSources cxxSources jsSources+ -> m (t asmSources_ cSources_ cxxSources_ jsSources_) -type Traversal_ t = forall m cSources cSources_ cxxSources cxxSources_ jsSources jsSources_ a. Monad m- => Traverse m cSources cSources_ cxxSources cxxSources_ jsSources jsSources_- -> t cSources cxxSources jsSources a- -> m (t cSources_ cxxSources_ jsSources_ a)+type Traversal_ t = forall m asmSources asmSources_ cSources cSources_ cxxSources cxxSources_ jsSources jsSources_ a. Monad m+ => Traverse m asmSources asmSources_ cSources cSources_ cxxSources cxxSources_ jsSources jsSources_+ -> t asmSources cSources cxxSources jsSources a+ -> m (t asmSources_ cSources_ cxxSources_ jsSources_ a) traverseCommonOptions :: Traversal_ CommonOptions traverseCommonOptions t@Traverse{..} c@CommonOptions{..} = do+ asmSources <- traverseAsmSources commonOptionsAsmSources cSources <- traverseCSources commonOptionsCSources cxxSources <- traverseCxxSources commonOptionsCxxSources jsSources <- traverseJsSources commonOptionsJsSources xs <- traverse (traverse (traverseConditionalSection t)) commonOptionsWhen return c {- commonOptionsCSources = cSources+ commonOptionsAsmSources = asmSources+ , commonOptionsCSources = cSources , commonOptionsCxxSources = cxxSources , commonOptionsJsSources = jsSources , commonOptionsWhen = xs@@ -423,16 +447,16 @@ traverseWithCommonOptions :: Traversal_ WithCommonOptions traverseWithCommonOptions t = bitraverse (traverseCommonOptions t) return -data ConditionalSection cSources cxxSources jsSources a =- ThenElseConditional (Product (ThenElse cSources cxxSources jsSources a) Condition)- | FlatConditional (Product (WithCommonOptions cSources cxxSources jsSources a) Condition)+data ConditionalSection asmSources cSources cxxSources jsSources a =+ ThenElseConditional (Product (ThenElse asmSources cSources cxxSources jsSources a) Condition)+ | FlatConditional (Product (WithCommonOptions asmSources cSources cxxSources jsSources a) Condition) -instance Functor (ConditionalSection cSources cxxSources jsSources) where+instance Functor (ConditionalSection asmSources cSources cxxSources jsSources) where fmap f = \ case ThenElseConditional c -> ThenElseConditional (first (fmap f) c) FlatConditional c -> FlatConditional (first (bimap (fmap f) f) c) -type ParseConditionalSection = ConditionalSection ParseCSources ParseCxxSources ParseJsSources+type ParseConditionalSection = ConditionalSection ParseAsmSources ParseCSources ParseCxxSources ParseJsSources instance FromValue a => FromValue (ParseConditionalSection a) where fromValue v@@ -486,17 +510,17 @@ Bool c -> return (CondBool c) _ -> typeMismatch "Boolean or String" v -data ThenElse cSources cxxSources jsSources a = ThenElse {- thenElseThen :: WithCommonOptions cSources cxxSources jsSources a-, thenElseElse :: WithCommonOptions cSources cxxSources jsSources a+data ThenElse asmSources cSources cxxSources jsSources a = ThenElse {+ thenElseThen :: WithCommonOptions asmSources cSources cxxSources jsSources a+, thenElseElse :: WithCommonOptions asmSources cSources cxxSources jsSources a } deriving Generic -instance Functor (ThenElse cSources cxxSources jsSources) where+instance Functor (ThenElse asmSources cSources cxxSources jsSources) where fmap f c@ThenElse{..} = c{thenElseThen = map_ thenElseThen, thenElseElse = map_ thenElseElse} where map_ = bimap (fmap f) f -type ParseThenElse = ThenElse ParseCSources ParseCxxSources ParseJsSources+type ParseThenElse = ThenElse ParseAsmSources ParseCSources ParseCxxSources ParseJsSources instance FromValue a => FromValue (ParseThenElse a) @@ -545,15 +569,15 @@ y : x : [] -> x ++ " or " ++ y x : ys@(_:_:_) -> intercalate ", " . reverse $ ("or " ++ x) : ys -type SectionConfigWithDefaults cSources cxxSources jsSources a = Product DefaultsConfig (WithCommonOptions cSources cxxSources jsSources a)+type SectionConfigWithDefaults asmSources cSources cxxSources jsSources a = Product DefaultsConfig (WithCommonOptions asmSources cSources cxxSources jsSources a) -type PackageConfigWithDefaults cSources cxxSources jsSources = PackageConfig_- (SectionConfigWithDefaults cSources cxxSources jsSources LibrarySection)- (SectionConfigWithDefaults cSources cxxSources jsSources ExecutableSection)+type PackageConfigWithDefaults asmSources cSources cxxSources jsSources = PackageConfig_+ (SectionConfigWithDefaults asmSources cSources cxxSources jsSources LibrarySection)+ (SectionConfigWithDefaults asmSources cSources cxxSources jsSources ExecutableSection) -type PackageConfig cSources cxxSources jsSources = PackageConfig_- (WithCommonOptions cSources cxxSources jsSources LibrarySection)- (WithCommonOptions cSources cxxSources jsSources ExecutableSection)+type PackageConfig asmSources cSources cxxSources jsSources = PackageConfig_+ (WithCommonOptions asmSources cSources cxxSources jsSources LibrarySection)+ (WithCommonOptions asmSources cSources cxxSources jsSources ExecutableSection) data PackageVersion = PackageVersion {unPackageVersion :: String} @@ -570,7 +594,7 @@ , packageConfigDescription :: Maybe String , packageConfigHomepage :: Maybe (Maybe String) , packageConfigBugReports :: Maybe (Maybe String)-, packageConfigCategory :: Maybe String+, packageConfigCategory :: Maybe (List String) , packageConfigStability :: Maybe String , packageConfigAuthor :: Maybe (List String) , packageConfigMaintainer :: Maybe (Maybe (List String))@@ -582,9 +606,11 @@ , packageConfigFlags :: Maybe (Map String FlagSection) , packageConfigExtraSourceFiles :: Maybe (List FilePath) , packageConfigExtraDocFiles :: Maybe (List FilePath)+, packageConfigExtraFiles :: Maybe (List FilePath) , packageConfigDataFiles :: Maybe (List FilePath) , packageConfigDataDir :: Maybe FilePath , packageConfigGithub :: Maybe GitHub+, packageConfigCodeberg :: Maybe GitHub , packageConfigGit :: Maybe String , packageConfigCustomSetup :: Maybe CustomSetupSection , packageConfigLibrary :: Maybe library@@ -632,7 +658,7 @@ where traverseNamedConfigs = traverse . traverse . traverseWithCommonOptions -type ParsePackageConfig = PackageConfigWithDefaults ParseCSources ParseCxxSources ParseJsSources+type ParsePackageConfig = PackageConfigWithDefaults ParseAsmSources ParseCSources ParseCxxSources ParseJsSources instance FromValue ParsePackageConfig @@ -686,8 +712,13 @@ userDataDir <- liftIO $ maybe (getAppUserDataDirectory "hpack") return mUserDataDir toPackage formatYamlParseError userDataDir dir config where- addCabalFile :: ((Package, String), [String]) -> DecodeResult- addCabalFile ((pkg, cabalVersion), warnings) = DecodeResult pkg cabalVersion (takeDirectory_ file </> (packageName pkg ++ ".cabal")) warnings+ addCabalFile :: (Package, [String]) -> DecodeResult+ addCabalFile (pkg, warnings) = DecodeResult {+ decodeResultPackage = pkg+ , decodeResultCabalVersion = "cabal-version: " ++ showCabalVersion (packageCabalVersion pkg) ++ "\n\n"+ , decodeResultCabalFile = takeDirectory_ file </> packageName pkg <.> "cabal"+ , decodeResultWarnings = warnings+ } takeDirectory_ :: FilePath -> FilePath takeDirectory_ p@@ -706,9 +737,9 @@ VerbatimBool b -> show b VerbatimNull -> "" -addPathsModuleToGeneratedModules :: Package -> Version -> Package-addPathsModuleToGeneratedModules pkg cabalVersion- | cabalVersion < makeVersion [2] = pkg+addPathsModuleToGeneratedModules :: Package -> Package+addPathsModuleToGeneratedModules pkg+ | packageCabalVersion pkg < makeCabalVersion [2] = pkg | otherwise = pkg { packageLibrary = fmap mapLibrary <$> packageLibrary pkg , packageInternalLibraries = fmap mapLibrary <$> packageInternalLibraries pkg@@ -737,22 +768,53 @@ where generatedModules = executableGeneratedModules executable -determineCabalVersion :: Maybe (License SPDX.License) -> Package -> (Package, String, Maybe Version)-determineCabalVersion inferredLicense pkg@Package{..} = (- pkg {- packageVerbatim = deleteVerbatimField "cabal-version" packageVerbatim- , packageLicense = formatLicense <$> license- }- , "cabal-version: " ++ effectiveCabalVersion ++ "\n\n"- , parseVersion effectiveCabalVersion- )+data CabalVersion = CabalVersion Version | VerbatimCabalVersion String+ deriving (Eq, Ord, Show)++makeCabalVersion :: [Int] -> CabalVersion+makeCabalVersion = CabalVersion . Version.makeVersion++showCabalVersion :: CabalVersion -> String+showCabalVersion = \ case+ CabalVersion v -> showVersion v+ VerbatimCabalVersion v -> v++extractVerbatimCabalVersion :: [Verbatim] -> (Maybe CabalVersion, [Verbatim])+extractVerbatimCabalVersion verbatim = case listToMaybe (mapMaybe extractCabalVersion verbatim) of+ Nothing -> (Nothing, verbatim)+ Just verbatimVersion -> (Just cabalVersion, deleteVerbatimField "cabal-version" verbatim)+ where+ cabalVersion :: CabalVersion+ cabalVersion = case parseVersion verbatimVersion of+ Nothing -> VerbatimCabalVersion verbatimVersion+ Just v -> CabalVersion v where- effectiveCabalVersion = fromMaybe inferredCabalVersion verbatimCabalVersion+ extractCabalVersion :: Verbatim -> Maybe String+ extractCabalVersion = \ case+ VerbatimLiteral _ -> Nothing+ VerbatimObject o -> case Map.lookup "cabal-version" o of+ Just v -> Just (verbatimValueToString v)+ Nothing -> Nothing +ensureRequiredCabalVersion :: Maybe (License SPDX.License) -> Package -> Package+ensureRequiredCabalVersion inferredLicense pkg@Package{..} = pkg {+ packageCabalVersion = version+ , packageLicense = formatLicense <$> license+ , packageVerbatim = verbatim+ }+ where+ makeVersion :: [Int] -> CabalVersion+ makeVersion = makeCabalVersion++ (verbatimCabalVersion, verbatim) = extractVerbatimCabalVersion packageVerbatim++ license :: Maybe (License String) license = fmap prettyShow <$> (parsedLicense <|> inferredLicense) + parsedLicense :: Maybe (License SPDX.License) parsedLicense = parseLicense <$> packageLicense + formatLicense :: License String -> String formatLicense = \ case MustSPDX spdx -> spdx CanSPDX _ spdx | version >= makeVersion [2,2] -> spdx@@ -767,21 +829,15 @@ CanSPDX _ _ -> False MustSPDX _ -> True - verbatimCabalVersion :: Maybe String- verbatimCabalVersion = listToMaybe (mapMaybe f packageVerbatim)- where- f :: Verbatim -> Maybe String- f = \ case- VerbatimLiteral _ -> Nothing- VerbatimObject o -> case Map.lookup "cabal-version" o of- Just v -> Just (verbatimValueToString v)- Nothing -> Nothing-- inferredCabalVersion :: String- inferredCabalVersion = showVersion version+ version :: CabalVersion+ version = fromMaybe inferredVersion verbatimCabalVersion - version = fromMaybe (makeVersion [1,12]) $ maximum [- packageCabalVersion+ inferredVersion :: CabalVersion+ inferredVersion = fromMaybe packageCabalVersion $ maximum [+ makeVersion [2,2] <$ guard mustSPDX+ , makeVersion [1,24] <$ packageCustomSetup+ , makeVersion [1,18] <$ guard (not (null packageExtraDocFiles))+ , makeVersion [3,14] <$ guard (not (null packageExtraFiles)) , packageLibrary >>= libraryCabalVersion , internalLibsCabalVersion packageInternalLibraries , executablesCabalVersion packageExecutables@@ -789,48 +845,59 @@ , executablesCabalVersion packageBenchmarks ] - packageCabalVersion :: Maybe Version- packageCabalVersion = maximum [- Nothing- , makeVersion [2,2] <$ guard mustSPDX- , makeVersion [1,24] <$ packageCustomSetup- , makeVersion [1,18] <$ guard (not (null packageExtraDocFiles))- ]-- libraryCabalVersion :: Section Library -> Maybe Version+ libraryCabalVersion :: Section Library -> Maybe CabalVersion libraryCabalVersion sect = maximum [ makeVersion [1,22] <$ guard (has libraryReexportedModules) , makeVersion [2,0] <$ guard (has librarySignatures) , makeVersion [2,0] <$ guard (has libraryGeneratedModules)+ , makeVersion [3,12] <$ guard (libraryHasPackageInfoModule sect) , makeVersion [3,0] <$ guard (has libraryVisibility) , sectionCabalVersion (concatMap getLibraryModules) sect ] where has field = any (not . null . field) sect - internalLibsCabalVersion :: Map String (Section Library) -> Maybe Version+ libraryHasPackageInfoModule :: Section Library -> Bool+ libraryHasPackageInfoModule =+ any (hasPackageInfoModule . libraryGeneratedModules)++ packageInfoModule :: Module+ packageInfoModule =+ Module ("PackageInfo_" ++ moduleNameFromPackageName packageName)++ hasPackageInfoModule :: [Module] -> Bool+ hasPackageInfoModule = any (== packageInfoModule)++ internalLibsCabalVersion :: Map String (Section Library) -> Maybe CabalVersion internalLibsCabalVersion internalLibraries | Map.null internalLibraries = Nothing | otherwise = foldr max (Just $ makeVersion [2,0]) versions where versions = libraryCabalVersion <$> Map.elems internalLibraries - executablesCabalVersion :: Map String (Section Executable) -> Maybe Version+ executablesCabalVersion :: Map String (Section Executable) -> Maybe CabalVersion executablesCabalVersion = foldr max Nothing . map executableCabalVersion . Map.elems - executableCabalVersion :: Section Executable -> Maybe Version+ executableCabalVersion :: Section Executable -> Maybe CabalVersion executableCabalVersion sect = maximum [ makeVersion [2,0] <$ guard (executableHasGeneratedModules sect)+ , makeVersion [3,12] <$ guard (executableHasPackageInfoModule sect) , sectionCabalVersion (concatMap getExecutableModules) sect ] executableHasGeneratedModules :: Section Executable -> Bool executableHasGeneratedModules = any (not . null . executableGeneratedModules) - sectionCabalVersion :: (Section a -> [Module]) -> Section a -> Maybe Version+ executableHasPackageInfoModule :: Section Executable -> Bool+ executableHasPackageInfoModule =+ any (hasPackageInfoModule . executableGeneratedModules)++ sectionCabalVersion :: (Section a -> [Module]) -> Section a -> Maybe CabalVersion sectionCabalVersion getMentionedModules sect = maximum $ [ makeVersion [2,2] <$ guard (sectionSatisfies (not . null . sectionCxxSources) sect) , makeVersion [2,2] <$ guard (sectionSatisfies (not . null . sectionCxxOptions) sect)+ , makeVersion [3,0] <$ guard (sectionSatisfies (not . null . sectionAsmOptions) sect)+ , makeVersion [3,0] <$ guard (sectionSatisfies (not . null . sectionAsmSources) sect) , makeVersion [2,0] <$ guard (sectionSatisfies (any hasMixins . unDependencies . sectionDependencies) sect) , makeVersion [3,0] <$ guard (sectionSatisfies (any hasSubcomponents . Map.keys . unDependencies . sectionDependencies) sect) , makeVersion [2,2] <$ guard (@@ -839,17 +906,23 @@ && pathsModule `elem` getMentionedModules sect) ] ++ map versionFromSystemBuildTool systemBuildTools where+ defaultExtensions :: [String] defaultExtensions = sectionAll sectionDefaultExtensions sect++ uses :: String -> Bool uses = (`elem` defaultExtensions) + pathsModule :: Module pathsModule = pathsModuleFromPackageName packageName + versionFromSystemBuildTool :: String -> Maybe CabalVersion versionFromSystemBuildTool name | name `elem` known_1_10 = Nothing | name `elem` known_1_14 = Just (makeVersion [1,14]) | name `elem` known_1_22 = Just (makeVersion [1,22]) | otherwise = Just (makeVersion [2,0]) + known_1_10 :: [String] known_1_10 = [ "ghc" , "ghc-pkg"@@ -877,9 +950,13 @@ , "lhc" , "lhc-pkg" ]++ known_1_14 :: [String] known_1_14 = [ "hpc" ]++ known_1_22 :: [String] known_1_22 = [ "ghcjs" , "ghcjs-pkg"@@ -952,13 +1029,14 @@ Nothing -> fail ("invalid value " ++ show s) data Package = Package {- packageName :: String+ packageCabalVersion :: CabalVersion+, packageName :: String , packageVersion :: String , packageSynopsis :: Maybe String , packageDescription :: Maybe String , packageHomepage :: Maybe String , packageBugReports :: Maybe String-, packageCategory :: Maybe String+, packageCategory :: [String] , packageStability :: Maybe String , packageAuthor :: [String] , packageMaintainer :: [String]@@ -970,6 +1048,7 @@ , packageFlags :: [Flag] , packageExtraSourceFiles :: [Path] , packageExtraDocFiles :: [Path]+, packageExtraFiles :: [Path] , packageDataFiles :: [Path] , packageDataDir :: Maybe FilePath , packageSourceRepository :: Maybe SourceRepository@@ -1013,11 +1092,14 @@ , sectionDefaultExtensions :: [String] , sectionOtherExtensions :: [String] , sectionLanguage :: Maybe Language+, sectionMhsOptions :: [GhcOption] , sectionGhcOptions :: [GhcOption] , sectionGhcProfOptions :: [GhcProfOption] , sectionGhcSharedOptions :: [GhcOption] , sectionGhcjsOptions :: [GhcjsOption] , sectionCppOptions :: [CppOption]+, sectionAsmOptions :: [AsmOption]+, sectionAsmSources :: [Path] , sectionCcOptions :: [CcOption] , sectionCSources :: [Path] , sectionCxxOptions :: [CxxOption]@@ -1064,20 +1146,20 @@ , sourceRepositorySubdir :: Maybe String } deriving (Eq, Show) -type Config cSources cxxSources jsSources =- Product (CommonOptions cSources cxxSources jsSources Empty) (PackageConfig cSources cxxSources jsSources)+type Config asmSources cSources cxxSources jsSources =+ Product (CommonOptions asmSources cSources cxxSources jsSources Empty) (PackageConfig asmSources cSources cxxSources jsSources) traverseConfig :: Traversal Config traverseConfig t = bitraverse (traverseCommonOptions t) (traversePackageConfig t) type ConfigWithDefaults = Product (CommonOptionsWithDefaults Empty)- (PackageConfigWithDefaults ParseCSources ParseCxxSources ParseJsSources)+ (PackageConfigWithDefaults ParseAsmSources ParseCSources ParseCxxSources ParseJsSources) -type CommonOptionsWithDefaults a = Product DefaultsConfig (CommonOptions ParseCSources ParseCxxSources ParseJsSources a)-type WithCommonOptionsWithDefaults a = Product DefaultsConfig (WithCommonOptions ParseCSources ParseCxxSources ParseJsSources a)+type CommonOptionsWithDefaults a = Product DefaultsConfig (CommonOptions ParseAsmSources ParseCSources ParseCxxSources ParseJsSources a)+type WithCommonOptionsWithDefaults a = Product DefaultsConfig (WithCommonOptions ParseAsmSources ParseCSources ParseCxxSources ParseJsSources a) -toPackage :: FormatYamlParseError -> FilePath -> FilePath -> ConfigWithDefaults -> ConfigM IO (Package, String)+toPackage :: FormatYamlParseError -> FilePath -> FilePath -> ConfigWithDefaults -> ConfigM IO Package toPackage formatYamlParseError userDataDir dir = expandDefaultsInConfig formatYamlParseError userDataDir dir >=> setDefaultLanguage "Haskell2010"@@ -1094,7 +1176,7 @@ -> FilePath -> FilePath -> ConfigWithDefaults- -> m (Config ParseCSources ParseCxxSources ParseJsSources)+ -> m (Config ParseAsmSources ParseCSources ParseCxxSources ParseJsSources) expandDefaultsInConfig formatYamlParseError userDataDir dir = bitraverse (expandGlobalDefaults formatYamlParseError userDataDir dir) (expandSectionDefaults formatYamlParseError userDataDir dir) expandGlobalDefaults@@ -1103,7 +1185,7 @@ -> FilePath -> FilePath -> CommonOptionsWithDefaults Empty- -> m (CommonOptions ParseCSources ParseCxxSources ParseJsSources Empty)+ -> m (CommonOptions ParseAsmSources ParseCSources ParseCxxSources ParseJsSources Empty) expandGlobalDefaults formatYamlParseError userDataDir dir = do fmap (`Product` Empty) >>> expandDefaults formatYamlParseError userDataDir dir >=> \ (Product c Empty) -> return c @@ -1112,8 +1194,8 @@ FormatYamlParseError -> FilePath -> FilePath- -> PackageConfigWithDefaults ParseCSources ParseCxxSources ParseJsSources- -> m (PackageConfig ParseCSources ParseCxxSources ParseJsSources)+ -> PackageConfigWithDefaults ParseAsmSources ParseCSources ParseCxxSources ParseJsSources+ -> m (PackageConfig ParseAsmSources ParseCSources ParseCxxSources ParseJsSources) expandSectionDefaults formatYamlParseError userDataDir dir p@PackageConfig{..} = do library <- traverse (expandDefaults formatYamlParseError userDataDir dir) packageConfigLibrary internalLibraries <- traverse (traverse (expandDefaults formatYamlParseError userDataDir dir)) packageConfigInternalLibraries@@ -1137,14 +1219,14 @@ -> FilePath -> FilePath -> WithCommonOptionsWithDefaults a- -> m (WithCommonOptions ParseCSources ParseCxxSources ParseJsSources a)+ -> m (WithCommonOptions ParseAsmSources ParseCSources ParseCxxSources ParseJsSources a) expandDefaults formatYamlParseError userDataDir = expand [] where expand :: [FilePath] -> FilePath -> WithCommonOptionsWithDefaults a- -> m (WithCommonOptions ParseCSources ParseCxxSources ParseJsSources a)+ -> m (WithCommonOptions ParseAsmSources ParseCSources ParseCxxSources ParseJsSources a) expand seen dir (Product DefaultsConfig{..} c) = do d <- mconcat <$> mapM (get seen dir) (fromMaybeList defaultsConfigDefaults) return (d <> c)@@ -1153,7 +1235,7 @@ [FilePath] -> FilePath -> Defaults- -> m (WithCommonOptions ParseCSources ParseCxxSources ParseJsSources a)+ -> m (WithCommonOptions ParseAsmSources ParseCSources ParseCxxSources ParseJsSources a) get seen dir defaults = do file <- liftIOEither (ensure userDataDir dir defaults) seen_ <- checkCycle seen file@@ -1177,25 +1259,25 @@ return $ Just (Map.fromList [(name, executable)]) Nothing -> return executables -type GlobalOptions = CommonOptions CSources CxxSources JsSources Empty+type GlobalOptions = CommonOptions AsmSources CSources CxxSources JsSources Empty -toPackage_ :: (MonadIO m, Warnings m, State m) => FilePath -> Product GlobalOptions (PackageConfig CSources CxxSources JsSources) -> m (Package, String)+toPackage_ :: (MonadIO m, Warnings m, State m) => FilePath -> Product GlobalOptions (PackageConfig AsmSources CSources CxxSources JsSources) -> m Package toPackage_ dir (Product g PackageConfig{..}) = do- executableMap <- toExecutableMap packageName_ packageConfigExecutables packageConfigExecutable+ executableMap <- toExecutableMap packageName packageConfigExecutables packageConfigExecutable let globalVerbatim = commonOptionsVerbatim g globalOptions = g {commonOptionsVerbatim = Nothing} executableNames = maybe [] Map.keys executableMap - toSect :: (Warnings m, Monoid a) => WithCommonOptions CSources CxxSources JsSources a -> m (Section a)- toSect = toSection packageName_ executableNames . first ((mempty <$ globalOptions) <>)+ toSect :: (Warnings m, Monoid a) => WithCommonOptions AsmSources CSources CxxSources JsSources a -> m (Section a)+ toSect = toSection packageName executableNames . first ((mempty <$ globalOptions) <>) - toSections :: (Warnings m, Monoid a) => Maybe (Map String (WithCommonOptions CSources CxxSources JsSources a)) -> m (Map String (Section a))+ toSections :: (Warnings m, Monoid a) => Maybe (Map String (WithCommonOptions AsmSources CSources CxxSources JsSources a)) -> m (Map String (Section a)) toSections = maybe (return mempty) (traverse toSect) - toLib = toLibrary dir packageName_- toExecutables = toSections >=> traverse (toExecutable dir packageName_)+ toLib = toLibrary dir packageName+ toExecutables = toSections >=> traverse (toExecutable dir packageName) mLibrary <- traverse (toSect >=> toLib) packageConfigLibrary internalLibraries <- toSections packageConfigInternalLibraries >>= traverse toLib@@ -1216,6 +1298,7 @@ extraSourceFiles <- expandGlobs "extra-source-files" dir (fromMaybeList packageConfigExtraSourceFiles) extraDocFiles <- expandGlobs "extra-doc-files" dir (fromMaybeList packageConfigExtraDocFiles)+ extraFiles <- expandGlobs "extra-files" dir (fromMaybeList packageConfigExtraFiles) let dataBaseDir = maybe dir (dir </>) packageConfigDataDir @@ -1241,13 +1324,14 @@ defaultBuildType = maybe Simple (const Custom) mCustomSetup pkg = Package {- packageName = packageName_+ packageCabalVersion = CabalVersion defaultCabalVersion+ , packageName , packageVersion = maybe "0.0.0" unPackageVersion packageConfigVersion , packageSynopsis = packageConfigSynopsis , packageDescription = packageConfigDescription , packageHomepage = homepage , packageBugReports = bugReports- , packageCategory = packageConfigCategory+ , packageCategory = fromMaybeList packageConfigCategory , packageStability = packageConfigStability , packageAuthor = fromMaybeList packageConfigAuthor , packageMaintainer = fromMaybeList maintainer@@ -1259,6 +1343,7 @@ , packageFlags = flags , packageExtraSourceFiles = extraSourceFiles , packageExtraDocFiles = extraDocFiles+ , packageExtraFiles = extraFiles , packageDataFiles = dataFiles , packageDataDir = packageConfigDataDir , packageSourceRepository = sourceRepository@@ -1274,12 +1359,11 @@ tell nameWarnings tell (formatMissingSourceDirs missingSourceDirs) - let (pkg_, renderedCabalVersion, cabalVersion) = determineCabalVersion inferredLicense pkg- return (maybe pkg_ (addPathsModuleToGeneratedModules pkg_) cabalVersion, renderedCabalVersion)+ return $ addPathsModuleToGeneratedModules $ ensureRequiredCabalVersion inferredLicense pkg where nameWarnings :: [String]- packageName_ :: String- (nameWarnings, packageName_) = case packageConfigName of+ packageName :: String+ (nameWarnings, packageName) = case packageConfigName of Nothing -> let inferredName = takeBaseName dir in (["Package name not specified, inferred " ++ show inferredName], inferredName) Just n -> ([], n)@@ -1297,7 +1381,7 @@ f name = "Specified source-dir " ++ show name ++ " does not exist" sourceRepository :: Maybe SourceRepository- sourceRepository = github <|> (`SourceRepository` Nothing) <$> packageConfigGit+ sourceRepository = codeberg <|> github <|> (`SourceRepository` Nothing) <$> packageConfigGit github :: Maybe SourceRepository github = toSourceRepository <$> packageConfigGithub@@ -1305,18 +1389,26 @@ toSourceRepository :: GitHub -> SourceRepository toSourceRepository (GitHub owner repo subdir) = SourceRepository (githubBaseUrl ++ owner ++ "/" ++ repo) subdir + codeberg :: Maybe SourceRepository+ codeberg = toSourceRepository <$> packageConfigCodeberg+ where+ toSourceRepository :: GitHub -> SourceRepository+ toSourceRepository (GitHub owner repo subdir) = SourceRepository (codebergBaseUrl ++ owner ++ "/" ++ repo) subdir+ homepage :: Maybe String homepage = case packageConfigHomepage of Just Nothing -> Nothing- _ -> join packageConfigHomepage <|> fromGithub+ _ -> join packageConfigHomepage <|> fromCodeberg <|> fromGithub where+ fromCodeberg = (++ "#readme") . sourceRepositoryUrl <$> codeberg fromGithub = (++ "#readme") . sourceRepositoryUrl <$> github bugReports :: Maybe String bugReports = case packageConfigBugReports of Just Nothing -> Nothing- _ -> join packageConfigBugReports <|> fromGithub+ _ -> join packageConfigBugReports <|> fromCodeberg <|> fromGithub where+ fromCodeberg = (++ "/issues") . sourceRepositoryUrl <$> codeberg fromGithub = (++ "/issues") . sourceRepositoryUrl <$> github maintainer :: Maybe (List String)@@ -1328,9 +1420,10 @@ expandForeignSources :: (MonadIO m, Warnings m) => FilePath- -> Traverse m ParseCSources CSources ParseCxxSources CxxSources ParseJsSources JsSources+ -> Traverse m ParseAsmSources AsmSources ParseCSources CSources ParseCxxSources CxxSources ParseJsSources JsSources expandForeignSources dir = Traverse {- traverseCSources = expand "c-sources"+ traverseAsmSources = expand "asm-sources"+ , traverseCSources = expand "c-sources" , traverseCxxSources = expand "cxx-sources" , traverseJsSources = expand "js-sources" }@@ -1401,7 +1494,7 @@ let pathsModule :: [Module] pathsModule = case specVersion of- SpecVersion v | v >= makeVersion [0,36,0] -> []+ SpecVersion v | v >= Version.makeVersion [0,36,0] -> [] _ -> [pathsModuleFromPackageName packageName_] removeConditionalsThatAreAlwaysFalse <$> traverseSectionAndConditionals@@ -1494,7 +1587,7 @@ , sectionConditionals = map (fmap flatten) sectionConditionals } -toSection :: forall a m. Warnings m => String -> [String] -> WithCommonOptions CSources CxxSources JsSources a -> m (Section a)+toSection :: forall a m. Warnings m => String -> [String] -> WithCommonOptions AsmSources CSources CxxSources JsSources a -> m (Section a) toSection packageName_ executableNames = go where go (Product CommonOptions{..} a) = do@@ -1509,11 +1602,14 @@ , sectionDefaultExtensions = fromMaybeList commonOptionsDefaultExtensions , sectionOtherExtensions = fromMaybeList commonOptionsOtherExtensions , sectionLanguage = join . getLast $ unAlias commonOptionsLanguage+ , sectionMhsOptions = fromMaybeList commonOptionsMhsOptions , sectionGhcOptions = fromMaybeList commonOptionsGhcOptions , sectionGhcProfOptions = fromMaybeList commonOptionsGhcProfOptions , sectionGhcSharedOptions = fromMaybeList commonOptionsGhcSharedOptions , sectionGhcjsOptions = fromMaybeList commonOptionsGhcjsOptions , sectionCppOptions = fromMaybeList commonOptionsCppOptions+ , sectionAsmOptions = fromMaybeList commonOptionsAsmOptions+ , sectionAsmSources = commonOptionsAsmSources , sectionCcOptions = fromMaybeList commonOptionsCcOptions , sectionCSources = commonOptionsCSources , sectionCxxOptions = fromMaybeList commonOptionsCxxOptions@@ -1540,7 +1636,7 @@ mkBuildTools = Map.fromList . rights - toConditional :: ConditionalSection CSources CxxSources JsSources a -> m (Conditional (Section a))+ toConditional :: ConditionalSection AsmSources CSources CxxSources JsSources a -> m (Conditional (Section a)) toConditional x = case x of ThenElseConditional (Product (ThenElse then_ else_) c) -> conditional c <$> go then_ <*> (Just <$> go else_) FlatConditional (Product sect c) -> conditional c <$> (go sect) <*> pure Nothing@@ -1591,10 +1687,14 @@ , "nix-build" ] warnLegacyTool pkg name = tell ["Usage of the unqualified build-tool name " ++ show name ++ " is deprecated! Please use the qualified name \"" ++ pkg ++ ":" ++ name ++ "\" instead!"]- warnLegacySystemTool name = tell ["Listing " ++ show name ++ " under build-tools is deperecated! Please list system executables under system-build-tools instead!"]+ warnLegacySystemTool name = tell ["Listing " ++ show name ++ " under build-tools is deprecated! Please list system executables under system-build-tools instead!"] pathsModuleFromPackageName :: String -> Module-pathsModuleFromPackageName name = Module ("Paths_" ++ map f name)- where- f '-' = '_'- f x = x+pathsModuleFromPackageName name =+ Module ("Paths_" ++ moduleNameFromPackageName name)++moduleNameFromPackageName :: String -> String+moduleNameFromPackageName = map f+ where+ f '-' = '_'+ f x = x
src/Hpack/Render.hs view
@@ -23,6 +23,7 @@ , Alignment(..) , CommaStyle(..) #ifdef TEST+, RenderEnv(..) , renderConditional , renderDependencies , renderLibraryFields@@ -30,7 +31,6 @@ , renderFlag , renderSourceRepository , renderDirectories-, formatDescription #endif ) where @@ -40,28 +40,47 @@ import Data.Maybe import Data.Map.Lazy (Map) import qualified Data.Map.Lazy as Map+import Control.Monad.Reader -import Hpack.Util import Hpack.Config import Hpack.Render.Hints-import Hpack.Render.Dsl hiding (sortFieldsBy)+import Hpack.Render.Dsl hiding (RenderSettings(..), defaultRenderSettings, sortFieldsBy) import qualified Hpack.Render.Dsl as Dsl +data RenderEnv = RenderEnv {+ renderEnvCabalVersion :: CabalVersion+, renderEnvPackageName :: String+}++type RenderM = Reader RenderEnv++getCabalVersion :: RenderM CabalVersion+getCabalVersion = asks renderEnvCabalVersion++getPackageName :: RenderM String+getPackageName = asks renderEnvPackageName+ renderPackage :: [String] -> Package -> String renderPackage oldCabalFile = renderPackageWith settings headerFieldsAlignment formattingHintsFieldOrder formattingHintsSectionsFieldOrder where- FormattingHints{..} = sniffFormattingHints oldCabalFile+ hints@FormattingHints{..} = sniffFormattingHints oldCabalFile headerFieldsAlignment = fromMaybe 16 formattingHintsAlignment- settings = formattingHintsRenderSettings+ settings = formattingHintsRenderSettings hints renderPackageWith :: RenderSettings -> Alignment -> [String] -> [(String, [String])] -> Package -> String-renderPackageWith settings headerFieldsAlignment existingFieldOrder sectionsFieldOrder Package{..} = intercalate "\n" (unlines header : chunks)+renderPackageWith RenderSettings{..} headerFieldsAlignment existingFieldOrder sectionsFieldOrder Package{..} = intercalate "\n" (unlines header : chunks) where+ settings :: Dsl.RenderSettings+ settings = Dsl.RenderSettings {+ renderSettingsEmptyLinesAsDot = packageCabalVersion < makeCabalVersion [3]+ , ..+ }+ chunks :: [String] chunks = map unlines . filter (not . null) . map (render settings 0) $ sortStanzaFields sectionsFieldOrder stanzas header :: [String]- header = concatMap (render settings {renderSettingsFieldAlignment = headerFieldsAlignment} 0) packageFields+ header = concatMap (render settings {Dsl.renderSettingsFieldAlignment = headerFieldsAlignment} 0) packageFields packageFields :: [Element] packageFields = addVerbatim packageVerbatim . sortFieldsBy existingFieldOrder $@@ -69,6 +88,7 @@ Field "tested-with" $ CommaSeparatedList packageTestedWith , Field "extra-source-files" (renderPaths packageExtraSourceFiles) , Field "extra-doc-files" (renderPaths packageExtraDocFiles)+ , Field "extra-files" (renderPaths packageExtraFiles) , Field "data-files" (renderPaths packageDataFiles) ] ++ maybe [] (return . Field "data-dir" . Literal) packageDataDir @@ -78,45 +98,52 @@ customSetup :: [Element] customSetup = maybe [] (return . renderCustomSetup) packageCustomSetup - library :: [Element]- library = maybe [] (return . renderLibrary) packageLibrary- stanzas :: [Element]- stanzas = concat [- sourceRepository- , customSetup- , map renderFlag packageFlags- , library- , renderInternalLibraries packageInternalLibraries- , renderExecutables packageExecutables- , renderTests packageTests- , renderBenchmarks packageBenchmarks- ]+ stanzas = flip runReader (RenderEnv packageCabalVersion packageName) $ do+ library <- maybe (return []) (fmap return . renderLibrary) packageLibrary+ internalLibraries <- renderInternalLibraries packageInternalLibraries+ executables <- renderExecutables packageExecutables+ tests <- renderTests packageTests+ benchmarks <- renderBenchmarks packageBenchmarks+ return $ concat [+ sourceRepository+ , customSetup+ , map renderFlag packageFlags+ , library+ , internalLibraries+ , executables+ , tests+ , benchmarks+ ] headerFields :: [Element] headerFields = mapMaybe (\(name, value) -> Field name . Literal <$> value) $ [ ("name", Just packageName) , ("version", Just packageVersion) , ("synopsis", packageSynopsis)- , ("description", (formatDescription headerFieldsAlignment <$> packageDescription))- , ("category", packageCategory)+ , ("description", packageDescription)+ , formatList "category" packageCategory , ("stability", packageStability) , ("homepage", packageHomepage) , ("bug-reports", packageBugReports)- , ("author", formatList packageAuthor)- , ("maintainer", formatList packageMaintainer)- , ("copyright", formatList packageCopyright)+ , formatList "author" packageAuthor+ , formatList "maintainer" packageMaintainer+ , formatList "copyright" packageCopyright , ("license", packageLicense) , case packageLicenseFile of [file] -> ("license-file", Just file)- files -> ("license-files", formatList files)+ files -> formatList "license-files" files , ("build-type", Just (show packageBuildType)) ] - formatList :: [String] -> Maybe String- formatList xs = guard (not $ null xs) >> (Just $ intercalate separator xs)+ formatList :: String -> [String] -> (String, Maybe String)+ formatList field = (,) field . formatValues where- separator = let Alignment n = headerFieldsAlignment in ",\n" ++ replicate n ' '+ formatValues :: [String] -> Maybe String+ formatValues values = guard (not $ null values) >> (Just $ intercalate separator values)+ where+ separator :: String+ separator = ",\n" sortStanzaFields :: [(String, [String])] -> [Element] -> [Element] sortStanzaFields sectionsFieldOrder = go@@ -126,20 +153,6 @@ Stanza name fields : xs | Just fieldOrder <- lookup name sectionsFieldOrder -> Stanza name (sortFieldsBy fieldOrder fields) : go xs x : xs -> x : go xs -formatDescription :: Alignment -> String -> String-formatDescription (Alignment alignment) description = case map emptyLineToDot $ lines description of- x : xs -> intercalate "\n" (x : map (indentation ++) xs)- [] -> ""- where- n = max alignment (length ("description: " :: String))- indentation = replicate n ' '-- emptyLineToDot xs- | isEmptyLine xs = "."- | otherwise = xs-- isEmptyLine = all isSpace- renderSourceRepository :: SourceRepository -> Element renderSourceRepository SourceRepository{..} = Stanza "source-repository head" [ Field "type" "git"@@ -155,37 +168,37 @@ where description = maybe [] (return . Field "description" . Literal) flagDescription -renderInternalLibraries :: Map String (Section Library) -> [Element]-renderInternalLibraries = map renderInternalLibrary . Map.toList+renderInternalLibraries :: Map String (Section Library) -> RenderM [Element]+renderInternalLibraries = traverse renderInternalLibrary . Map.toList -renderInternalLibrary :: (String, Section Library) -> Element-renderInternalLibrary (name, sect) =- Stanza ("library " ++ name) (renderLibrarySection sect)+renderInternalLibrary :: (String, Section Library) -> RenderM Element+renderInternalLibrary (name, sect) = do+ Stanza ("library " ++ name) <$> renderLibrarySection sect -renderExecutables :: Map String (Section Executable) -> [Element]-renderExecutables = map renderExecutable . Map.toList+renderExecutables :: Map String (Section Executable) -> RenderM [Element]+renderExecutables = traverse renderExecutable . Map.toList -renderExecutable :: (String, Section Executable) -> Element-renderExecutable (name, sect) =- Stanza ("executable " ++ name) (renderExecutableSection [] sect)+renderExecutable :: (String, Section Executable) -> RenderM Element+renderExecutable (name, sect) = do+ Stanza ("executable " ++ name) <$> renderExecutableSection [] sect -renderTests :: Map String (Section Executable) -> [Element]-renderTests = map renderTest . Map.toList+renderTests :: Map String (Section Executable) -> RenderM [Element]+renderTests = traverse renderTest . Map.toList -renderTest :: (String, Section Executable) -> Element-renderTest (name, sect) =- Stanza ("test-suite " ++ name)- (renderExecutableSection [Field "type" "exitcode-stdio-1.0"] sect)+renderTest :: (String, Section Executable) -> RenderM Element+renderTest (name, sect) = do+ Stanza ("test-suite " ++ name) <$>+ renderExecutableSection [Field "type" "exitcode-stdio-1.0"] sect -renderBenchmarks :: Map String (Section Executable) -> [Element]-renderBenchmarks = map renderBenchmark . Map.toList+renderBenchmarks :: Map String (Section Executable) -> RenderM [Element]+renderBenchmarks = traverse renderBenchmark . Map.toList -renderBenchmark :: (String, Section Executable) -> Element-renderBenchmark (name, sect) =- Stanza ("benchmark " ++ name)- (renderExecutableSection [Field "type" "exitcode-stdio-1.0"] sect)+renderBenchmark :: (String, Section Executable) -> RenderM Element+renderBenchmark (name, sect) = do+ Stanza ("benchmark " ++ name) <$>+ renderExecutableSection [Field "type" "exitcode-stdio-1.0"] sect -renderExecutableSection :: [Element] -> Section Executable -> [Element]+renderExecutableSection :: [Element] -> Section Executable -> RenderM [Element] renderExecutableSection extraFields = renderSection renderExecutableFields extraFields renderExecutableFields :: Executable -> [Element]@@ -199,10 +212,10 @@ renderCustomSetup CustomSetup{..} = Stanza "custom-setup" $ renderDependencies "setup-depends" customSetupDependencies -renderLibrary :: Section Library -> Element-renderLibrary sect = Stanza "library" $ renderLibrarySection sect+renderLibrary :: Section Library -> RenderM Element+renderLibrary sect = Stanza "library" <$> renderLibrarySection sect -renderLibrarySection :: Section Library -> [Element]+renderLibrarySection :: Section Library -> RenderM [Element] renderLibrarySection = renderSection renderLibraryFields [] renderLibraryFields :: Library -> [Element]@@ -222,37 +235,44 @@ renderVisibility :: String -> Element renderVisibility = Field "visibility" . Literal -renderSection :: (a -> [Element]) -> [Element] -> Section a -> [Element]-renderSection renderSectionData extraFieldsStart Section{..} = addVerbatim sectionVerbatim $- extraFieldsStart- ++ renderSectionData sectionData ++ [- renderDirectories "hs-source-dirs" sectionSourceDirs- , renderDefaultExtensions sectionDefaultExtensions- , renderOtherExtensions sectionOtherExtensions- , renderGhcOptions sectionGhcOptions- , renderGhcProfOptions sectionGhcProfOptions- , renderGhcSharedOptions sectionGhcSharedOptions- , renderGhcjsOptions sectionGhcjsOptions- , renderCppOptions sectionCppOptions- , renderCcOptions sectionCcOptions- , renderCxxOptions sectionCxxOptions- , renderDirectories "include-dirs" sectionIncludeDirs- , Field "install-includes" (LineSeparatedList sectionInstallIncludes)- , Field "c-sources" (renderPaths sectionCSources)- , Field "cxx-sources" (renderPaths sectionCxxSources)- , Field "js-sources" (renderPaths sectionJsSources)- , renderDirectories "extra-lib-dirs" sectionExtraLibDirs- , Field "extra-libraries" (LineSeparatedList sectionExtraLibraries)- , renderDirectories "extra-frameworks-dirs" sectionExtraFrameworksDirs- , Field "frameworks" (LineSeparatedList sectionFrameworks)- , renderLdOptions sectionLdOptions- , Field "pkgconfig-depends" (CommaSeparatedList sectionPkgConfigDependencies)- ]- ++ renderBuildTools sectionBuildTools sectionSystemBuildTools- ++ renderDependencies "build-depends" sectionDependencies- ++ maybe [] (return . renderBuildable) sectionBuildable- ++ maybe [] (return . renderLanguage) sectionLanguage- ++ map (renderConditional renderSectionData) sectionConditionals+renderSection :: (a -> [Element]) -> [Element] -> Section a -> RenderM [Element]+renderSection renderSectionData extraFieldsStart Section{..} = do+ buildTools <- renderBuildTools sectionBuildTools sectionSystemBuildTools+ conditionals <- traverse (renderConditional renderSectionData) sectionConditionals+ return . addVerbatim sectionVerbatim $+ extraFieldsStart+ ++ renderSectionData sectionData+ ++ [+ renderDirectories "hs-source-dirs" sectionSourceDirs+ , renderDefaultExtensions sectionDefaultExtensions+ , renderOtherExtensions sectionOtherExtensions+ , Field "mhs-options" $ WordList sectionMhsOptions+ , Field "ghc-options" $ WordList sectionGhcOptions+ , Field "ghc-prof-options" $ WordList sectionGhcProfOptions+ , Field "ghc-shared-options" $ WordList sectionGhcSharedOptions+ , Field "ghcjs-options" $ WordList sectionGhcjsOptions+ , Field "cpp-options" $ WordList sectionCppOptions+ , Field "asm-options" $ WordList sectionAsmOptions+ , Field "cc-options" $ WordList sectionCcOptions+ , Field "cxx-options" $ WordList sectionCxxOptions+ , renderDirectories "include-dirs" sectionIncludeDirs+ , Field "install-includes" (LineSeparatedList sectionInstallIncludes)+ , Field "asm-sources" (renderPaths sectionAsmSources)+ , Field "c-sources" (renderPaths sectionCSources)+ , Field "cxx-sources" (renderPaths sectionCxxSources)+ , Field "js-sources" (renderPaths sectionJsSources)+ , renderDirectories "extra-lib-dirs" sectionExtraLibDirs+ , Field "extra-libraries" (LineSeparatedList sectionExtraLibraries)+ , renderDirectories "extra-frameworks-dirs" sectionExtraFrameworksDirs+ , Field "frameworks" (LineSeparatedList sectionFrameworks)+ , Field "ld-options" $ WordList sectionLdOptions+ , Field "pkgconfig-depends" (CommaSeparatedList sectionPkgConfigDependencies)+ ]+ ++ buildTools+ ++ renderDependencies "build-depends" sectionDependencies+ ++ maybe [] (return . renderBuildable) sectionBuildable+ ++ maybe [] (return . renderLanguage) sectionLanguage+ ++ conditionals addVerbatim :: [Verbatim] -> [Element] -> [Element] addVerbatim verbatim fields = filterVerbatim verbatim fields ++ renderVerbatim verbatim@@ -283,12 +303,12 @@ [x] -> Field key (Literal x) xs -> Field key (LineSeparatedList xs) -renderConditional :: (a -> [Element]) -> Conditional (Section a) -> Element+renderConditional :: (a -> [Element]) -> Conditional (Section a) -> RenderM Element renderConditional renderSectionData (Conditional condition sect mElse) = case mElse of Nothing -> if_- Just else_ -> Group if_ (Stanza "else" $ renderSection renderSectionData [] else_)+ Just else_ -> Group <$> if_ <*> (Stanza "else" <$> renderSection renderSectionData [] else_) where- if_ = Stanza ("if " ++ renderCond condition) (renderSection renderSectionData [] sect)+ if_ = Stanza ("if " ++ renderCond condition) <$> renderSection renderSectionData [] sect renderCond :: Cond -> String renderCond = \ case@@ -341,21 +361,32 @@ AnyVersion -> "" VersionRange x -> " " ++ x -renderBuildTools :: Map BuildTool DependencyVersion -> SystemBuildTools -> [Element]-renderBuildTools (map renderBuildTool . Map.toList -> xs) systemBuildTools = [- Field "build-tools" (CommaSeparatedList $ [x | BuildTools x <- xs] ++ renderSystemBuildTools systemBuildTools)- , Field "build-tool-depends" (CommaSeparatedList [x | BuildToolDepends x <- xs])- ]+renderBuildTools :: Map BuildTool DependencyVersion -> SystemBuildTools -> RenderM [Element]+renderBuildTools buildTools systemBuildTools = do+ xs <- traverse renderBuildTool $ Map.toList buildTools+ return [+ Field "build-tools" $ CommaSeparatedList $ [x | BuildTools x <- xs] ++ renderSystemBuildTools systemBuildTools+ , Field "build-tool-depends" $ CommaSeparatedList [x | BuildToolDepends x <- xs]+ ] data RenderBuildTool = BuildTools String | BuildToolDepends String -renderBuildTool :: (BuildTool, DependencyVersion) -> RenderBuildTool-renderBuildTool (buildTool, renderVersion -> version) = case buildTool of- LocalBuildTool executable -> BuildTools (executable ++ version)- BuildTool pkg executable- | pkg == executable && executable `elem` knownBuildTools -> BuildTools (executable ++ version)- | otherwise -> BuildToolDepends (pkg ++ ":" ++ executable ++ version)+renderBuildTool :: (BuildTool, DependencyVersion) -> RenderM RenderBuildTool+renderBuildTool (buildTool, renderVersion -> version) = do+ cabalVersion <- getCabalVersion+ packageName <- getPackageName+ let supportsBuildTools = cabalVersion < makeCabalVersion [2]+ return $ case buildTool of+ LocalBuildTool executable+ | supportsBuildTools -> BuildTools (executable ++ version)+ | otherwise -> BuildToolDepends (packageName ++ ":" ++ executable ++ version)+ BuildTool pkg executable+ | supportsBuildTools && isknownBuildTool pkg executable -> BuildTools (executable ++ version)+ | otherwise -> BuildToolDepends (pkg ++ ":" ++ executable ++ version) where+ isknownBuildTool :: String -> String -> Bool+ isknownBuildTool pkg executable = pkg == executable && executable `elem` knownBuildTools+ knownBuildTools :: [String] knownBuildTools = [ "alex"@@ -376,30 +407,6 @@ renderLanguage :: Language -> Element renderLanguage (Language lang) = Field "default-language" (Literal lang)--renderGhcOptions :: [GhcOption] -> Element-renderGhcOptions = Field "ghc-options" . WordList--renderGhcProfOptions :: [GhcProfOption] -> Element-renderGhcProfOptions = Field "ghc-prof-options" . WordList--renderGhcSharedOptions :: [GhcOption] -> Element-renderGhcSharedOptions = Field "ghc-shared-options" . WordList--renderGhcjsOptions :: [GhcjsOption] -> Element-renderGhcjsOptions = Field "ghcjs-options" . WordList--renderCppOptions :: [CppOption] -> Element-renderCppOptions = Field "cpp-options" . WordList--renderCcOptions :: [CcOption] -> Element-renderCcOptions = Field "cc-options" . WordList--renderCxxOptions :: [CxxOption] -> Element-renderCxxOptions = Field "cxx-options" . WordList--renderLdOptions :: [LdOption] -> Element-renderLdOptions = Field "ld-options" . WordList renderBuildable :: Bool -> Element renderBuildable = Field "buildable" . Literal . show
src/Hpack/Render/Dsl.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} module Hpack.Render.Dsl (@@ -19,13 +20,18 @@ #ifdef TEST , Lines (..)+, IndentOrAlign (..) , renderValue , addSortKey #endif ) where import Imports+import Data.Char (isSpace) +data Element = Stanza String [Element] | Group Element Element | Field String Value | Verbatim String+ deriving (Eq, Show)+ data Value = Literal String | CommaSeparatedList [String]@@ -33,10 +39,26 @@ | WordList [String] deriving (Eq, Show) -data Element = Stanza String [Element] | Group Element Element | Field String Value | Verbatim String+data Lines = SingleLine String | MultipleLines IndentOrAlign [String] deriving (Eq, Show) -data Lines = SingleLine String | MultipleLines [String]+data IndentOrAlign =+ Indent+ -- ^+ -- Indent lines, e.g.+ --+ -- description:+ -- some+ -- multiline+ -- description+ |+ Align+ -- ^+ -- Align lines with field labels, e.g.+ --+ -- description: some+ -- multiline+ -- description deriving (Eq, Show) data CommaStyle = LeadingCommas | TrailingCommas@@ -46,52 +68,78 @@ deriving (Eq, Show, Num, Enum) newtype Alignment = Alignment Int- deriving (Eq, Show, Num)+ deriving (Eq, Ord, Show, Num) data RenderSettings = RenderSettings { renderSettingsIndentation :: Int , renderSettingsFieldAlignment :: Alignment , renderSettingsCommaStyle :: CommaStyle+, renderSettingsEmptyLinesAsDot :: Bool } deriving (Eq, Show) defaultRenderSettings :: RenderSettings-defaultRenderSettings = RenderSettings 2 0 LeadingCommas+defaultRenderSettings = RenderSettings 2 0 LeadingCommas True render :: RenderSettings -> Nesting -> Element -> [String]-render settings nesting (Stanza name elements) = indent settings nesting name : renderElements settings (succ nesting) elements-render settings nesting (Group a b) = render settings nesting a ++ render settings nesting b-render settings nesting (Field name value) = renderField settings nesting name value-render settings nesting (Verbatim str) = map (indent settings nesting) (lines str)+render settings nesting = \ case+ Stanza name elements -> indent settings nesting name : renderElements settings (succ nesting) elements+ Group a b -> render settings nesting a ++ render settings nesting b+ Field name value -> map (indent settings nesting) $ renderField settings name value+ Verbatim str -> map (indent settings nesting) (lines str) renderElements :: RenderSettings -> Nesting -> [Element] -> [String] renderElements settings nesting = concatMap (render settings nesting) -renderField :: RenderSettings -> Nesting -> String -> Value -> [String]-renderField settings@RenderSettings{..} nesting name value = case renderValue settings value of+renderField :: RenderSettings -> String -> Value -> [String]+renderField settings@RenderSettings{..} name = renderValue settings >>> \ case SingleLine "" -> []- SingleLine x -> [indent settings nesting (name ++ ": " ++ padding ++ x)]- MultipleLines [] -> []- MultipleLines xs -> (indent settings nesting name ++ ":") : map (indent settings $ succ nesting) xs+ SingleLine value -> [fieldName ++ value]+ MultipleLines _ [] -> []+ MultipleLines Indent values -> (name ++ ":") : map (indent settings 1) values+ MultipleLines Align (value : values) -> (fieldName ++ value) : map align values where Alignment fieldAlignment = renderSettingsFieldAlignment- padding = replicate (fieldAlignment - length name - 2) ' ' + fieldName :: String+ fieldName = name ++ ": " ++ fieldNamePadding++ fieldNamePadding :: String+ fieldNamePadding = replicate (fieldAlignment - length name - 2) ' '++ align :: String -> String+ align = \ case+ "" -> ""+ value -> padding ++ value++ padding :: String+ padding = replicate (length fieldName) ' '+ renderValue :: RenderSettings -> Value -> Lines-renderValue RenderSettings{..} v = case v of- Literal s -> SingleLine s+renderValue RenderSettings{..} = \ case+ Literal string -> case lines string of+ [value] -> SingleLine value+ values -> MultipleLines Align $ map emptyLineToDot values WordList ws -> SingleLine $ unwords ws LineSeparatedList xs -> renderLineSeparatedList renderSettingsCommaStyle xs CommaSeparatedList xs -> renderCommaSeparatedList renderSettingsCommaStyle xs+ where+ emptyLineToDot :: String -> String+ emptyLineToDot xs+ | isEmptyLine xs && renderSettingsEmptyLinesAsDot = "."+ | otherwise = xs + isEmptyLine :: String -> Bool+ isEmptyLine = all isSpace+ renderLineSeparatedList :: CommaStyle -> [String] -> Lines-renderLineSeparatedList style = MultipleLines . map (padding ++)+renderLineSeparatedList style = MultipleLines Indent . map (padding ++) where padding = case style of LeadingCommas -> " " TrailingCommas -> "" renderCommaSeparatedList :: CommaStyle -> [String] -> Lines-renderCommaSeparatedList style = MultipleLines . case style of+renderCommaSeparatedList style = MultipleLines Indent . case style of LeadingCommas -> map renderLeadingComma . zip (True : repeat False) TrailingCommas -> map renderTrailingComma . reverse . zip (True : repeat False) . reverse where@@ -109,7 +157,9 @@ fromString = Literal indent :: RenderSettings -> Nesting -> String -> String-indent RenderSettings{..} (Nesting nesting) s = replicate (nesting * renderSettingsIndentation) ' ' ++ s+indent RenderSettings{..} (Nesting nesting) = \ case+ "" -> ""+ s -> replicate (nesting * renderSettingsIndentation) ' ' ++ s sortFieldsBy :: [String] -> [Element] -> [Element] sortFieldsBy existingFieldOrder =
src/Hpack/Render/Hints.hs view
@@ -1,10 +1,13 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE RecordWildCards #-} module Hpack.Render.Hints ( FormattingHints (..) , sniffFormattingHints+, RenderSettings (..)+, defaultRenderSettings+, formattingHintsRenderSettings #ifdef TEST-, sniffRenderSettings , extractFieldOrder , extractSectionsFieldOrder , sanitize@@ -21,14 +24,16 @@ import Data.Char import Data.Maybe -import Hpack.Render.Dsl+import Hpack.Render.Dsl (Alignment(..), CommaStyle(..))+import qualified Hpack.Render.Dsl as Dsl import Hpack.Util data FormattingHints = FormattingHints { formattingHintsFieldOrder :: [String] , formattingHintsSectionsFieldOrder :: [(String, [String])] , formattingHintsAlignment :: Maybe Alignment-, formattingHintsRenderSettings :: RenderSettings+, formattingHintsIndentation :: Maybe Int+, formattingHintsCommaStyle :: Maybe CommaStyle } deriving (Eq, Show) sniffFormattingHints :: [String] -> FormattingHints@@ -36,7 +41,8 @@ formattingHintsFieldOrder = extractFieldOrder input , formattingHintsSectionsFieldOrder = extractSectionsFieldOrder input , formattingHintsAlignment = sniffAlignment input-, formattingHintsRenderSettings = sniffRenderSettings input+, formattingHintsIndentation = sniffIndentation input+, formattingHintsCommaStyle = sniffCommaStyle input } sanitize :: [String] -> [String]@@ -124,11 +130,20 @@ where startsWithComma = isPrefixOf "," . dropWhile isSpace -sniffRenderSettings :: [String] -> RenderSettings-sniffRenderSettings input = RenderSettings indentation fieldAlignment commaStyle- where- indentation = max def $ fromMaybe def (sniffIndentation input)- where def = renderSettingsIndentation defaultRenderSettings+data RenderSettings = RenderSettings {+ renderSettingsIndentation :: Int+, renderSettingsFieldAlignment :: Alignment+, renderSettingsCommaStyle :: CommaStyle+} deriving (Eq, Show) - fieldAlignment = renderSettingsFieldAlignment defaultRenderSettings- commaStyle = fromMaybe (renderSettingsCommaStyle defaultRenderSettings) (sniffCommaStyle input)+defaultRenderSettings :: RenderSettings+defaultRenderSettings = let Dsl.RenderSettings{..} = Dsl.defaultRenderSettings in RenderSettings{..}++formattingHintsRenderSettings :: FormattingHints -> RenderSettings+formattingHintsRenderSettings FormattingHints{..} = defaultRenderSettings {+ renderSettingsIndentation = indentation+, renderSettingsCommaStyle = commaStyle+} where+ indentation = max def $ fromMaybe def formattingHintsIndentation+ where def = renderSettingsIndentation defaultRenderSettings+ commaStyle = fromMaybe (renderSettingsCommaStyle defaultRenderSettings) formattingHintsCommaStyle
src/Hpack/Syntax/Dependencies.hs view
@@ -73,10 +73,15 @@ parseDependency subject = fmap fromCabal . cabalParse subject . T.unpack where fromCabal :: D.Dependency -> (String, DependencyVersion)- fromCabal d = (toName (D.depPkgName d) (DependencySet.toList $ D.depLibraries d), DependencyVersion Nothing . versionConstraintFromCabal $ D.depVerRange d)+ fromCabal (D.Dependency pkgName verRange libraries) =+ (depName, DependencyVersion Nothing $ versionConstraintFromCabal verRange)+ where+ depName :: String+ depName = prettyShow pkgName <> case DependencySet.toList libraries of+ [D.LMainLibName] -> ""+ [D.LSubLibName name] -> ":" <> prettyShow name+ xs -> ":{" <> intercalate "," (map renderComponent xs) <> "}" - toName :: D.PackageName -> [D.LibraryName] -> String- toName package components = prettyShow package <> case components of- [D.LMainLibName] -> ""- [D.LSubLibName lib] -> ":" <> prettyShow lib- xs -> ":{" <> (intercalate "," $ map prettyShow [name | D.LSubLibName name <- xs]) <> "}"+ renderComponent :: D.LibraryName -> String+ renderComponent D.LMainLibName = prettyShow pkgName+ renderComponent (D.LSubLibName name) = prettyShow name
src/Hpack/Syntax/DependencyVersion.hs view
@@ -4,6 +4,7 @@ {-# LANGUAGE ViewPatterns #-} module Hpack.Syntax.DependencyVersion ( githubBaseUrl+, codebergBaseUrl , GitRef , GitUrl @@ -44,6 +45,9 @@ githubBaseUrl :: String githubBaseUrl = "https://github.com/"++codebergBaseUrl :: String+codebergBaseUrl = "https://codeberg.org/" type GitUrl = String type GitRef = String
src/Hpack/Util.hs view
@@ -4,6 +4,7 @@ , GhcProfOption , GhcjsOption , CppOption+, AsmOption , CcOption , CxxOption , LdOption@@ -31,7 +32,7 @@ import System.FilePath import qualified System.FilePath.Posix as Posix import System.FilePath.Glob-import Crypto.Hash+import qualified Crypto.Hash.SHA256 as SHA256 import Hpack.Haskell import Hpack.Utf8 as Utf8@@ -46,6 +47,7 @@ type GhcProfOption = String type GhcjsOption = String type CppOption = String+type AsmOption = String type CcOption = String type CxxOption = String type LdOption = String@@ -128,7 +130,7 @@ type Hash = String sha256 :: String -> Hash-sha256 c = show (hash (Utf8.encodeUtf8 c) :: Digest SHA256)+sha256 c = show (SHA256.hash (Utf8.encodeUtf8 c)) nub :: Ord a => [a] -> [a] nub = nubOn id
src/Imports.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} module Imports (module Imports) where import Control.Applicative as Imports@@ -6,7 +7,11 @@ import Control.Monad as Imports import Control.Monad.IO.Class as Imports import Data.Bifunctor as Imports+#if MIN_VERSION_base(4,20,0)+import Data.List as Imports hiding (List, sort, nub)+#else import Data.List as Imports hiding (sort, nub)+#endif import Data.Monoid as Imports (Monoid(..)) import Data.Semigroup as Imports (Semigroup(..)) import Data.String as Imports
test/EndToEndSpec.hs view
@@ -19,8 +19,8 @@ import Data.Version (showVersion) import qualified Hpack.Render as Hpack-import Hpack.Config (packageConfig, readPackageConfig, DecodeOptions(..), DecodeResult(..), defaultDecodeOptions)-import Hpack.Render.Hints (FormattingHints(..), sniffFormattingHints)+import Hpack.Config (packageConfig, readPackageConfig, DecodeOptions(..), defaultDecodeOptions, DecodeResult(..))+import Hpack.Render.Hints (FormattingHints(..), sniffFormattingHints, formattingHintsRenderSettings) import qualified Paths_hpack as Hpack (version) @@ -67,6 +67,60 @@ , GHC == 7.4.2 |] + describe "description" $ do+ it "renders empty lines as dots" $ do+ [i|+ description: |+ foo++ bar++ baz+ |] `shouldRenderTo` package [i|+ description: foo+ .+ bar+ .+ baz+ |]++ context "when cabal-version is >= 3" $ do+ it "preserves empty lines" $ do+ [i|+ verbatim:+ cabal-version: 3.0+ description: |+ foo++ bar++ baz+ |] `shouldRenderTo` (package [i|+ description: foo++ bar++ baz+ |]) { packageCabalVersion = "3.0" }++ describe "category" $ do+ it "accepts a single category" $ do+ [i|+ category: Testing+ |] `shouldRenderTo` package [i|+ category: Testing+ |]++ it "accepts a list of categories" $ do+ [i|+ category:+ - Development+ - Testing+ |] `shouldRenderTo` package [i|+ category: Development,+ Testing+ |]+ describe "handling of Paths_ module" $ do it "adds Paths_ to other-modules" $ do [i|@@ -260,6 +314,18 @@ github: https://github.com/sol/hpack/issues/365 |] `shouldFailWith` "package.yaml: Error while parsing $.github - expected owner/repo or owner/repo/subdir, but encountered \"https://github.com/sol/hpack/issues/365\"" + describe "codeberg" $ do+ it "accepts owner/repo" $ do+ [i|+ codeberg: sol/hpack+ |] `shouldRenderTo` package [i|+ homepage: https://codeberg.org/sol/hpack#readme+ bug-reports: https://codeberg.org/sol/hpack/issues+ source-repository head+ type: git+ location: https://codeberg.org/sol/hpack+ |]+ describe "homepage" $ do it "accepts homepage URL" $ do [i|@@ -324,6 +390,26 @@ location: https://github.com/hspec/hspec |] + describe "flags" $ do+ it "accepts multi-line flag descriptions" $ do+ [i|+ flags:+ some-flag:+ description: |+ some+ flag+ description+ manual: True+ default: False+ |] `shouldRenderTo` package [i|+ flag some-flag+ description: some+ flag+ description+ manual: True+ default: False+ |]+ describe "defaults" $ do it "accepts global defaults" $ do writeFile "defaults/sol/hpack-template/2017/defaults.yaml" [i|@@ -424,7 +510,6 @@ |] `shouldFailWith` [i|cycle in defaults (#{canonic1} -> #{canonic2} -> #{canonic1})|] it "fails if defaults don't exist" $ do- pending [i| defaults: github: sol/foo@@ -638,44 +723,78 @@ - "*.markdown" |] `shouldWarn` ["Specified pattern \"*.markdown\" for extra-doc-files does not match any files"] - describe "build-tools" $ do- it "adds known build tools to build-tools" $ do+ describe "extra-files" $ do+ it "accepts extra-files" $ do+ touch "CHANGES.markdown"+ touch "README.markdown" [i|- executable:- build-tools:- alex == 0.1.0- |] `shouldRenderTo` executable_ "my-package" [i|- build-tools:- alex ==0.1.0- |]+ extra-files:+ - CHANGES.markdown+ - README.markdown+ |] `shouldRenderTo` (package [i|+ extra-files:+ CHANGES.markdown+ README.markdown+ |]) {packageCabalVersion = "3.14"} - it "adds other build tools to build-tool-depends" $ do- [i|- executable:- build-tools:- hspec-discover: 0.1.0- |] `shouldRenderTo` (executable_ "my-package" [i|- build-tool-depends:- hspec-discover:hspec-discover ==0.1.0- |]) {- -- NOTE: We do not set this to 2.0 on purpose, so that the .cabal- -- file is compatible with a wider range of Cabal versions!- packageCabalVersion = "1.12"- }+ describe "build-tools" $ do+ context "with known build tools" $ do+ context "when cabal-version < 2" $ do+ it "adds them to build-tools" $ do+ [i|+ executable:+ build-tools:+ alex == 0.1.0+ |] `shouldRenderTo` executable_ "my-package" [i|+ build-tools:+ alex ==0.1.0+ |] - it "accepts build-tool-depends as an alias" $ do- [i|- executable:+ context "when cabal-version >= 2" $ do+ it "adds them to build-tool-depends" $ do+ [i|+ verbatim:+ cabal-version: 2.0+ executable:+ build-tools:+ alex == 0.1.0+ |] `shouldRenderTo` (executable_ "my-package" [i|+ autogen-modules:+ Paths_my_package+ build-tool-depends:+ alex:alex ==0.1.0+ |]) {+ packageCabalVersion = "2.0"+ }++ context "with other build tools" $ do+ it "adds them to build-tool-depends" $ do+ [i|+ executable:+ build-tools:+ hspec-discover: 0.1.0+ |] `shouldRenderTo` (executable_ "my-package" [i| build-tool-depends:- hspec-discover: 0.1.0- |] `shouldRenderTo` (executable_ "my-package" [i|- build-tool-depends:- hspec-discover:hspec-discover ==0.1.0- |]) {- packageCabalVersion = "1.12"- , packageWarnings = ["package.yaml: $.executable.build-tool-depends is deprecated, use $.executable.build-tools instead"]- }+ hspec-discover:hspec-discover ==0.1.0+ |]) {+ -- NOTE: We do not set this to 2.0 on purpose, so that the .cabal+ -- file is compatible with a wider range of Cabal versions!+ packageCabalVersion = "1.12"+ } + it "accepts build-tool-depends as an alias" $ do+ [i|+ executable:+ build-tool-depends:+ hspec-discover: 0.1.0+ |] `shouldRenderTo` (executable_ "my-package" [i|+ build-tool-depends:+ hspec-discover:hspec-discover ==0.1.0+ |]) {+ packageCabalVersion = "1.12"+ , packageWarnings = ["package.yaml: $.executable.build-tool-depends is deprecated, use $.executable.build-tools instead"]+ }+ context "when the name of a build tool matches an executable from the same package" $ do it "adds it to build-tools" $ do [i|@@ -714,6 +833,22 @@ bar ==0.2.0 |] + context "when cabal-version >= 2" $ do+ it "adds it to build-tool-depends" $ do+ [i|+ verbatim:+ cabal-version: 2.0+ executables:+ bar:+ build-tools:+ - bar+ |] `shouldRenderTo` (executable_ "bar" [i|+ autogen-modules:+ Paths_my_package+ build-tool-depends:+ my-package:bar+ |]) {packageCabalVersion = "2.0"}+ context "when the name of a build tool matches a legacy system build tool" $ do it "adds it to build-tools" $ do [i|@@ -723,7 +858,7 @@ |] `shouldRenderTo` (executable_ "my-package" [i| build-tools: ghc >=7.10- |]) { packageWarnings = ["Listing \"ghc\" under build-tools is deperecated! Please list system executables under system-build-tools instead!"] }+ |]) { packageWarnings = ["Listing \"ghc\" under build-tools is deprecated! Please list system executables under system-build-tools instead!"] } describe "system-build-tools" $ do it "adds system build tools to build-tools" $ do@@ -924,6 +1059,32 @@ jsbits/bar.js |] + describe "asm-options" $ do+ it "accepts asm-options" $ do+ [i|+ executable:+ asm-options: -Wall+ |] `shouldRenderTo` (executable_ "my-package" [i|+ autogen-modules:+ Paths_my_package+ asm-options: -Wall+ |]) {packageCabalVersion = "3.0"}++ describe "asm-sources" $ before_ (touch "foo.asm" >> touch "asmbits/bar.asm") $ do+ it "accepts asm-sources" $ do+ [i|+ executable:+ asm-sources:+ - foo.asm+ - asmbits/*.asm+ |] `shouldRenderTo` (executable_ "my-package" [i|+ autogen-modules:+ Paths_my_package+ asm-sources:+ foo.asm+ asmbits/bar.asm+ |]) {packageCabalVersion = "3.0"}+ describe "cxx-options" $ do it "accepts cxx-options" $ do [i|@@ -1216,6 +1377,20 @@ default-language: Haskell2010 |]) {packageCabalVersion = "2.0"} + context "with PackageInfo_my_package" $ do+ it "infers cabal-version 3.12" $ do+ [i|+ spec-version: 0.36.0+ library:+ generated-other-modules: PackageInfo_my_package+ |] `shouldRenderTo` (library [i|+ other-modules:+ PackageInfo_my_package+ autogen-modules:+ PackageInfo_my_package+ default-language: Haskell2010+ |]) {packageCabalVersion = "3.12"}+ describe "internal-libraries" $ do it "accepts internal-libraries" $ do touch "src/Foo.hs"@@ -1573,6 +1748,23 @@ default-language: Haskell2010 |]) {packageCabalVersion = "2.0"} + context "with PackageInfo_my_package" $ do+ it "infers cabal-version 3.12" $ do+ [i|+ spec-version: 0.36.0+ executables:+ foo:+ main: Main.hs+ generated-other-modules: PackageInfo_my_package+ |] `shouldRenderTo` (executable "foo" [i|+ main-is: Main.hs+ other-modules:+ PackageInfo_my_package+ autogen-modules:+ PackageInfo_my_package+ default-language: Haskell2010+ |]) {packageCabalVersion = "3.12"}+ context "with a conditional" $ do it "doesn't infer any modules mentioned in that conditional" $ do touch "src/Foo.hs"@@ -1862,9 +2054,26 @@ it "overrides header fields" $ do [i| verbatim:- cabal-version: foo- |] `shouldRenderTo` (package "") {packageCabalVersion = "foo"}+ build-type: foo+ |] `shouldRenderTo` (package "") {packageBuildType = "foo"} + context "with cabal-version" $ do+ context "with a string value" $ do+ it "takes precedence over inferred version" $ do+ [i|+ license: BSD-3-Clause+ verbatim:+ cabal-version: foo+ |] `shouldRenderTo` (package "license: BSD-3-Clause") {packageCabalVersion = "foo"}++ context "with a version" $ do+ it "takes precedence over inferred version" $ do+ [i|+ license: BSD-3-Clause+ verbatim:+ cabal-version: 0.8+ |] `shouldRenderTo` (package "license: BSD-3-Clause") {packageCabalVersion = "0.8"}+ it "overrides other fields" $ do touch "foo" [i|@@ -1936,9 +2145,9 @@ return $ case mPackage of Right (DecodeResult pkg cabalVersion _ warnings) -> let- FormattingHints{..} = sniffFormattingHints (lines old)+ hints@FormattingHints{..} = sniffFormattingHints (lines old) alignment = fromMaybe 0 formattingHintsAlignment- settings = formattingHintsRenderSettings+ settings = formattingHintsRenderSettings hints output = cabalVersion ++ Hpack.renderPackageWith settings alignment formattingHintsFieldOrder formattingHintsSectionsFieldOrder pkg in Right (warnings, output)
test/Hpack/ConfigSpec.hs view
@@ -166,7 +166,7 @@ context "when name matches a legacy system build tool" $ do it "warns" $ do- toBuildTool_ (UnqualifiedBuildTool "ghc") `shouldBe` (Left ("ghc", AnyVersion), ["Listing \"ghc\" under build-tools is deperecated! Please list system executables under system-build-tools instead!"])+ toBuildTool_ (UnqualifiedBuildTool "ghc") `shouldBe` (Left ("ghc", AnyVersion), ["Listing \"ghc\" under build-tools is deprecated! Please list system executables under system-build-tools instead!"]) context "with a QualifiedBuildTool" $ do context "when only package matches the current package" $ do@@ -225,7 +225,7 @@ withPackageConfig_ [i| category: Data |]- (`shouldBe` package {packageCategory = Just "Data"})+ (`shouldBe` package {packageCategory = ["Data"]}) it "accepts author" $ do withPackageConfig_ [i|
test/Hpack/DefaultsSpec.hs view
@@ -22,7 +22,6 @@ url = "https://raw.githubusercontent.com/sol/hpack/master/Setup.lhs" it "downloads file if missing" $ do- pending expected <- readFile "Setup.lhs" inTempDirectory $ do Found <- ensureFile file url@@ -41,7 +40,6 @@ url = "https://raw.githubusercontent.com/sol/hpack/master/Setup.foo" it "does not create any files" $ do- pending inTempDirectory $ do NotFound <- ensureFile file url doesFileExist file `shouldReturn` False
test/Hpack/Render/DslSpec.hs view
@@ -55,7 +55,79 @@ ] context "when rendering a Field" $ do- context "when rendering a MultipleLines value" $ do+ context "with a Literal value" $ do+ let+ description :: [String] -> Element+ description = Field "description" . Literal . unlines++ values :: [String]+ values = [+ "foo"+ , "bar"+ , "baz"+ ]++ it "renders field" $ do+ render_ (Field "description" "foo") `shouldBe` ["description: foo"]++ it "formats multi-line values" $ do+ render_ (description values) `shouldBe` [+ "description: foo"+ , " bar"+ , " baz"+ ]++ it "formats empty lines" $ do+ let+ field = description [+ "foo"+ , " "+ , "baz"+ ]+ render_ field `shouldBe` [+ "description: foo"+ , " ."+ , " baz"+ ]++ it "correctly handles empty lines at the beginning" $ do+ render_ (description $ "" : values) `shouldBe` [+ "description: ."+ , " foo"+ , " bar"+ , " baz"+ ]++ it "takes alignment into account" $ do+ let+ settings :: RenderSettings+ settings = defaultRenderSettings { renderSettingsFieldAlignment = 15 }++ render settings 0 (description values) `shouldBe` [+ "description: foo"+ , " bar"+ , " baz"+ ]++ context "when cabal-version is >= 3" $ do+ let+ settings :: RenderSettings+ settings = defaultRenderSettings { renderSettingsEmptyLinesAsDot = False }++ it "preserves empty lines" $ do+ let+ field = description [+ "foo"+ , ""+ , "baz"+ ]+ render settings 0 field `shouldBe` [+ "description: foo"+ , ""+ , " baz"+ ]++ context "with MultipleLines" $ do it "takes nesting into account" $ do let field = Field "foo" (CommaSeparatedList ["bar", "baz"]) render defaultRenderSettings 1 field `shouldBe` [@@ -92,14 +164,14 @@ renderValue defaultRenderSettings (WordList ["foo", "bar", "baz"]) `shouldBe` SingleLine "foo bar baz" it "renders CommaSeparatedList" $ do- renderValue defaultRenderSettings (CommaSeparatedList ["foo", "bar", "baz"]) `shouldBe` MultipleLines [+ renderValue defaultRenderSettings (CommaSeparatedList ["foo", "bar", "baz"]) `shouldBe` MultipleLines Indent [ " foo" , ", bar" , ", baz" ] it "renders LineSeparatedList" $ do- renderValue defaultRenderSettings (LineSeparatedList ["foo", "bar", "baz"]) `shouldBe` MultipleLines [+ renderValue defaultRenderSettings (LineSeparatedList ["foo", "bar", "baz"]) `shouldBe` MultipleLines Indent [ " foo" , " bar" , " baz"@@ -109,14 +181,14 @@ let settings = defaultRenderSettings{renderSettingsCommaStyle = TrailingCommas} it "renders CommaSeparatedList with trailing commas" $ do- renderValue settings (CommaSeparatedList ["foo", "bar", "baz"]) `shouldBe` MultipleLines [+ renderValue settings (CommaSeparatedList ["foo", "bar", "baz"]) `shouldBe` MultipleLines Indent [ "foo," , "bar," , "baz" ] it "renders LineSeparatedList without padding" $ do- renderValue settings (LineSeparatedList ["foo", "bar", "baz"]) `shouldBe` MultipleLines [+ renderValue settings (LineSeparatedList ["foo", "bar", "baz"]) `shouldBe` MultipleLines Indent [ "foo" , "bar" , "baz"
test/Hpack/Render/HintsSpec.hs view
@@ -3,11 +3,11 @@ import Test.Hspec import Hpack.Render.Hints-import Hpack.Render.Dsl+import Hpack.Render.Dsl (CommaStyle(..)) spec :: Spec spec = do- describe "sniffRenderSettings" $ do+ describe "formattingHintsRenderSettings" $ do context "when sniffed indentation is < default" $ do it "uses default instead" $ do let input = [@@ -15,8 +15,9 @@ , "exposed-modules:" , " Foo" ]- sniffIndentation input `shouldBe` Just 0- renderSettingsIndentation (sniffRenderSettings input) `shouldBe` 2+ hints = sniffFormattingHints input+ formattingHintsIndentation hints `shouldBe` Just 0+ renderSettingsIndentation (formattingHintsRenderSettings hints) `shouldBe` 2 describe "extractFieldOrder" $ do it "extracts field order hints" $ do
test/Hpack/RenderSpec.hs view
@@ -4,10 +4,13 @@ import Helper +import Control.Monad.Reader (runReader)+ import Hpack.Syntax.DependencyVersion import Hpack.ConfigSpec hiding (spec) import Hpack.Config hiding (package)-import Hpack.Render.Dsl+import Hpack.Render.Dsl hiding (RenderSettings, defaultRenderSettings, render)+import qualified Hpack.Render.Dsl as Dsl import Hpack.Render library :: Library@@ -21,6 +24,12 @@ renderEmptySection :: Empty -> [Element] renderEmptySection Empty = [] +cabalVersion :: CabalVersion+cabalVersion = makeCabalVersion [1,12]++render :: Element -> [FilePath]+render = Dsl.render Dsl.defaultRenderSettings 0+ spec :: Spec spec = do describe "renderPackageWith" $ do@@ -220,9 +229,11 @@ ] describe "renderConditional" $ do+ let run = flip runReader (RenderEnv cabalVersion "foo")+ it "renders conditionals" $ do let conditional = Conditional "os(windows)" (section Empty) {sectionDependencies = deps ["Win32"]} Nothing- render defaultRenderSettings 0 (renderConditional renderEmptySection conditional) `shouldBe` [+ render (run $ renderConditional renderEmptySection conditional) `shouldBe` [ "if os(windows)" , " build-depends:" , " Win32"@@ -230,7 +241,7 @@ it "renders conditionals with else-branch" $ do let conditional = Conditional "os(windows)" (section Empty) {sectionDependencies = deps ["Win32"]} (Just $ (section Empty) {sectionDependencies = deps ["unix"]})- render defaultRenderSettings 0 (renderConditional renderEmptySection conditional) `shouldBe` [+ render (run $ renderConditional renderEmptySection conditional) `shouldBe` [ "if os(windows)" , " build-depends:" , " Win32"@@ -242,7 +253,7 @@ it "renders nested conditionals" $ do let conditional = Conditional "arch(i386)" (section Empty) {sectionGhcOptions = ["-threaded"], sectionConditionals = [innerConditional]} Nothing innerConditional = Conditional "os(windows)" (section Empty) {sectionDependencies = deps ["Win32"]} Nothing- render defaultRenderSettings 0 (renderConditional renderEmptySection conditional) `shouldBe` [+ render (run $ renderConditional renderEmptySection conditional) `shouldBe` [ "if arch(i386)" , " ghc-options: -threaded" , " if os(windows)"@@ -253,7 +264,7 @@ it "conditionalises both build-depends and mixins" $ do let conditional = Conditional "os(windows)" (section Empty) {sectionDependencies = [("Win32", depInfo)]} Nothing depInfo = defaultInfo { dependencyInfoMixins = ["hiding (Blah)"] }- render defaultRenderSettings 0 (renderConditional renderEmptySection conditional) `shouldBe` [+ render (run $ renderConditional renderEmptySection conditional) `shouldBe` [ "if os(windows)" , " build-depends:" , " Win32"@@ -264,52 +275,17 @@ describe "renderFlag" $ do it "renders flags" $ do let flag = (Flag "foo" (Just "some flag") True False)- render defaultRenderSettings 0 (renderFlag flag) `shouldBe` [+ render (renderFlag flag) `shouldBe` [ "flag foo" , " description: some flag" , " manual: True" , " default: False" ] - describe "formatDescription" $ do- it "formats description" $ do- let description = unlines [- "foo"- , "bar"- ]- "description: " ++ formatDescription 0 description `shouldBe` intercalate "\n" [- "description: foo"- , " bar"- ]-- it "takes specified alignment into account" $ do- let description = unlines [- "foo"- , "bar"- , "baz"- ]- "description: " ++ formatDescription 15 description `shouldBe` intercalate "\n" [- "description: foo"- , " bar"- , " baz"- ]-- it "formats empty lines" $ do- let description = unlines [- "foo"- , " "- , "bar"- ]- "description: " ++ formatDescription 0 description `shouldBe` intercalate "\n" [- "description: foo"- , " ."- , " bar"- ]- describe "renderSourceRepository" $ do it "renders source-repository without subdir correctly" $ do let repository = SourceRepository "https://github.com/hspec/hspec" Nothing- (render defaultRenderSettings 0 $ renderSourceRepository repository)+ (render $ renderSourceRepository repository) `shouldBe` [ "source-repository head" , " type: git"@@ -318,7 +294,7 @@ it "renders source-repository with subdir" $ do let repository = SourceRepository "https://github.com/hspec/hspec" (Just "hspec-core")- (render defaultRenderSettings 0 $ renderSourceRepository repository)+ (render $ renderSourceRepository repository) `shouldBe` [ "source-repository head" , " type: git"@@ -328,7 +304,7 @@ describe "renderDirectories" $ do it "replaces . with ./. (for compatibility with cabal syntax)" $ do- (render defaultRenderSettings 0 $ renderDirectories "name" ["."])+ (render $ renderDirectories "name" ["."]) `shouldBe` [ "name:" , " ./"
test/Hpack/Syntax/DependenciesSpec.hs view
@@ -29,6 +29,9 @@ it "accepts dependencies with multiple subcomponents" $ do parseDependency "dependency" "foo:{bar,baz}" `shouldReturn` ("foo:{bar,baz}", DependencyVersion Nothing AnyVersion) + it "accepts dependencies with multiple subcomponents including the main library" $ do+ parseDependency "dependency" "foo:{foo,bar,baz}" `shouldReturn` ("foo:{foo,bar,baz}", DependencyVersion Nothing AnyVersion)+ describe "fromValue" $ do context "when parsing Dependencies" $ do context "with a scalar" $ do
test/Hpack/Syntax/GitSpec.hs view
@@ -21,7 +21,7 @@ it "rejects .lock at the end of a component" $ do isValidRef "foo/bar.lock/baz" `shouldBe` False - it "rejects . at the biginning of a component" $ do+ it "rejects . at the beginning of a component" $ do isValidRef "foo/.bar/baz" `shouldBe` False it "rejects two consecutive dots .." $ do
+ test/SpecHook.hs view
@@ -0,0 +1,8 @@+{-# LANGUAGE OverloadedStrings #-}+module SpecHook where++import Test.Hspec+import qualified VCR++hook :: Spec -> Spec+hook = aroundAll_ (VCR.with "test/fixtures/vcr-tape.yaml")