module Main.Report where
import Control.Monad
import Data.List
import Data.Maybe (fromMaybe)
import Data.Semigroup
import Main.Tasks
import Ideas.Common.Id
import Ideas.Text.HTML
import Ideas.Text.XML
import Ideas.Text.HTML.W3CSS
import Ideas.Encoding.Logging
import Recognize.Data.MathStoryProblem
import Recognize.Data.DiagnoseResult
import Recognize.Data.Diagnosis
import Recognize.Data.Entry
import Recognize.Data.Solution
import System.IO
import Util.Cache
import Util.Table
import Control.Exception
reportDatabase :: FilePath -> FilePath -> IO ()
reportDatabase inFile outFile = do
hSetBuffering stdout NoBuffering
solutions <-
selectFrom inFile "requests" ["rowid","input"] $ \[rowid,txt] -> fallback (rowid, (defaultSolution [], newId "error")) . either error id $ do
xml <- parseXML txt
exid <- newId <$> findAttribute "exerciseid" xml
sol <- findChild "solution" xml >>= fromXML
return (rowid, (sol, exid))
results <-
forM solutions $ \(nr, (sol, exid)) -> fallback (mempty, mempty) . either error id $ do
Task t <- findTask exid
let entry = diagnose t sol
let html = header (string $ '#' : show nr) (string $ show exid)
<> toHTML entry
return (html, countEntry exid entry)
let (outs, counts) = unzip results
writeFile outFile $ showHTML $ w3css $ htmlPage inFile $ mconcat outs
putStrLn ""
print (percentage $ mconcat counts)
fallback :: a -> a -> IO a
fallback def val = do
action <- try (evaluate val)
case action of
Left err -> do
putStrLn "Warning - something went wrong. Continuing with default value. The error was:"
print (err :: SomeException)
return def
Right result' -> return result'
header :: BuildXML a => a -> a -> a
header x y = container $ background DarkGray $
styleA "padding:0" <>
(Ideas.Text.XML.tag "div" . left . padding Medium) x <>
(Ideas.Text.XML.tag "div" . right . padding Medium) y
countEntry :: Id -> Entry -> Tables Count
countEntry n = mconcat . map (countResult n) . diagnoses
countResult :: Id -> DiagnoseResult -> Tables Count
countResult n r =
let i = getInputId (originalInput r)
in count (show i ++ "." ++ show n) . either (const "error") (show . category) . diagnosis $ r