Startup: If repo dir check fails, print both versions of repo tree
This commit is contained in:
parent
cac4edc8eb
commit
2063c7313b
1 changed files with 14 additions and 8 deletions
|
@ -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,14 +230,19 @@ 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:"
|
||||||
for_ rps $ \ (rp, vcs) ->
|
printRepos repos'
|
||||||
putStrLn $
|
throwIO $ userError "Repo dir check failed!"
|
||||||
"Found repo " ++
|
liftIO $ printRepos repos
|
||||||
shr ++ " / " ++ rp ++ " [" ++ show vcs ++ "]"
|
where
|
||||||
|
printRepos = traverse_ $ \ (shr, rps) ->
|
||||||
|
for_ rps $ \ (rp, vcs) ->
|
||||||
|
putStrLn $
|
||||||
|
"Found repo " ++
|
||||||
|
shr ++ " / " ++ rp ++ " [" ++ show vcs ++ "]"
|
||||||
repoTreeFromDir = do
|
repoTreeFromDir = do
|
||||||
dir <- askRepoRootDir
|
dir <- askRepoRootDir
|
||||||
outers <- liftIO $ listDirectory dir
|
outers <- liftIO $ listDirectory dir
|
||||||
|
|
Loading…
Reference in a new issue