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

Fix Hoogle database download

Browse Source
This commit is contained in:
Michael Snoyman 2015-05-22 09:22:44 +03:00
parent 59fac14f73
commit c7b82f38d0
1 changed files with 5 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
Stackage/Database/Cron.hs
View File

@ -107,7 +107,6 @@ hoogleUrl :: SnapName -> Text
hoogleUrl n = concat hoogleUrl n = concat
[ "https://s3.amazonaws.com/haddock.stackage.org/" [ "https://s3.amazonaws.com/haddock.stackage.org/"
, hoogleKey n , hoogleKey n
, ".gz"
] ]
getHoogleDB :: Bool -- ^ print exceptions? getHoogleDB :: Bool -- ^ print exceptions?
@ -120,11 +119,15 @@ getHoogleDB toPrint man name = do
then return $ Just fp then return $ Just fp
else do else do
req' <- parseUrl $ unpack $ hoogleUrl name req' <- parseUrl $ unpack $ hoogleUrl name
let req = req' { checkStatus = \_ _ _ -> Nothing } let req = req'
{ checkStatus = \_ _ _ -> Nothing
, decompress = const False
}
withResponse req man $ \res -> if responseStatus res == status200 withResponse req man $ \res -> if responseStatus res == status200
then do then do
createTree $ parent fptmp createTree $ parent fptmp
runResourceT $ bodyReaderSource (responseBody res) runResourceT $ bodyReaderSource (responseBody res)
$= ungzip
$$ sinkFile fptmp $$ sinkFile fptmp
rename fptmp fp rename fptmp fp
return $ Just fp return $ Just fp