haskell/stackage-server
1
0
Fork 0
mirror of https://github.com/commercialhaskell/stackage-server.git synced 2026-01-25 02:11:55 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

Better parse error messages #252

Browse Source
This commit is contained in:
Michael Snoyman 2018-03-12 11:27:06 +02:00
parent f732899303
commit 800b8907c8
No known key found for this signature in database
GPG Key ID: A048E8C057E86876
1 changed files with 9 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
src/Stackage/Database.hs
View File

@ -65,7 +65,7 @@ import Stackage.Types
import Stackage.Metadata import Stackage.Metadata
import Stackage.PackageIndex.Conduit import Stackage.PackageIndex.Conduit
import Web.PathPieces (fromPathPiece) import Web.PathPieces (fromPathPiece)
import Data.Yaml (decodeFileEither) import Data.Yaml (decodeFileEither, decodeEither)
import Database.Persist import Database.Persist
import Database.Persist.Postgresql import Database.Persist.Postgresql
import Database.Persist.TH import Database.Persist.TH
@ -316,7 +316,13 @@ getPackageId x = do
addPackage :: Tar.Entry -> SqlPersistT (ResourceT IO) () addPackage :: Tar.Entry -> SqlPersistT (ResourceT IO) ()
addPackage e = addPackage e =
case ("packages/" `isPrefixOf` fp && takeExtension fp == ".yaml", Tar.entryContent e) of case ("packages/" `isPrefixOf` fp && takeExtension fp == ".yaml", Tar.entryContent e) of
(True, Tar.NormalFile lbs _) | Just pi <- decode $ toStrict lbs -> do (True, Tar.NormalFile lbs _) ->
case decodeEither $ toStrict lbs of
Left err -> putStrLn $ "ERROR: Could not parse " ++ tshow fp ++ ": " ++ tshow err
Right pi -> onParse pi
_ -> return ()
where
onParse pi = do
let p = Package let p = Package
{ packageName = pack base { packageName = pack base
, packageLatest = display $ piLatest pi , packageLatest = display $ piLatest pi
@ -341,8 +347,7 @@ addPackage e =
, depUses = display uses , depUses = display uses
, depRange = display range , depRange = display range
} }
_ -> return ()
where
fp = Tar.entryPath e fp = Tar.entryPath e
base = takeBaseName fp base = takeBaseName fp