Add logging progress in a simple script

This commit is contained in:
Filip Gralinski 2021-02-24 06:55:46 +01:00
parent 8652d087fb
commit c115e31f34

View File

@ -42,16 +42,19 @@ process dbName = do
return (variant, submission, out, test) return (variant, submission, out, test)
Prelude.putStrLn "Adding evaluations…" Prelude.putStrLn "Adding evaluations…"
_ <- mapM (processVariant dbName) variants let total = length variants
putStrLn $ "TOTAL " ++ (show total)
_ <- mapM (\(v, ix) -> processVariant total ix dbName v) $ zip variants [1..]
putStrLn "DELETING" putStrLn "DELETING"
runOnDb dbName $ deleteWhere [EvaluationVersion ==. Nothing] runOnDb dbName $ deleteWhere [EvaluationVersion ==. Nothing]
return () return ()
processVariant :: String -> (Entity Variant, Entity Submission, Entity Out, Entity Test) -> IO () processVariant :: Int -> Int -> String -> (Entity Variant, Entity Submission, Entity Out, Entity Test) -> IO ()
processVariant dbName (variant, Entity _ submission, Entity _ out, Entity testId _) = do processVariant total ix dbName (variant, Entity _ submission, Entity _ out, Entity testId _) = do
Prelude.putStrLn (show $ entityKey variant) Prelude.putStrLn (show $ entityKey variant)
Prelude.putStrLn ((show ix) ++ "/" ++ (show total))
evaluations <- runOnDb dbName evaluations <- runOnDb dbName
$ E.select $ E.from $ \evaluation -> do $ E.select $ E.from $ \evaluation -> do