Script 'mail_helper' called by obssrc Hello community, here is the log from the commit of package hpack for openSUSE:Factory checked in at 2023-01-18 13:11:12 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/hpack (Old) and /work/SRC/openSUSE:Factory/.hpack.new.32243 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "hpack" Wed Jan 18 13:11:12 2023 rev:27 rq:1059139 version:0.35.1 Changes: -------- --- /work/SRC/openSUSE:Factory/hpack/hpack.changes 2022-10-13 15:45:03.775079671 +0200 +++ /work/SRC/openSUSE:Factory/.hpack.new.32243/hpack.changes 2023-01-18 13:11:37.337037469 +0100 @@ -1,0 +2,7 @@ +Sun Dec 11 23:09:37 UTC 2022 - Peter Simons <[email protected]> + +- Update hpack to version 0.35.1. + Upstream has not updated the file "CHANGELOG.md" since the last + release. + +------------------------------------------------------------------- Old: ---- hpack-0.35.0.tar.gz hpack.cabal New: ---- hpack-0.35.1.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ hpack.spec ++++++ --- /var/tmp/diff_new_pack.Yrw2vR/_old 2023-01-18 13:11:37.937039794 +0100 +++ /var/tmp/diff_new_pack.Yrw2vR/_new 2023-01-18 13:11:37.941039810 +0100 @@ -19,13 +19,12 @@ %global pkg_name hpack %bcond_with tests Name: %{pkg_name} -Version: 0.35.0 +Version: 0.35.1 Release: 0 Summary: A modern format for Haskell packages License: MIT URL: https://hackage.haskell.org/package/%{name} Source0: https://hackage.haskell.org/package/%{name}-%{version}/%{name}-%{version}.tar.gz -Source1: https://hackage.haskell.org/package/%{name}-%{version}/revision/1.cabal#/%{name}.cabal BuildRequires: chrpath BuildRequires: ghc-Cabal-devel BuildRequires: ghc-Glob-devel @@ -81,7 +80,6 @@ %prep %autosetup -cp -p %{SOURCE1} %{name}.cabal %build %ghc_lib_build ++++++ hpack-0.35.0.tar.gz -> hpack-0.35.1.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hpack-0.35.0/hpack.cabal new/hpack-0.35.1/hpack.cabal --- old/hpack-0.35.0/hpack.cabal 2001-09-09 03:46:40.000000000 +0200 +++ new/hpack-0.35.1/hpack.cabal 2001-09-09 03:46:40.000000000 +0200 @@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.7. +-- This file has been generated from package.yaml by hpack version 0.35.0. -- -- see: https://github.com/sol/hpack name: hpack -version: 0.35.0 +version: 0.35.1 synopsis: A modern format for Haskell packages description: See README at <https://github.com/sol/hpack#readme> category: Development @@ -27,7 +27,7 @@ src ghc-options: -Wall -fno-warn-incomplete-uni-patterns build-depends: - Cabal >=3.0.0.0 && <3.7 + Cabal >=3.0.0.0 && <3.9 , Glob >=0.9.0 , aeson >=1.4.3.0 , base >=4.9 && <5 @@ -54,6 +54,7 @@ Hpack.Config Hpack.Render Hpack.Yaml + Hpack.Error other-modules: Data.Aeson.Config.FromValue Data.Aeson.Config.Key @@ -88,7 +89,7 @@ driver ghc-options: -Wall -fno-warn-incomplete-uni-patterns build-depends: - Cabal >=3.0.0.0 && <3.7 + Cabal >=3.0.0.0 && <3.9 , Glob >=0.9.0 , aeson >=1.4.3.0 , base >=4.9 && <5 @@ -124,7 +125,7 @@ ghc-options: -Wall -fno-warn-incomplete-uni-patterns cpp-options: -DTEST build-depends: - Cabal >=3.0.0.0 && <3.7 + Cabal >=3.0.0.0 && <3.9 , Glob >=0.9.0 , HUnit >=1.6.0.0 , QuickCheck @@ -188,6 +189,7 @@ Hpack.CabalFile Hpack.Config Hpack.Defaults + Hpack.Error Hpack.Haskell Hpack.License Hpack.Module diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hpack-0.35.0/src/Hpack/Config.hs new/hpack-0.35.1/src/Hpack/Config.hs --- old/hpack-0.35.0/src/Hpack/Config.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/hpack-0.35.1/src/Hpack/Config.hs 2001-09-09 03:46:40.000000000 +0200 @@ -33,6 +33,7 @@ , packageConfig , DecodeResult(..) , readPackageConfig +, readPackageConfigWithError , renamePackage , packageDependencies @@ -112,6 +113,7 @@ import Data.Aeson.Config.FromValue hiding (decodeValue) import qualified Data.Aeson.Config.FromValue as Config +import Hpack.Error import Hpack.Syntax.Defaults import Hpack.Util hiding (expandGlobs) import qualified Hpack.Util as Util @@ -631,29 +633,29 @@ instance FromValue ParsePackageConfig type Warnings m = WriterT [String] m -type Errors = ExceptT String +type Errors = ExceptT HpackError -decodeYaml :: FromValue a => ProgramName -> FilePath -> Warnings (Errors IO) a -decodeYaml programName file = do - (warnings, a) <- lift (ExceptT $ Yaml.decodeYaml file) +liftEither :: IO (Either HpackError a) -> Warnings (Errors IO) a +liftEither = lift . ExceptT + +type FormatYamlParseError = FilePath -> Yaml.ParseException -> String + +decodeYaml :: FromValue a => FormatYamlParseError -> FilePath -> Warnings (Errors IO) a +decodeYaml formatYamlParseError file = do + (warnings, a) <- liftEither $ first (ParseError . formatYamlParseError file) <$> Yaml.decodeYamlWithParseError file tell warnings - decodeValue programName file a + decodeValue file a data DecodeOptions = DecodeOptions { decodeOptionsProgramName :: ProgramName , decodeOptionsTarget :: FilePath , decodeOptionsUserDataDir :: Maybe FilePath , decodeOptionsDecode :: FilePath -> IO (Either String ([String], Value)) +, decodeOptionsFormatYamlParseError :: FilePath -> Yaml.ParseException -> String } -newtype ProgramName = ProgramName String - deriving (Eq, Show) - -instance IsString ProgramName where - fromString = ProgramName - defaultDecodeOptions :: DecodeOptions -defaultDecodeOptions = DecodeOptions "hpack" packageConfig Nothing Yaml.decodeYaml +defaultDecodeOptions = DecodeOptions "hpack" packageConfig Nothing Yaml.decodeYaml Yaml.formatYamlParseError data DecodeResult = DecodeResult { decodeResultPackage :: Package @@ -663,13 +665,16 @@ } deriving (Eq, Show) readPackageConfig :: DecodeOptions -> IO (Either String DecodeResult) -readPackageConfig (DecodeOptions programName file mUserDataDir readValue) = runExceptT $ fmap addCabalFile . runWriterT $ do - (warnings, value) <- lift . ExceptT $ readValue file +readPackageConfig options = first (formatHpackError $ decodeOptionsProgramName options) <$> readPackageConfigWithError options + +readPackageConfigWithError :: DecodeOptions -> IO (Either HpackError DecodeResult) +readPackageConfigWithError (DecodeOptions _ file mUserDataDir readValue formatYamlParseError) = runExceptT $ fmap addCabalFile . runWriterT $ do + (warnings, value) <- liftEither $ first ParseError <$> readValue file tell warnings - config <- decodeValue programName file value + config <- decodeValue file value dir <- liftIO $ takeDirectory <$> canonicalizePath file userDataDir <- liftIO $ maybe (getAppUserDataDirectory "hpack") return mUserDataDir - toPackage programName userDataDir dir config + toPackage formatYamlParseError userDataDir dir config where addCabalFile :: ((Package, String), [String]) -> DecodeResult addCabalFile ((pkg, cabalVersion), warnings) = DecodeResult pkg cabalVersion (takeDirectory_ file </> (packageName pkg ++ ".cabal")) warnings @@ -890,12 +895,12 @@ sectionAll :: (Semigroup b, Monoid b) => (Section a -> b) -> Section a -> b sectionAll f sect = f sect <> foldMap (foldMap $ sectionAll f) (sectionConditionals sect) -decodeValue :: FromValue a => ProgramName -> FilePath -> Value -> Warnings (Errors IO) a -decodeValue (ProgramName programName) file value = do - (r, unknown, deprecated) <- lift . ExceptT . return $ first (prefix ++) (Config.decodeValue value) +decodeValue :: FromValue a => FilePath -> Value -> Warnings (Errors IO) a +decodeValue file value = do + (r, unknown, deprecated) <- liftEither . return $ first (DecodeValueError file) (Config.decodeValue value) case r of UnsupportedSpecVersion v -> do - lift $ throwE ("The file " ++ file ++ " requires version " ++ showVersion v ++ " of the Hpack package specification, however this version of " ++ programName ++ " only supports versions up to " ++ showVersion Hpack.version ++ ". Upgrading to the latest version of " ++ programName ++ " may resolve this issue.") + lift . throwE $ HpackVersionNotSupported file v Hpack.version SupportedSpecVersion a -> do tell (map formatUnknownField unknown) tell (map formatDeprecatedField deprecated) @@ -1049,9 +1054,9 @@ type CommonOptionsWithDefaults a = Product DefaultsConfig (CommonOptions ParseCSources ParseCxxSources ParseJsSources a) type WithCommonOptionsWithDefaults a = Product DefaultsConfig (WithCommonOptions ParseCSources ParseCxxSources ParseJsSources a) -toPackage :: ProgramName -> FilePath -> FilePath -> ConfigWithDefaults -> Warnings (Errors IO) (Package, String) -toPackage programName userDataDir dir = - expandDefaultsInConfig programName userDataDir dir +toPackage :: FormatYamlParseError -> FilePath -> FilePath -> ConfigWithDefaults -> Warnings (Errors IO) (Package, String) +toPackage formatYamlParseError userDataDir dir = + expandDefaultsInConfig formatYamlParseError userDataDir dir >=> setDefaultLanguage "Haskell2010" >>> traverseConfig (expandForeignSources dir) >=> toPackage_ dir @@ -1061,35 +1066,35 @@ setLanguage = (mempty { commonOptionsLanguage = Alias . Last $ Just (Just language) } <>) expandDefaultsInConfig - :: ProgramName + :: FormatYamlParseError -> FilePath -> FilePath -> ConfigWithDefaults -> Warnings (Errors IO) (Config ParseCSources ParseCxxSources ParseJsSources) -expandDefaultsInConfig programName userDataDir dir = bitraverse (expandGlobalDefaults programName userDataDir dir) (expandSectionDefaults programName userDataDir dir) +expandDefaultsInConfig formatYamlParseError userDataDir dir = bitraverse (expandGlobalDefaults formatYamlParseError userDataDir dir) (expandSectionDefaults formatYamlParseError userDataDir dir) expandGlobalDefaults - :: ProgramName + :: FormatYamlParseError -> FilePath -> FilePath -> CommonOptionsWithDefaults Empty -> Warnings (Errors IO) (CommonOptions ParseCSources ParseCxxSources ParseJsSources Empty) -expandGlobalDefaults programName userDataDir dir = do - fmap (`Product` Empty) >>> expandDefaults programName userDataDir dir >=> \ (Product c Empty) -> return c +expandGlobalDefaults formatYamlParseError userDataDir dir = do + fmap (`Product` Empty) >>> expandDefaults formatYamlParseError userDataDir dir >=> \ (Product c Empty) -> return c expandSectionDefaults - :: ProgramName + :: FormatYamlParseError -> FilePath -> FilePath -> PackageConfigWithDefaults ParseCSources ParseCxxSources ParseJsSources -> Warnings (Errors IO) (PackageConfig ParseCSources ParseCxxSources ParseJsSources) -expandSectionDefaults programName userDataDir dir p@PackageConfig{..} = do - library <- traverse (expandDefaults programName userDataDir dir) packageConfigLibrary - internalLibraries <- traverse (traverse (expandDefaults programName userDataDir dir)) packageConfigInternalLibraries - executable <- traverse (expandDefaults programName userDataDir dir) packageConfigExecutable - executables <- traverse (traverse (expandDefaults programName userDataDir dir)) packageConfigExecutables - tests <- traverse (traverse (expandDefaults programName userDataDir dir)) packageConfigTests - benchmarks <- traverse (traverse (expandDefaults programName userDataDir dir)) packageConfigBenchmarks +expandSectionDefaults formatYamlParseError userDataDir dir p@PackageConfig{..} = do + library <- traverse (expandDefaults formatYamlParseError userDataDir dir) packageConfigLibrary + internalLibraries <- traverse (traverse (expandDefaults formatYamlParseError userDataDir dir)) packageConfigInternalLibraries + executable <- traverse (expandDefaults formatYamlParseError userDataDir dir) packageConfigExecutable + executables <- traverse (traverse (expandDefaults formatYamlParseError userDataDir dir)) packageConfigExecutables + tests <- traverse (traverse (expandDefaults formatYamlParseError userDataDir dir)) packageConfigTests + benchmarks <- traverse (traverse (expandDefaults formatYamlParseError userDataDir dir)) packageConfigBenchmarks return p{ packageConfigLibrary = library , packageConfigInternalLibraries = internalLibraries @@ -1101,12 +1106,12 @@ expandDefaults :: (FromValue a, Semigroup a, Monoid a) - => ProgramName + => FormatYamlParseError -> FilePath -> FilePath -> WithCommonOptionsWithDefaults a -> Warnings (Errors IO) (WithCommonOptions ParseCSources ParseCxxSources ParseJsSources a) -expandDefaults programName userDataDir = expand [] +expandDefaults formatYamlParseError userDataDir = expand [] where expand :: (FromValue a, Semigroup a, Monoid a) => [FilePath] @@ -1123,17 +1128,17 @@ -> Defaults -> Warnings (Errors IO) (WithCommonOptions ParseCSources ParseCxxSources ParseJsSources a) get seen dir defaults = do - file <- lift $ ExceptT (ensure userDataDir dir defaults) + file <- liftEither (ensure userDataDir dir defaults) seen_ <- lift (checkCycle seen file) let dir_ = takeDirectory file - decodeYaml programName file >>= expand seen_ dir_ + decodeYaml formatYamlParseError file >>= expand seen_ dir_ checkCycle :: [FilePath] -> FilePath -> Errors IO [FilePath] checkCycle seen file = do canonic <- liftIO $ canonicalizePath file let seen_ = canonic : seen when (canonic `elem` seen) $ do - throwE ("cycle in defaults (" ++ intercalate " -> " (reverse seen_) ++ ")") + throwE $ CycleInDefaults (reverse seen_) return seen_ toExecutableMap :: Monad m => String -> Maybe (Map String a) -> Maybe a -> Warnings m (Maybe (Map String a)) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hpack-0.35.0/src/Hpack/Defaults.hs new/hpack-0.35.1/src/Hpack/Defaults.hs --- old/hpack-0.35.0/src/Hpack/Defaults.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/hpack-0.35.1/src/Hpack/Defaults.hs 2001-09-09 03:46:40.000000000 +0200 @@ -14,18 +14,15 @@ import Imports -import Network.HTTP.Types import Network.HTTP.Client import Network.HTTP.Client.TLS import qualified Data.ByteString.Lazy as LB -import qualified Data.ByteString.Char8 as B import System.FilePath import System.Directory +import Hpack.Error import Hpack.Syntax.Defaults -type URL = String - defaultsUrl :: Github -> URL defaultsUrl Github{..} = "https://raw.githubusercontent.com/"; ++ githubOwner ++ "/" ++ githubRepo ++ "/" ++ githubRef ++ "/" ++ intercalate "/" githubPath @@ -33,7 +30,7 @@ defaultsCachePath dir Github{..} = joinPath $ dir : "defaults" : githubOwner : githubRepo : githubRef : githubPath -data Result = Found | NotFound | Failed String +data Result = Found | NotFound | Failed Status deriving (Eq, Show) get :: URL -> FilePath -> IO Result @@ -47,12 +44,9 @@ LB.writeFile file (responseBody response) return Found Status 404 _ -> return NotFound - status -> return (Failed $ "Error while downloading " ++ url ++ " (" ++ formatStatus status ++ ")") - -formatStatus :: Status -> String -formatStatus (Status code message) = show code ++ " " ++ B.unpack message + status -> return (Failed status) -ensure :: FilePath -> FilePath -> Defaults -> IO (Either String FilePath) +ensure :: FilePath -> FilePath -> Defaults -> IO (Either HpackError FilePath) ensure userDataDir dir = \ case DefaultsGithub defaults -> do let @@ -60,14 +54,14 @@ file = defaultsCachePath userDataDir defaults ensureFile file url >>= \ case Found -> return (Right file) - NotFound -> return (Left $ notFound url) - Failed err -> return (Left err) + NotFound -> notFound url + Failed status -> return (Left $ DefaultsDownloadFailed url status) DefaultsLocal (Local ((dir </>) -> file)) -> do doesFileExist file >>= \ case True -> return (Right file) - False -> return (Left $ notFound file) + False -> notFound file where - notFound file = "Invalid value for \"defaults\"! File " ++ file ++ " does not exist!" + notFound = return . Left . DefaultsFileNotFound ensureFile :: FilePath -> URL -> IO Result ensureFile file url = do diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hpack-0.35.0/src/Hpack/Error.hs new/hpack-0.35.1/src/Hpack/Error.hs --- old/hpack-0.35.0/src/Hpack/Error.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/hpack-0.35.1/src/Hpack/Error.hs 2001-09-09 03:46:40.000000000 +0200 @@ -0,0 +1,59 @@ +{-# LANGUAGE LambdaCase #-} +module Hpack.Error ( +-- | /__NOTE:__/ This module is exposed to allow integration of Hpack into +-- other tools. It is not meant for general use by end users. The following +-- caveats apply: +-- +-- * The API is undocumented, consult the source instead. +-- +-- * The exposed types and functions primarily serve Hpack's own needs, not +-- that of a public API. Breaking changes can happen as Hpack evolves. +-- +-- As an Hpack user you either want to use the @hpack@ executable or a build +-- tool that supports Hpack (e.g. @stack@ or @cabal2nix@). + HpackError (..) +, formatHpackError +, ProgramName (..) +, URL +, Status (..) +, formatStatus +) where + +import qualified Data.ByteString.Char8 as B +import Data.List (intercalate) +import Data.String (IsString (..)) +import Data.Version (Version (..), showVersion) +import Network.HTTP.Types.Status (Status (..)) + +type URL = String + +data HpackError = + HpackVersionNotSupported FilePath Version Version + | DefaultsFileNotFound FilePath + | DefaultsDownloadFailed URL Status + | CycleInDefaults [FilePath] + | ParseError String + | DecodeValueError FilePath String + deriving (Eq, Show) + +newtype ProgramName = ProgramName {unProgramName :: String} + deriving (Eq, Show) + +instance IsString ProgramName where + fromString = ProgramName + +formatHpackError :: ProgramName -> HpackError -> String +formatHpackError (ProgramName progName) = \ case + HpackVersionNotSupported file wanted supported -> + "The file " ++ file ++ " requires version " ++ showVersion wanted ++ + " of the Hpack package specification, however this version of " ++ + progName ++ " only supports versions up to " ++ showVersion supported ++ + ". Upgrading to the latest version of " ++ progName ++ " may resolve this issue." + DefaultsFileNotFound file -> "Invalid value for \"defaults\"! File " ++ file ++ " does not exist!" + DefaultsDownloadFailed url status -> "Error while downloading " ++ url ++ " (" ++ formatStatus status ++ ")" + CycleInDefaults files -> "cycle in defaults (" ++ intercalate " -> " files ++ ")" + ParseError err -> err + DecodeValueError file err -> file ++ ": " ++ err + +formatStatus :: Status -> String +formatStatus (Status code message) = show code ++ " " ++ B.unpack message diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hpack-0.35.0/src/Hpack/Yaml.hs new/hpack-0.35.1/src/Hpack/Yaml.hs --- old/hpack-0.35.0/src/Hpack/Yaml.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/hpack-0.35.1/src/Hpack/Yaml.hs 2001-09-09 03:46:40.000000000 +0200 @@ -14,6 +14,10 @@ -- tool that supports Hpack (e.g. @stack@ or @cabal2nix@). decodeYaml +, decodeYamlWithParseError +, ParseException +, formatYamlParseError +, formatWarning , module Data.Aeson.Config.FromValue ) where @@ -25,18 +29,22 @@ import Data.Aeson.Config.FromValue import Data.Aeson.Config.Parser (fromAesonPath, formatPath) +decodeYaml :: FilePath -> IO (Either String ([String], Value)) +decodeYaml file = first (formatYamlParseError file) <$> decodeYamlWithParseError file + +decodeYamlWithParseError :: FilePath -> IO (Either ParseException ([String], Value)) +decodeYamlWithParseError file = do + result <- decodeFileWithWarnings file + return $ fmap (first (map $ formatWarning file)) result + +formatYamlParseError :: FilePath -> ParseException -> String +formatYamlParseError file err = file ++ case err of + AesonException e -> ": " ++ e + InvalidYaml (Just (YamlException s)) -> ": " ++ s + InvalidYaml (Just (YamlParseException{..})) -> ":" ++ show yamlLine ++ ":" ++ show yamlColumn ++ ": " ++ yamlProblem ++ " " ++ yamlContext + where YamlMark{..} = yamlProblemMark + _ -> ": " ++ displayException err + formatWarning :: FilePath -> Warning -> String formatWarning file = \ case DuplicateKey path -> file ++ ": Duplicate field " ++ formatPath (fromAesonPath path) - -decodeYaml :: FilePath -> IO (Either String ([String], Value)) -decodeYaml file = do - result <- decodeFileWithWarnings file - return $ either (Left . errToString) (Right . first (map $ formatWarning file)) result - where - errToString err = file ++ case err of - AesonException e -> ": " ++ e - InvalidYaml (Just (YamlException s)) -> ": " ++ s - InvalidYaml (Just (YamlParseException{..})) -> ":" ++ show yamlLine ++ ":" ++ show yamlColumn ++ ": " ++ yamlProblem ++ " " ++ yamlContext - where YamlMark{..} = yamlProblemMark - _ -> ": " ++ show err diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hpack-0.35.0/src/Hpack.hs new/hpack-0.35.1/src/Hpack.hs --- old/hpack-0.35.0/src/Hpack.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/hpack-0.35.1/src/Hpack.hs 2001-09-09 03:46:40.000000000 +0200 @@ -1,6 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE LambdaCase #-} module Hpack ( -- | /__NOTE:__/ This module is exposed to allow integration of Hpack into -- other tools. It is not meant for general use by end users. The following @@ -20,6 +21,7 @@ -- * Running Hpack , hpack , hpackResult +, hpackResultWithError , printResult , Result(..) , Status(..) @@ -29,6 +31,7 @@ , setProgramName , setTarget , setDecode +, setFormatYamlParseError , getOptions , Verbose(..) , Options(..) @@ -56,10 +59,12 @@ import Paths_hpack (version) import Hpack.Options import Hpack.Config +import Hpack.Error (HpackError, formatHpackError) import Hpack.Render import Hpack.Util import Hpack.Utf8 as Utf8 import Hpack.CabalFile +import qualified Data.Yaml as Yaml programVersion :: Maybe Version -> String programVersion Nothing = "hpack" @@ -135,6 +140,41 @@ setDecode decode options@Options{..} = options {optionsDecodeOptions = optionsDecodeOptions {decodeOptionsDecode = decode}} +-- | This is used to format any `Yaml.ParseException`s encountered during +-- decoding of <https://github.com/sol/hpack#defaults defaults>. +-- +-- Note that: +-- +-- 1. This is not used to format `Yaml.ParseException`s encountered during +-- decoding of the main @package.yaml@. To customize this you have to set a +-- custom decode function. +-- +-- 2. Some of the constructors of `Yaml.ParseException` are never produced by +-- Hpack (e.g. `Yaml.AesonException` as Hpack uses it's own mechanism to decode +-- `Yaml.Value`s). +-- +-- Example: +-- +-- @ +-- example :: IO (Either `HpackError` `Result`) +-- example = `hpackResultWithError` options +-- where +-- options :: `Options` +-- options = setCustomYamlParseErrorFormat format `defaultOptions` +-- +-- format :: FilePath -> `Yaml.ParseException` -> String +-- format file err = file ++ ": " ++ displayException err +-- +-- setCustomYamlParseErrorFormat :: (FilePath -> `Yaml.ParseException` -> String) -> `Options` -> `Options` +-- setCustomYamlParseErrorFormat format = `setDecode` decode >>> `setFormatYamlParseError` format +-- where +-- decode :: FilePath -> IO (Either String ([String], Value)) +-- decode file = first (format file) \<$> `Hpack.Yaml.decodeYamlWithParseError` file +-- @ +setFormatYamlParseError :: (FilePath -> Yaml.ParseException -> String) -> Options -> Options +setFormatYamlParseError formatYamlParseError options@Options{..} = + options {optionsDecodeOptions = optionsDecodeOptions {decodeOptionsFormatYamlParseError = formatYamlParseError}} + data Result = Result { resultWarnings :: [String] , resultCabalFile :: String @@ -188,28 +228,35 @@ calculateHash (CabalFile cabalVersion _ _ body) = sha256 (unlines $ cabalVersion ++ body) hpackResult :: Options -> IO Result -hpackResult = hpackResultWithVersion version +hpackResult opts = hpackResultWithError opts >>= either (die . formatHpackError programName) return + where + programName = decodeOptionsProgramName (optionsDecodeOptions opts) + +hpackResultWithError :: Options -> IO (Either HpackError Result) +hpackResultWithError = hpackResultWithVersion version -hpackResultWithVersion :: Version -> Options -> IO Result +hpackResultWithVersion :: Version -> Options -> IO (Either HpackError Result) hpackResultWithVersion v (Options options force generateHashStrategy toStdout) = do - DecodeResult pkg (lines -> cabalVersion) cabalFileName warnings <- readPackageConfig options >>= either die return - mExistingCabalFile <- readCabalFile cabalFileName - let - newCabalFile = makeCabalFile generateHashStrategy mExistingCabalFile cabalVersion v pkg - - status = case force of - Force -> Generated - NoForce -> maybe Generated (mkStatus newCabalFile) mExistingCabalFile - - case status of - Generated -> writeCabalFile options toStdout cabalFileName newCabalFile - _ -> return () - - return Result { - resultWarnings = warnings - , resultCabalFile = cabalFileName - , resultStatus = status - } + readPackageConfigWithError options >>= \ case + Right (DecodeResult pkg (lines -> cabalVersion) cabalFileName warnings) -> do + mExistingCabalFile <- readCabalFile cabalFileName + let + newCabalFile = makeCabalFile generateHashStrategy mExistingCabalFile cabalVersion v pkg + + status = case force of + Force -> Generated + NoForce -> maybe Generated (mkStatus newCabalFile) mExistingCabalFile + + case status of + Generated -> writeCabalFile options toStdout cabalFileName newCabalFile + _ -> return () + + return $ Right Result { + resultWarnings = warnings + , resultCabalFile = cabalFileName + , resultStatus = status + } + Left err -> return $ Left err writeCabalFile :: DecodeOptions -> Bool -> FilePath -> CabalFile -> IO () writeCabalFile options toStdout name cabalFile = do diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hpack-0.35.0/src/Imports.hs new/hpack-0.35.1/src/Imports.hs --- old/hpack-0.35.0/src/Imports.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/hpack-0.35.1/src/Imports.hs 2001-09-09 03:46:40.000000000 +0200 @@ -2,6 +2,7 @@ import Control.Applicative as Imports import Control.Arrow as Imports ((>>>), (&&&)) +import Control.Exception as Imports (Exception(..)) import Control.Monad as Imports import Data.Bifunctor as Imports import Data.List as Imports hiding (sort, nub) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hpack-0.35.0/test/Hpack/DefaultsSpec.hs new/hpack-0.35.1/test/Hpack/DefaultsSpec.hs --- old/hpack-0.35.0/test/Hpack/DefaultsSpec.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/hpack-0.35.1/test/Hpack/DefaultsSpec.hs 2001-09-09 03:46:40.000000000 +0200 @@ -4,6 +4,7 @@ import Helper import System.Directory +import Hpack.Error import Hpack.Syntax.Defaults import Hpack.Defaults @@ -12,7 +13,7 @@ describe "ensure" $ do it "fails when local file does not exist" $ do cwd <- getCurrentDirectory - let expected = Left $ "Invalid value for \"defaults\"! File " ++ (cwd </> "foo") ++ " does not exist!" + let expected = Left (DefaultsFileNotFound $ cwd </> "foo") ensure undefined cwd (DefaultsLocal $ Local "foo") `shouldReturn` expected describe "ensureFile" $ do diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hpack-0.35.0/test/HpackSpec.hs new/hpack-0.35.1/test/HpackSpec.hs --- old/hpack-0.35.0/test/HpackSpec.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/hpack-0.35.1/test/HpackSpec.hs 2001-09-09 03:46:40.000000000 +0200 @@ -1,14 +1,17 @@ +{-# LANGUAGE OverloadedStrings #-} module HpackSpec (spec) where import Helper import Prelude hiding (readFile) import qualified Prelude as Prelude +import System.Exit (die) import Control.DeepSeq import Hpack.Config import Hpack.CabalFile +import Hpack.Error (formatHpackError) import Hpack hiding (hpack) readFile :: FilePath -> IO String @@ -55,7 +58,7 @@ let file = "foo.cabal" - hpackWithVersion v = hpackResultWithVersion (makeVersion v) defaultOptions + hpackWithVersion v = hpackResultWithVersion (makeVersion v) defaultOptions >>= either (die . formatHpackError "hpack") return hpackWithStrategy strategy = hpackResult defaultOptions { optionsGenerateHashStrategy = strategy } hpackForce = hpackResult defaultOptions {optionsForce = Force}
