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 +7/−5
- src/Hpack.hs +64/−17
- src/Hpack/Config.hs +46/−41
- src/Hpack/Defaults.hs +8/−14
- src/Hpack/Error.hs +59/−0
- src/Hpack/Yaml.hs +20/−12
- src/Imports.hs +1/−0
- test/Hpack/DefaultsSpec.hs +2/−1
- test/HpackSpec.hs +4/−1
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}