{-# LANGUAGE FlexibleInstances #-}
module Service.AdviseMe (runService, adviseMeDr, runDomainReasoner) where
import Database.SQLite.Simple.ToField
import Ideas.Service.Types hiding (tUserId)
import Ideas.Text.HTML
import Ideas.Text.XML
import Recognize.Data.DiagnoseResult
import Data.List
import Data.Maybe
import Recognize.Data.Entry
import Recognize.Data.MathStoryProblem
import Recognize.Data.Solution
import Main.Tasks
import Bayes.Script
import Bayes.StudentReport (StudentReport)
import Service.Sequencer
import Service.Types
import Util.W3CSSHTML
import Ideas.Common.Library
import Ideas.Main.Default
import Ideas.Encoding.Request (Schema(V2))
import Ideas.Encoding.ModeXML (processXML)
import Ideas.Encoding.Options (logRef, maxTime)
import qualified Ideas.Encoding.Logging as Log
import qualified Database.HDBC as SQL
import qualified Database.HDBC.Sqlite3 as SQL (connectSqlite3, setBusyTimeout)
import Database.Data
instance ToField Rational where
toField d = let x = fromRational d :: Double
in toField x
runService :: IO ()
runService = do
ref <- Log.makeLogRef "advise-me.db" V2
Log.disableLogging ref
defaultMainWith (mempty {logRef=ref}) adviseMeDr
conn <- SQL.connectSqlite3 (fromJust $ Log.getFilePath ref)
SQL.setBusyTimeout conn 1000
Log.logRecordWith ref conn
addModelToLatestRequest conn
SQL.commit conn
SQL.disconnect conn
adviseMeDr :: DomainReasoner
adviseMeDr = describe "Advise-Me domain reasoner" (newDomainReasoner "advise-me")
{ exercises = map (\(Task e) -> Some (getExercise e)) tasks
, services = myServices
}
myServices :: [Service]
myServices = adviseMeUserModelService
: assessmentService
: sequencerService
: metaServiceList adviseMeDr ++ serviceList
adviseMeUserModelService :: Service
adviseMeUserModelService = makeService "advise-me-usermodel" "Obtain user models for Advise-Me" $
adviseMeUserModel ::: tUserRequest .-> tIO tStudentReports
adviseMeUserModel :: UserRequest -> IO [StudentReport]
adviseMeUserModel userRequest = do
conn <- SQL.connectSqlite3 "advise-me.db"
reports <- mapM (latestStudentReport conn (lang userRequest)) (ids userRequest)
SQL.disconnect conn
return reports
assessmentService :: Service
assessmentService = makeService "advise-me" "Assessment service for Advise-Me project" $
assess ::: tExercise .-> tSource .-> tSolution .-> tIO tDiagnosis
assess :: Exercise a -> Source -> Solution -> IO (DiagnosisReply a)
assess ex src sol = do
Task e <- findTask (getId ex)
return $ DiagnosisReply
{ exercise = ex
, solution = sol
, source = src
, entry = diagnose e sol
, examinator = Just "ideas"
}
runDomainReasoner :: String -> IO String
runDomainReasoner inputString = do
(_, reply, _) <- processXML options adviseMeDr inputString
return reply
where
options = mempty { logRef = mempty
, maxTime = Just 5 }