From eeb0aae9d92622fada6cf3186e21ce60a5f7552e Mon Sep 17 00:00:00 2001
From: Michael Sloan <mgsloan@gmail.com>
Date: Sat, 27 Dec 2014 20:40:05 -0800
Subject: [PATCH] Avoid unnecessarily looking up StackageId in haddock unpacker

---
 Handler/Haddock.hs | 27 +++++++++++++--------------
 1 file changed, 13 insertions(+), 14 deletions(-)

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