AdviseMe.hs

{-# LANGUAGE FlexibleInstances #-}
-----------------------------------------------------------------------------
-- Copyright 2019, Advise-Me project team. This file is distributed under 
-- the terms of the Apache License 2.0. For more information, see the files
-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
-----------------------------------------------------------------------------
-- |
-- Maintainer  :  bastiaan.heeren@ou.nl
-- Stability   :  provisional
-- Portability :  portable (depends on ghc)
--
-----------------------------------------------------------------------------

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

-- COMPILER BUG? instance needed?
instance ToField Rational where
 toField d = let x = fromRational d :: Double
             in toField x

-- | Run the Advise-Me domain reasoner, and then afterwards the Bayesian
-- networks. We defer logging of the request so that the request and the
-- student model are logged in one fell swoop.
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 -- milliseconds
      Log.logRecordWith ref conn
      addModelToLatestRequest conn --temporarily turned off: no BN
      --calculation!
      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
           -- : adviseMeService

adviseMeUserModelService :: Service
adviseMeUserModelService = makeService "advise-me-usermodel" "Obtain user models for Advise-Me" $
   adviseMeUserModel ::: tUserRequest .-> tIO tStudentReports

-- | Request to obtain the user model.
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"
      }

-- | Run the domain reasoner directly, on a single input, without logging.
-- Intended for internal usage.
runDomainReasoner :: String -> IO String
runDomainReasoner inputString = do
   (_, reply, _) <- processXML options adviseMeDr inputString
   return reply

   where
   options = mempty { logRef = mempty
                    , maxTime = Just 5 }