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

Don't overpopulate the Schema table

Browse Source
This commit is contained in:
Michael Snoyman 2018-12-19 08:55:09 +02:00
parent 4f91ac6c73
commit 40e551a6f2
No known key found for this signature in database
GPG Key ID: A048E8C057E86876
1 changed files with 4 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
src/Stackage/Database.hs
View File

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