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

Proper compression for orig.tar

Browse Source
This commit is contained in:
Michael Snoyman 2015-05-15 05:49:18 +03:00
parent 54b69cb491
commit 5b228f6e45
1 changed files with 4 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
Stackage/Database/Cron.hs
View File

@ -147,7 +147,9 @@ stackageServerCron = do
createHoogleDB :: StackageDatabase -> Manager -> SnapName -> IO (Maybe FilePath) createHoogleDB :: StackageDatabase -> Manager -> SnapName -> IO (Maybe FilePath)
createHoogleDB db man name = handleAny (\e -> print e $> Nothing) $ do createHoogleDB db man name = handleAny (\e -> print e $> Nothing) $ do
req <- parseUrl $ unpack tarUrl req' <- parseUrl $ unpack tarUrl
let req = req' { decompress = const True }
unlessM (isFile tarFP) $ withResponse req man $ \res -> do unlessM (isFile tarFP) $ withResponse req man $ \res -> do
let tmp = tarFP <.> "tmp" let tmp = tarFP <.> "tmp"
createTree $ parent tmp createTree $ parent tmp
@ -160,7 +162,7 @@ createHoogleDB db man name = handleAny (\e -> print e $> Nothing) $ do
createTree bindir createTree bindir
dbs <- runResourceT dbs <- runResourceT
$ sourceTarFile True (fpToString tarFP) $ sourceTarFile False (fpToString tarFP)
$$ evalStateC 1 (mapMC (singleDB db name bindir)) $$ evalStateC 1 (mapMC (singleDB db name bindir))
=$ sinkList =$ sinkList