diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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` diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2014-2023 Simon Hengel +Copyright (c) 2014-2026 Simon Hengel Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal diff --git a/hpack.cabal b/hpack.cabal --- a/hpack.cabal +++ b/hpack.cabal @@ -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 +description: See the README at 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: diff --git a/resources/test/hpack.cabal b/resources/test/hpack.cabal --- a/resources/test/hpack.cabal +++ b/resources/test/hpack.cabal @@ -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 +description: See the README at 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: diff --git a/src/Hpack/Config.hs b/src/Hpack/Config.hs --- a/src/Hpack/Config.hs +++ b/src/Hpack/Config.hs @@ -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 diff --git a/src/Hpack/Render.hs b/src/Hpack/Render.hs --- a/src/Hpack/Render.hs +++ b/src/Hpack/Render.hs @@ -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 diff --git a/src/Hpack/Render/Dsl.hs b/src/Hpack/Render/Dsl.hs --- a/src/Hpack/Render/Dsl.hs +++ b/src/Hpack/Render/Dsl.hs @@ -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 = diff --git a/src/Hpack/Render/Hints.hs b/src/Hpack/Render/Hints.hs --- a/src/Hpack/Render/Hints.hs +++ b/src/Hpack/Render/Hints.hs @@ -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 diff --git a/src/Hpack/Syntax/Dependencies.hs b/src/Hpack/Syntax/Dependencies.hs --- a/src/Hpack/Syntax/Dependencies.hs +++ b/src/Hpack/Syntax/Dependencies.hs @@ -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 diff --git a/src/Hpack/Syntax/DependencyVersion.hs b/src/Hpack/Syntax/DependencyVersion.hs --- a/src/Hpack/Syntax/DependencyVersion.hs +++ b/src/Hpack/Syntax/DependencyVersion.hs @@ -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 diff --git a/src/Hpack/Util.hs b/src/Hpack/Util.hs --- a/src/Hpack/Util.hs +++ b/src/Hpack/Util.hs @@ -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 diff --git a/src/Imports.hs b/src/Imports.hs --- a/src/Imports.hs +++ b/src/Imports.hs @@ -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 diff --git a/test/EndToEndSpec.hs b/test/EndToEndSpec.hs --- a/test/EndToEndSpec.hs +++ b/test/EndToEndSpec.hs @@ -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) diff --git a/test/Hpack/ConfigSpec.hs b/test/Hpack/ConfigSpec.hs --- a/test/Hpack/ConfigSpec.hs +++ b/test/Hpack/ConfigSpec.hs @@ -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| diff --git a/test/Hpack/DefaultsSpec.hs b/test/Hpack/DefaultsSpec.hs --- a/test/Hpack/DefaultsSpec.hs +++ b/test/Hpack/DefaultsSpec.hs @@ -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 diff --git a/test/Hpack/Render/DslSpec.hs b/test/Hpack/Render/DslSpec.hs --- a/test/Hpack/Render/DslSpec.hs +++ b/test/Hpack/Render/DslSpec.hs @@ -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" diff --git a/test/Hpack/Render/HintsSpec.hs b/test/Hpack/Render/HintsSpec.hs --- a/test/Hpack/Render/HintsSpec.hs +++ b/test/Hpack/Render/HintsSpec.hs @@ -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 diff --git a/test/Hpack/RenderSpec.hs b/test/Hpack/RenderSpec.hs --- a/test/Hpack/RenderSpec.hs +++ b/test/Hpack/RenderSpec.hs @@ -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:" , " ./" diff --git a/test/Hpack/Syntax/DependenciesSpec.hs b/test/Hpack/Syntax/DependenciesSpec.hs --- a/test/Hpack/Syntax/DependenciesSpec.hs +++ b/test/Hpack/Syntax/DependenciesSpec.hs @@ -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 diff --git a/test/Hpack/Syntax/GitSpec.hs b/test/Hpack/Syntax/GitSpec.hs --- a/test/Hpack/Syntax/GitSpec.hs +++ b/test/Hpack/Syntax/GitSpec.hs @@ -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 diff --git a/test/SpecHook.hs b/test/SpecHook.hs new file mode 100644 --- /dev/null +++ b/test/SpecHook.hs @@ -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")