haskell/stackage-server
1
0
Fork 0
mirror of https://github.com/commercialhaskell/stackage-server.git synced 2026-01-29 04:10:24 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

Avoid unnecessarily looking up StackageId in haddock unpacker

Browse Source
This commit is contained in:
Michael Sloan 2014-12-27 20:40:05 -08:00
parent f635977b02
commit eeb0aae9d9
1 changed files with 13 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
Handler/Haddock.hs
View File

@ -314,20 +314,19 @@ createHaddockUnpacker root store runDB' urlRenderRef = do
-- Determine which packages have documentation and update the -- Determine which packages have documentation and update the
-- database appropriately -- database appropriately
runResourceT $ runDB' $ do runResourceT $ runDB' $ do
ment <- getBy $ UniqueStackage ident let sid = entityKey stackageEnt
forM_ ment $ \(Entity sid _) -> do updateWhere
updateWhere [PackageStackage ==. sid]
[PackageStackage ==. sid] [PackageHasHaddocks =. False]
[PackageHasHaddocks =. False] sourceDirectory destdir $$ mapM_C (\fp -> do
sourceDirectory destdir $$ mapM_C (\fp -> do let mnv = nameAndVersionFromPath fp
let mnv = nameAndVersionFromPath fp forM_ mnv $ \(name, version) -> updateWhere
forM_ mnv $ \(name, version) -> updateWhere [ PackageStackage ==. sid
[ PackageStackage ==. sid , PackageName' ==. PackageName name
, PackageName' ==. PackageName name , PackageVersion ==. Version version
, PackageVersion ==. Version version ]
] [PackageHasHaddocks =. True]
[PackageHasHaddocks =. True] )
)
data DocInfo = DocInfo Version (Map Text [Text]) data DocInfo = DocInfo Version (Map Text [Text])
instance FromJSON DocInfo where instance FromJSON DocInfo where