From 40e551a6f2627e87a0f4c1f2cb1dacc2fca6ef1b Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Wed, 19 Dec 2018 08:55:09 +0200
Subject: [PATCH] Don't overpopulate the Schema table

---
 src/Stackage/Database.hs | 7 ++++---
 1 file changed, 4 insertions(+), 3 deletions(-)

diff --git a/src/Stackage/Database.hs b/src/Stackage/Database.hs
index 489f271..0812fa2 100644
--- a/src/Stackage/Database.hs
+++ b/src/Stackage/Database.hs
@@ -224,8 +224,7 @@ openStackageDatabase pg = liftIO $ do
 getSchema :: PostgresConf -> IO (Maybe Int)
 getSchema fp = do
     StackageDatabase pool <- openStackageDatabase fp
-    eres <- tryAny $ runSqlPool (selectList [] []) pool
-    putStrLn $ "getSchema result: " ++ tshow eres
+    eres <- tryAny $ runSqlPool (selectList [] [Desc SchemaVal, LimitTo 1]) pool
     case eres of
         Right [Entity _ (Schema v)] -> return $ Just v
         _ -> return Nothing
@@ -241,7 +240,9 @@ createStackageDatabase fp = liftIO $ do
     StackageDatabase pool <- openStackageDatabase fp
     flip runSqlPool pool $ do
         runMigration migrateAll
-        unless schemaMatch $ insert_ $ Schema currentSchema
+        unless schemaMatch $ do
+          deleteWhere ([] :: [Filter Schema])
+          insert_ $ Schema currentSchema
 
     root <- liftIO $ (</> "database") <$> getAppUserDataDirectory "stackage"
     createDirectoryIfMissing True root