packages feed

hpack 0.35.0 → 0.35.1

raw patch · 9 files changed

+211/−91 lines, 9 filesdep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base

API changes (from Hackage documentation)

- Hpack.Config: instance Data.String.IsString Hpack.Config.ProgramName
- Hpack.Config: instance GHC.Classes.Eq Hpack.Config.ProgramName
- Hpack.Config: instance GHC.Show.Show Hpack.Config.ProgramName
+ Hpack: hpackResultWithError :: Options -> IO (Either HpackError Result)
+ Hpack: setFormatYamlParseError :: (FilePath -> ParseException -> String) -> Options -> Options
+ Hpack.Config: [decodeOptionsFormatYamlParseError] :: DecodeOptions -> FilePath -> ParseException -> String
+ Hpack.Config: [unProgramName] :: ProgramName -> String
+ Hpack.Config: readPackageConfigWithError :: DecodeOptions -> IO (Either HpackError DecodeResult)
+ Hpack.Error: CycleInDefaults :: [FilePath] -> HpackError
+ Hpack.Error: DecodeValueError :: FilePath -> String -> HpackError
+ Hpack.Error: DefaultsDownloadFailed :: URL -> Status -> HpackError
+ Hpack.Error: DefaultsFileNotFound :: FilePath -> HpackError
+ Hpack.Error: HpackVersionNotSupported :: FilePath -> Version -> Version -> HpackError
+ Hpack.Error: ParseError :: String -> HpackError
+ Hpack.Error: ProgramName :: String -> ProgramName
+ Hpack.Error: Status :: Int -> ByteString -> Status
+ Hpack.Error: [statusCode] :: Status -> Int
+ Hpack.Error: [statusMessage] :: Status -> ByteString
+ Hpack.Error: [unProgramName] :: ProgramName -> String
+ Hpack.Error: data HpackError
+ Hpack.Error: data Status
+ Hpack.Error: formatHpackError :: ProgramName -> HpackError -> String
+ Hpack.Error: formatStatus :: Status -> String
+ Hpack.Error: instance Data.String.IsString Hpack.Error.ProgramName
+ Hpack.Error: instance GHC.Classes.Eq Hpack.Error.HpackError
+ Hpack.Error: instance GHC.Classes.Eq Hpack.Error.ProgramName
+ Hpack.Error: instance GHC.Show.Show Hpack.Error.HpackError
+ Hpack.Error: instance GHC.Show.Show Hpack.Error.ProgramName
+ Hpack.Error: newtype ProgramName
+ Hpack.Error: type URL = String
+ Hpack.Yaml: data ParseException
+ Hpack.Yaml: decodeYamlWithParseError :: FilePath -> IO (Either ParseException ([String], Value))
+ Hpack.Yaml: formatWarning :: FilePath -> Warning -> String
+ Hpack.Yaml: formatYamlParseError :: FilePath -> ParseException -> String
- Hpack.Config: DecodeOptions :: ProgramName -> FilePath -> Maybe FilePath -> (FilePath -> IO (Either String ([String], Value))) -> DecodeOptions
+ Hpack.Config: DecodeOptions :: ProgramName -> FilePath -> Maybe FilePath -> (FilePath -> IO (Either String ([String], Value))) -> (FilePath -> ParseException -> String) -> DecodeOptions

Files

hpack.cabal view
@@ -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
src/Hpack.hs view
@@ -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) -hpackResultWithVersion :: Version -> Options -> IO Result+hpackResultWithError :: Options -> IO (Either HpackError Result)+hpackResultWithError = hpackResultWithVersion version++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+  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+        status = case force of+          Force -> Generated+          NoForce -> maybe Generated (mkStatus newCabalFile) mExistingCabalFile -  case status of-    Generated -> writeCabalFile options toStdout cabalFileName newCabalFile-    _ -> return ()+      case status of+        Generated -> writeCabalFile options toStdout cabalFileName newCabalFile+        _ -> return () -  return Result {-    resultWarnings = warnings-  , resultCabalFile = cabalFileName-  , resultStatus = status-  }+      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
src/Hpack/Config.hs view
@@ -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))
src/Hpack/Defaults.hs view
@@ -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
+ src/Hpack/Error.hs view
@@ -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
src/Hpack/Yaml.hs view
@@ -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
src/Imports.hs view
@@ -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)
test/Hpack/DefaultsSpec.hs view
@@ -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
test/HpackSpec.hs view
@@ -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}