diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,19 @@ +## Changes in 0.34.0 + - Use `PreferNoHash` as default `GenerateHashStrategy` + - Add support for library `visibility` (see #382) + - Reject URLs for `github` + +## Changes in 0.33.1 + - Add `GenerateHashStrategy`. The default is `PreferHash` for `0.33.0` and + will change to `PreferNoHash` with `0.34.0`. See + https://github.com/sol/hpack/pull/390) for details. + + - Add command-line options `--hash` and `--no-hash` + +## Changes in 0.33.0.1 + - Silently ignore missing hash when the cabal file content didn't change at + all (for forward compatibility with #390) + ## Changes in 0.33.0 - Support GHC 8.8.1: `fail` is no longer a part of `Monad`. Instead, it lives in the `MonadFail` class. Adapting our code to this change meant changing diff --git a/hpack.cabal b/hpack.cabal --- a/hpack.cabal +++ b/hpack.cabal @@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: 3543542c356a8147c78f7d1b3e633d834653cf0d5132754f0751b712e275cc88 +-- hash: 12b7d6619eff1d32190bac55f5a9d29fc4732f7475eb5e450effd690c9f53964 name: hpack -version: 0.33.1 +version: 0.34.0 synopsis: A modern format for Haskell packages description: See README at category: Development diff --git a/src/Hpack.hs b/src/Hpack.hs --- a/src/Hpack.hs +++ b/src/Hpack.hs @@ -100,7 +100,7 @@ let generateHash = case hash of Just True -> ForceHash Just False -> ForceNoHash - Nothing -> PreferHash + Nothing -> PreferNoHash return $ Just (verbose, Options defaultDecodeOptions {decodeOptionsTarget = file} force generateHash toStdout) ParseError -> do printHelp @@ -120,7 +120,7 @@ hpack verbose options = hpackResult options >>= printResult verbose defaultOptions :: Options -defaultOptions = Options defaultDecodeOptions NoForce PreferHash False +defaultOptions = Options defaultDecodeOptions NoForce PreferNoHash False setTarget :: FilePath -> Options -> Options setTarget target options@Options{..} = diff --git a/src/Hpack/Config.hs b/src/Hpack/Config.hs --- a/src/Hpack/Config.hs +++ b/src/Hpack/Config.hs @@ -196,6 +196,7 @@ data LibrarySection = LibrarySection { librarySectionExposed :: Maybe Bool +, librarySectionVisibility :: Maybe String , librarySectionExposedModules :: Maybe (List String) , librarySectionGeneratedExposedModules :: Maybe (List String) , librarySectionOtherModules :: Maybe (List String) @@ -205,12 +206,13 @@ } deriving (Eq, Show, Generic, FromValue) instance Monoid LibrarySection where - mempty = LibrarySection Nothing Nothing Nothing Nothing Nothing Nothing Nothing + mempty = LibrarySection Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing mappend = (<>) instance Semigroup LibrarySection where a <> b = LibrarySection { librarySectionExposed = librarySectionExposed b <|> librarySectionExposed a + , librarySectionVisibility = librarySectionVisibility b <|> librarySectionVisibility a , librarySectionExposedModules = librarySectionExposedModules a <> librarySectionExposedModules b , librarySectionGeneratedExposedModules = librarySectionGeneratedExposedModules a <> librarySectionGeneratedExposedModules b , librarySectionOtherModules = librarySectionOtherModules a <> librarySectionOtherModules b @@ -532,7 +534,7 @@ , packageConfigExtraDocFiles :: Maybe (List FilePath) , packageConfigDataFiles :: Maybe (List FilePath) , packageConfigDataDir :: Maybe FilePath -, packageConfigGithub :: Maybe Text +, packageConfigGithub :: Maybe GitHub , packageConfigGit :: Maybe String , packageConfigCustomSetup :: Maybe CustomSetupSection , packageConfigLibrary :: Maybe library @@ -543,6 +545,20 @@ , packageConfigBenchmarks :: Maybe (Map String executable) } deriving Generic +data GitHub = GitHub { + _gitHubOwner :: String +, _gitHubRepo :: String +, _gitHubSubdir :: Maybe String +} + +instance FromValue GitHub where + fromValue v = do + input <- fromValue v + case map T.unpack $ T.splitOn "/" input of + [owner, repo, subdir] -> return $ GitHub owner repo (Just subdir) + [owner, repo] -> return $ GitHub owner repo Nothing + _ -> fail $ "expected owner/repo or owner/repo/subdir, but encountered " ++ show input + data DefaultsConfig = DefaultsConfig { defaultsConfigDefaults :: Maybe (List Defaults) } deriving (Generic, FromValue) @@ -690,15 +706,14 @@ libraryCabalVersion :: Section Library -> Maybe Version libraryCabalVersion sect = maximum [ - makeVersion [1,22] <$ guard hasReexportedModules - , makeVersion [2,0] <$ guard hasSignatures - , makeVersion [2,0] <$ guard hasGeneratedModules + makeVersion [1,22] <$ guard (has libraryReexportedModules) + , makeVersion [2,0] <$ guard (has librarySignatures) + , makeVersion [2,0] <$ guard (has libraryGeneratedModules) + , makeVersion [3,0] <$ guard (has libraryVisibility) , sectionCabalVersion sect ] where - hasReexportedModules = any (not . null . libraryReexportedModules) sect - hasSignatures = any (not . null . librarySignatures) sect - hasGeneratedModules = any (not . null . libraryGeneratedModules) sect + has field = any (not . null . field) sect internalLibsCabalVersion :: Map String (Section Library) -> Maybe Version internalLibsCabalVersion internalLibraries @@ -852,6 +867,7 @@ data Library = Library { libraryExposed :: Maybe Bool +, libraryVisibility :: Maybe String , libraryExposedModules :: [String] , libraryOtherModules :: [String] , libraryGeneratedModules :: [String] @@ -1147,13 +1163,10 @@ sourceRepository = github <|> (`SourceRepository` Nothing) <$> packageConfigGit github :: Maybe SourceRepository - github = parseGithub <$> packageConfigGithub + github = toSourceRepository <$> packageConfigGithub where - parseGithub :: Text -> SourceRepository - parseGithub input = case map T.unpack $ T.splitOn "/" input of - [owner, repo, subdir] -> - SourceRepository (githubBaseUrl ++ owner ++ "/" ++ repo) (Just subdir) - _ -> SourceRepository (githubBaseUrl ++ T.unpack input) Nothing + toSourceRepository :: GitHub -> SourceRepository + toSourceRepository (GitHub repo owner subdir) = SourceRepository (githubBaseUrl ++ owner ++ "/" ++ repo) subdir homepage :: Maybe String homepage = case packageConfigHomepage of @@ -1218,7 +1231,7 @@ traverseConditionals = traverse . traverse . traverseSectionAndConditionals fConditionals fConditionals getMentionedLibraryModules :: LibrarySection -> [String] -getMentionedLibraryModules (LibrarySection _ exposedModules generatedExposedModules otherModules generatedOtherModules _ _) +getMentionedLibraryModules (LibrarySection _ _ exposedModules generatedExposedModules otherModules generatedOtherModules _ _) = fromMaybeList (exposedModules <> generatedExposedModules <> otherModules <> generatedOtherModules) listModules :: FilePath -> Section a -> IO [String] @@ -1255,7 +1268,7 @@ getLibraryModules Library{..} = libraryExposedModules ++ libraryOtherModules fromLibrarySectionTopLevel pathsModule inferableModules LibrarySection{..} = - Library librarySectionExposed exposedModules otherModules generatedModules reexportedModules signatures + Library librarySectionExposed librarySectionVisibility exposedModules otherModules generatedModules reexportedModules signatures where (exposedModules, otherModules, generatedModules) = determineModules pathsModule inferableModules librarySectionExposedModules librarySectionGeneratedExposedModules librarySectionOtherModules librarySectionGeneratedOtherModules @@ -1271,7 +1284,7 @@ others = maybe ((inferable \\ exposed) ++ pathsModule) fromList mOther ++ fromMaybeList mGeneratedOther fromLibrarySectionInConditional :: [String] -> LibrarySection -> Library -fromLibrarySectionInConditional inferableModules lib@(LibrarySection _ exposedModules _ otherModules _ _ _) = +fromLibrarySectionInConditional inferableModules lib@(LibrarySection _ _ exposedModules _ otherModules _ _ _) = case (exposedModules, otherModules) of (Nothing, Nothing) -> addToOtherModules inferableModules (fromLibrarySectionPlain lib) _ -> fromLibrarySectionPlain lib @@ -1281,6 +1294,7 @@ fromLibrarySectionPlain :: LibrarySection -> Library fromLibrarySectionPlain LibrarySection{..} = Library { libraryExposed = librarySectionExposed + , libraryVisibility = librarySectionVisibility , libraryExposedModules = fromMaybeList (librarySectionExposedModules <> librarySectionGeneratedExposedModules) , libraryOtherModules = fromMaybeList (librarySectionOtherModules <> librarySectionGeneratedOtherModules) , libraryGeneratedModules = fromMaybeList (librarySectionGeneratedOtherModules <> librarySectionGeneratedExposedModules) diff --git a/src/Hpack/Render.hs b/src/Hpack/Render.hs --- a/src/Hpack/Render.hs +++ b/src/Hpack/Render.hs @@ -206,7 +206,8 @@ renderLibraryFields :: Library -> [Element] renderLibraryFields Library{..} = - maybe [] (return . renderExposed) libraryExposed ++ [ + maybe [] (return . renderExposed) libraryExposed ++ + maybe [] (return . renderVisibility) libraryVisibility ++ [ renderExposedModules libraryExposedModules , renderOtherModules libraryOtherModules , renderGeneratedModules libraryGeneratedModules @@ -216,6 +217,9 @@ renderExposed :: Bool -> Element renderExposed = Field "exposed" . Literal . show + +renderVisibility :: String -> Element +renderVisibility = Field "visibility" . Literal renderSection :: (a -> [Element]) -> [Element] -> [Element] -> Section a -> [Element] renderSection renderSectionData extraFieldsStart extraFieldsEnd Section{..} = addVerbatim sectionVerbatim $ diff --git a/test/EndToEndSpec.hs b/test/EndToEndSpec.hs --- a/test/EndToEndSpec.hs +++ b/test/EndToEndSpec.hs @@ -132,6 +132,11 @@ subdir: hspec-core |] + it "rejects URLs" $ do + [i| + 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 "homepage" $ do it "accepts homepage URL" $ do [i| @@ -1134,14 +1139,14 @@ internal-libraries: bar: source-dirs: src - |] `shouldRenderTo` internalLibrary "bar" [i| - exposed-modules: - Foo - other-modules: - Paths_foo - hs-source-dirs: - src - |] + |] `shouldRenderTo` internalLibrary "bar" [i| + exposed-modules: + Foo + other-modules: + Paths_foo + hs-source-dirs: + src + |] it "warns on unknown fields" $ do [i| @@ -1158,6 +1163,17 @@ bar: source-dirs: src |] `shouldWarn` pure "Specified source-dir \"src\" does not exist" + + it "accepts visibility" $ do + [i| + internal-libraries: + bar: + visibility: public + |] `shouldRenderTo` (internalLibrary "bar" [i| + visibility: public + other-modules: + Paths_foo + |]) {packageCabalVersion = "3.0"} describe "executables" $ do it "accepts arbitrary entry points as main" $ do diff --git a/test/Hpack/ConfigSpec.hs b/test/Hpack/ConfigSpec.hs --- a/test/Hpack/ConfigSpec.hs +++ b/test/Hpack/ConfigSpec.hs @@ -54,7 +54,7 @@ executable main_ = Executable (Just main_) ["Paths_foo"] [] library :: Library -library = Library Nothing [] ["Paths_foo"] [] [] [] +library = Library Nothing Nothing [] ["Paths_foo"] [] [] [] testDecodeOptions :: FilePath -> DecodeOptions testDecodeOptions file = defaultDecodeOptions {decodeOptionsTarget = file, decodeOptionsUserDataDir = Just undefined} @@ -90,6 +90,7 @@ let sect = LibrarySection { librarySectionExposed = Nothing + , librarySectionVisibility = Nothing , librarySectionExposedModules = Nothing , librarySectionGeneratedExposedModules = Nothing , librarySectionOtherModules = Nothing @@ -99,6 +100,7 @@ } lib = Library { libraryExposed = Nothing + , libraryVisibility = Nothing , libraryExposedModules = [] , libraryOtherModules = [] , libraryGeneratedModules = [] diff --git a/test/Hpack/RenderSpec.hs b/test/Hpack/RenderSpec.hs --- a/test/Hpack/RenderSpec.hs +++ b/test/Hpack/RenderSpec.hs @@ -12,7 +12,7 @@ import Hpack.Render library :: Library -library = Library Nothing [] [] [] [] [] +library = Library Nothing Nothing [] [] [] [] [] executable :: Section Executable executable = section (Executable (Just "Main.hs") [] [])