Skip to content

Commit

Permalink
Don't infer Paths_-module with spec-version: 0.36.0 or later
Browse files Browse the repository at this point in the history
  • Loading branch information
sol committed Sep 21, 2023
1 parent 56cdf88 commit 9a1b938
Show file tree
Hide file tree
Showing 8 changed files with 97 additions and 34 deletions.
2 changes: 1 addition & 1 deletion .ghci
Original file line number Diff line number Diff line change
@@ -1 +1 @@
:set -XHaskell2010 -fno-warn-incomplete-uni-patterns -DTEST -isrc -itest -i./dist-newstyle/build/x86_64-linux/ghc-9.6.2/hpack-0.35.3/build/autogen/
:set -XHaskell2010 -Wredundant-constraints -fno-warn-incomplete-uni-patterns -DTEST -isrc -itest -i./dist-newstyle/build/x86_64-linux/ghc-9.6.2/hpack-0.36.0/build/autogen
3 changes: 3 additions & 0 deletions CHANGELOG.md
Original file line number Diff line number Diff line change
@@ -1,3 +1,6 @@
## Changes in 0.36.0
- Don't infer `Paths_`-module with `spec-version: 0.36.0` or later

## Changes in 0.35.5
- Add (undocumented) `list` command

Expand Down
37 changes: 31 additions & 6 deletions README.md
Original file line number Diff line number Diff line change
Expand Up @@ -47,6 +47,8 @@ at the Singapore Haskell meetup: http://typeful.net/talks/hpack
* [Examples](#examples)
* [Documentation](#documentation)
* [Handling of Paths_ modules](#handling-of-paths_-modules)
* [Modern behavior](#modern-behavior)
* [Legacy behavior](#legacy-behavior)
* [Quick-reference](#quick-reference)
* [Top-level fields](#top-level-fields)
* [cabal-version](#cabal-version)
Expand All @@ -70,18 +72,41 @@ at the Singapore Haskell meetup: http://typeful.net/talks/hpack
* [Stack support](#stack-support)
* [Binaries for use on Travis CI](#binaries-for-use-on-travis-ci)

<!-- Added by: sol, at: Fri 19 Feb 2021 10:31:47 PM +07 -->
<!-- Added by: sol, at: Mon Sep 18 11:40:17 AM +07 2023 -->

<!--te-->

### Handling of `Paths_` modules

Cabal generates a `Paths_` module for every package. By default Hpack adds
that module to `other-modules` when generating a `.cabal` file. This is
sometimes useful and most of the time not harmful.
Cabal generates a `Paths_` module for every package. How exactly Hpack behaves
in regards to that module depends on the value of the `spec-version` field.

However, there are situations when this can lead to compilation errors (e.g
when using a custom `Prelude`).
If the `spec-version` is explicitly specified and at least `0.36.0` the modern
behavior is used, otherwise Hpack falls back to the legacy behavior.

To use the modern behavior, require at least
```yaml
spec-version: 0.36.0
```
in your `package.yaml`.

#### Modern behavior

If you want to use the `Paths_` module for a component, you have to explicitly
specify it under `generated-other-modules`.

***Example:***

```yaml
library:
source-dirs: src
generated-other-modules: Paths_name # substitute name with the package name
```

#### Legacy behavior

For historic reasons Hpack adds the `Paths_` module to `other-modules` when
generating a `.cabal` file.

To prevent Hpack from adding the `Paths_` module to `other-modules` add the
following to `package.yaml`:
Expand Down
2 changes: 2 additions & 0 deletions cabal.project
Original file line number Diff line number Diff line change
Expand Up @@ -3,3 +3,5 @@ packages:

package hpack
ghc-options: -Werror

tests: True
12 changes: 7 additions & 5 deletions hpack.cabal

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

5 changes: 4 additions & 1 deletion package.yaml
Original file line number Diff line number Diff line change
@@ -1,5 +1,6 @@
spec-version: 0.36.0
name: hpack
version: 0.35.5
version: 0.36.0
synopsis: A modern format for Haskell packages
description: See README at <https://github.com/sol/hpack#readme>
author: Simon Hengel <[email protected]>
Expand Down Expand Up @@ -50,6 +51,7 @@ library:
- Hpack.Render
- Hpack.Yaml
- Hpack.Error
generated-other-modules: Paths_hpack

executable:
main: Main.hs
Expand All @@ -64,6 +66,7 @@ tests:
source-dirs:
- test
- src
generated-other-modules: Paths_hpack
dependencies:
- hspec == 2.*
- QuickCheck
Expand Down
61 changes: 40 additions & 21 deletions src/Hpack/Config.hs
Original file line number Diff line number Diff line change
Expand Up @@ -99,6 +99,8 @@ import Data.Text.Encoding (decodeUtf8)
import Data.Scientific (Scientific)
import System.Directory
import System.FilePath
import Control.Monad.State (MonadState, StateT, evalStateT)
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)
Expand Down Expand Up @@ -639,7 +641,7 @@ liftIOEither action = liftIO action >>= liftEither

type FormatYamlParseError = FilePath -> Yaml.ParseException -> String

decodeYaml :: (FromValue a, MonadIO m, Warnings m, Errors m) => FormatYamlParseError -> FilePath -> m a
decodeYaml :: (FromValue a, MonadIO m, Warnings m, Errors m, State m) => FormatYamlParseError -> FilePath -> m a
decodeYaml formatYamlParseError file = do
(warnings, a) <- liftIOEither $ first (ParseError . formatYamlParseError file) <$> Yaml.decodeYamlWithParseError file
tell warnings
Expand Down Expand Up @@ -668,11 +670,12 @@ readPackageConfig options = first (formatHpackError $ decodeOptionsProgramName o

type Errors = MonadError HpackError
type Warnings = MonadWriter [String]
type State = MonadState SpecVersion

type ConfigM m = WriterT [String] (ExceptT HpackError m)
type ConfigM m = StateT SpecVersion (WriterT [String] (ExceptT HpackError m))

runConfigM :: ConfigM m a -> m (Either HpackError (a, [String]))
runConfigM = runExceptT . runWriterT
runConfigM :: Monad m => ConfigM m a -> m (Either HpackError (a, [String]))
runConfigM = runExceptT . runWriterT . (`evalStateT` NoSpecVersion)

readPackageConfigWithError :: DecodeOptions -> IO (Either HpackError DecodeResult)
readPackageConfigWithError (DecodeOptions _ file mUserDataDir readValue formatYamlParseError) = fmap (fmap addCabalFile) . runConfigM $ do
Expand Down Expand Up @@ -902,15 +905,16 @@ determineCabalVersion inferredLicense pkg@Package{..} = (
sectionAll :: Monoid b => (Section a -> b) -> Section a -> b
sectionAll f sect = f sect <> foldMap (foldMap $ sectionAll f) (sectionConditionals sect)

decodeValue :: (FromValue a, Warnings m, Errors m) => FilePath -> Value -> m a
decodeValue :: (FromValue a, State m, Warnings m, Errors m) => FilePath -> Value -> m a
decodeValue file value = do
(r, unknown, deprecated) <- liftEither $ first (DecodeValueError file) (Config.decodeValue value)
case r of
UnsupportedSpecVersion v -> do
throwError $ HpackVersionNotSupported file v Hpack.version
SupportedSpecVersion a -> do
SupportedSpecVersion v a -> do
tell (map formatUnknownField unknown)
tell (map formatDeprecatedField deprecated)
State.modify $ max v
return a
where
prefix :: String
Expand All @@ -922,14 +926,20 @@ decodeValue file value = do
formatDeprecatedField :: (String, String) -> String
formatDeprecatedField (name, substitute) = prefix <> name <> " is deprecated, use " <> substitute <> " instead"

data CheckSpecVersion a = SupportedSpecVersion a | UnsupportedSpecVersion Version
data SpecVersion = NoSpecVersion | SpecVersion Version
deriving (Eq, Show, Ord)

toSpecVersion :: Maybe ParseSpecVersion -> SpecVersion
toSpecVersion = maybe NoSpecVersion (SpecVersion . unParseSpecVersion)

data CheckSpecVersion a = SupportedSpecVersion SpecVersion a | UnsupportedSpecVersion Version

instance FromValue a => FromValue (CheckSpecVersion a) where
fromValue = withObject $ \ o -> o .:? "spec-version" >>= \ case
Just (ParseSpecVersion v) | Hpack.version < v -> return $ UnsupportedSpecVersion v
_ -> SupportedSpecVersion <$> fromValue (Object o)
v -> SupportedSpecVersion (toSpecVersion v) <$> fromValue (Object o)

newtype ParseSpecVersion = ParseSpecVersion Version
newtype ParseSpecVersion = ParseSpecVersion {unParseSpecVersion :: Version}

instance FromValue ParseSpecVersion where
fromValue value = do
Expand Down Expand Up @@ -1079,7 +1089,7 @@ toPackage formatYamlParseError userDataDir dir =
setLanguage = (mempty { commonOptionsLanguage = Alias . Last $ Just (Just language) } <>)

expandDefaultsInConfig
:: (MonadIO m, Warnings m, Errors m) =>
:: (MonadIO m, Warnings m, Errors m, State m) =>
FormatYamlParseError
-> FilePath
-> FilePath
Expand All @@ -1088,7 +1098,7 @@ expandDefaultsInConfig
expandDefaultsInConfig formatYamlParseError userDataDir dir = bitraverse (expandGlobalDefaults formatYamlParseError userDataDir dir) (expandSectionDefaults formatYamlParseError userDataDir dir)

expandGlobalDefaults
:: (MonadIO m, Warnings m, Errors m) =>
:: (MonadIO m, Warnings m, Errors m, State m) =>
FormatYamlParseError
-> FilePath
-> FilePath
Expand All @@ -1098,7 +1108,7 @@ expandGlobalDefaults formatYamlParseError userDataDir dir = do
fmap (`Product` Empty) >>> expandDefaults formatYamlParseError userDataDir dir >=> \ (Product c Empty) -> return c

expandSectionDefaults
:: (MonadIO m, Warnings m, Errors m) =>
:: (MonadIO m, Warnings m, Errors m, State m) =>
FormatYamlParseError
-> FilePath
-> FilePath
Expand All @@ -1121,7 +1131,7 @@ expandSectionDefaults formatYamlParseError userDataDir dir p@PackageConfig{..} =
}

expandDefaults
:: forall a m. (MonadIO m, Warnings m, Errors m) =>
:: forall a m. (MonadIO m, Warnings m, Errors m, State m) =>
(FromValue a, Monoid a)
=> FormatYamlParseError
-> FilePath
Expand Down Expand Up @@ -1169,7 +1179,7 @@ toExecutableMap name executables mExecutable = do

type GlobalOptions = CommonOptions CSources CxxSources JsSources Empty

toPackage_ :: (MonadIO m, Warnings m) => FilePath -> Product GlobalOptions (PackageConfig CSources CxxSources JsSources) -> m (Package, String)
toPackage_ :: (MonadIO m, Warnings m, State m) => FilePath -> Product GlobalOptions (PackageConfig CSources CxxSources JsSources) -> m (Package, String)
toPackage_ dir (Product g PackageConfig{..}) = do
executableMap <- toExecutableMap packageName_ packageConfigExecutables packageConfigExecutable
let
Expand Down Expand Up @@ -1377,7 +1387,7 @@ removeConditionalsThatAreAlwaysFalse sect = sect {
where
p = (/= CondBool False) . conditionalCondition

inferModules :: MonadIO m =>
inferModules :: (MonadIO m, State m) =>
FilePath
-> String
-> (a -> [Module])
Expand All @@ -1386,10 +1396,19 @@ inferModules :: MonadIO m =>
-> ([Module] -> a -> b)
-> Section a
-> m (Section b)
inferModules dir packageName_ getMentionedModules getInferredModules fromData fromConditionals = fmap removeConditionalsThatAreAlwaysFalse . traverseSectionAndConditionals
(fromConfigSection fromData [pathsModuleFromPackageName packageName_])
(fromConfigSection (\ [] -> fromConditionals) [])
[]
inferModules dir packageName_ getMentionedModules getInferredModules fromData fromConditionals sect_ = do
specVersion <- State.get
let
pathsModule :: [Module]
pathsModule = case specVersion of
SpecVersion v | v >= makeVersion [0,36,0] -> []
_ -> [pathsModuleFromPackageName packageName_]

removeConditionalsThatAreAlwaysFalse <$> traverseSectionAndConditionals
(fromConfigSection fromData pathsModule)
(fromConfigSection (\ [] -> fromConditionals) [])
[]
sect_
where
fromConfigSection fromConfig pathsModule_ outerModules sect@Section{sectionData = conf} = do
modules <- liftIO $ listModules dir sect
Expand All @@ -1400,7 +1419,7 @@ inferModules dir packageName_ getMentionedModules getInferredModules fromData fr
r = fromConfig pathsModule inferableModules conf
return (outerModules ++ getInferredModules r, r)

toLibrary :: MonadIO m => FilePath -> String -> Section LibrarySection -> m (Section Library)
toLibrary :: (MonadIO m, State m) => FilePath -> String -> Section LibrarySection -> m (Section Library)
toLibrary dir name =
inferModules dir name getMentionedLibraryModules getLibraryModules fromLibrarySectionTopLevel fromLibrarySectionInConditional
where
Expand Down Expand Up @@ -1444,7 +1463,7 @@ getMentionedExecutableModules :: ExecutableSection -> [Module]
getMentionedExecutableModules (ExecutableSection (Alias (Last main)) otherModules generatedModules)=
maybe id (:) (toModule . Path.fromFilePath <$> main) $ fromMaybeList (otherModules <> generatedModules)

toExecutable :: MonadIO m => FilePath -> String -> Section ExecutableSection -> m (Section Executable)
toExecutable :: (MonadIO m, State m) => FilePath -> String -> Section ExecutableSection -> m (Section Executable)
toExecutable dir packageName_ =
inferModules dir packageName_ getMentionedExecutableModules getExecutableModules fromExecutableSection (fromExecutableSection [])
. expandMain
Expand Down
9 changes: 9 additions & 0 deletions test/EndToEndSpec.hs
Original file line number Diff line number Diff line change
Expand Up @@ -77,6 +77,15 @@ spec = around_ (inTempDirectoryNamed "my-package") $ do
default-language: Haskell2010
|]

context "when spec-version is >= 0.36.0" $ do
it "does not add Paths_" $ do
[i|
spec-version: 0.36.0
library: {}
|] `shouldRenderTo` library [i|
default-language: Haskell2010
|]

context "when cabal-version is >= 2" $ do
it "adds Paths_ to autogen-modules" $ do
[i|
Expand Down

0 comments on commit 9a1b938

Please sign in to comment.