More informative error messages

This commit is contained in:
Michael Snoyman 2014-12-07 13:04:02 +02:00
parent b66961d2d8
commit e97ac30568
2 changed files with 34 additions and 8 deletions

View File

@ -37,10 +37,36 @@ checkDeps allPackages (user, pb) =
(dep, Just version)
errMap
where
errMap = singletonMap (user, pbVersion pb) range
errMap = singletonMap pu range
pu = PkgUser
{ puName = user
, puVersion = pbVersion pb
, puMaintainer = pbMaintainer pb
, puGithubPings = pbGithubPings pb
}
data PkgUser = PkgUser
{ puName :: PackageName
, puVersion :: Version
, puMaintainer :: Maybe Maintainer
, puGithubPings :: Set Text
}
deriving (Eq, Ord)
pkgUserShow1 :: PkgUser -> String
pkgUserShow1 PkgUser {..} = concat
[ display puName
, "-"
, display puVersion
]
pkgUserShow2 :: PkgUser -> String
pkgUserShow2 PkgUser {..} = unwords
$ (maybe "No maintainer" (unpack . unMaintainer) puMaintainer ++ ".")
: map (("@" ++) . unpack) (setToList puGithubPings)
newtype BadBuildPlan =
BadBuildPlan (Map (PackageName, Maybe Version) (Map (PackageName, Version) VersionRange)) -- FIXME add maintainer and Github ping info
BadBuildPlan (Map (PackageName, Maybe Version) (Map PkgUser VersionRange))
deriving Typeable
instance Exception BadBuildPlan
instance Show BadBuildPlan where
@ -60,15 +86,14 @@ instance Show BadBuildPlan where
, " depended on by:"
]
showUser :: ((PackageName, Version), VersionRange) -> String
showUser ((user, version), range) = concat
showUser :: (PkgUser, VersionRange) -> String
showUser (pu, range) = concat
[ "- "
, display user
, "-"
, display version
, pkgUserShow1 pu
, " ("
, display range
, ")"
, "). "
, pkgUserShow2 pu
]
instance Monoid BadBuildPlan where

View File

@ -12,4 +12,5 @@ spec = it "works" $ do
bp <- newBuildPlan
let bs = Y.encode bp
mbp' = Y.decode bs
Y.encodeFile "myplan.yaml" bp
mbp' `shouldBe` Just (() <$ bp)