forge/Vervis
1
0
Fork 0
Code Pull requests Activity

Startup: If repo dir check fails, print both versions of repo tree

Browse source
This commit is contained in:
fr33domlover 2020-05-14 12:11:31 +00:00
parent cac4edc8eb
commit 2063c7313b
1 changed files with 14 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

14
src/Vervis/Application.hs
View file

@ -32,6 +32,7 @@ where
import Control.Concurrent.Chan import Control.Concurrent.Chan
import Control.Concurrent.STM.TVar import Control.Concurrent.STM.TVar
import Control.Exception hiding (Handler)
import Control.Monad import Control.Monad
import Control.Monad.Logger (liftLoc, runLoggingT, logInfo, logError) import Control.Monad.Logger (liftLoc, runLoggingT, logInfo, logError)
import Control.Monad.Trans.Reader import Control.Monad.Trans.Reader
@ -229,10 +230,15 @@ makeFoundation appSettings = do
verifyRepoDir = do verifyRepoDir = do
repos <- lift repoTreeFromDir repos <- lift repoTreeFromDir
repos' <- repoTreeFromDB repos' <- repoTreeFromDB
unless (repos == repos') $ unless (repos == repos') $ liftIO $ do
error "Repo dir check failed!" putStrLn "Repo tree based on filesystem:"
liftIO $ printRepos repos
for_ repos $ \ (shr, rps) -> putStrLn "Repo tree based on database:"
printRepos repos'
throwIO $ userError "Repo dir check failed!"
liftIO $ printRepos repos
where
printRepos = traverse_ $ \ (shr, rps) ->
for_ rps $ \ (rp, vcs) -> for_ rps $ \ (rp, vcs) ->
putStrLn $ putStrLn $
"Found repo " ++ "Found repo " ++