module Service.Types where
import Ideas.Text.XML (ToXML, toXML, Attribute((:=)) )
import Ideas.Common.Library hiding (recognize)
import Ideas.Service.Types hiding (tUserId)
import Recognize.Data.Solution
import Util.String
import Bayes.StudentReport (StudentReport)
import Control.Monad
import Data.Maybe (fromMaybe)
import Data.List (intercalate)
import qualified Ideas.Text.XML as XML
import Recognize.Data.Entry (Entry, diagnoses)
import Recognize.Data.DiagnoseResult (evidence)
import Database.Data ( StudentID )
tSolution :: Type a Solution
tSolution = Tag "solution" $ Iso (f <-> g) tp
where
tp = tTuple4 tUserId tGroupId tLanguage (tList tInput)
f (userId, groupId, lan, inps) = Solution userId groupId lan inps
g (Solution userId groupId lan inps) = (userId, groupId, lan, inps)
tUserId :: Type a UserId
tUserId = tMaybe $ tAttr "userid"
tGroupId :: Type a GroupId
tGroupId = tMaybe $ tAttr "groupid"
tSource :: Type a Source
tSource = tMaybe $ tAttr "source"
tLanguage :: Type a (Maybe Language)
tLanguage = tMaybe $ Iso (f <-> g) $ tAttr "language"
where
f = read . strToUpper
g = strToLower . show
tInput :: Type a Input
tInput = Tag "input" $ Iso (f <-> g) tp
where
tp = tPair tInputId (tList (tMathML :|: tString))
f (inputId, xs) = Input inputId xs
g (Input inputId xs) = (inputId, xs)
tInputId :: Type a Id
tInputId = Iso (newId.strToLower <-> show) $ tAttr "id"
tAttr :: String -> Type a String
tAttr s = Tag s tString
tStudentReport :: Type a StudentReport
tStudentReport = Tag "StudentReport" $ Iso (f <-> toXML) tXML
where
f = error "student report from xml not implemented"
tStudentReports :: Type a [StudentReport]
tStudentReports = Iso (f <-> g) tXML
where
f = error "student reports from xml not implemented"
g reports = XML.makeXML "users" $ mconcat $ map (XML.builder . toXML) reports
data DiagnosisReply a = DiagnosisReply
{ exercise :: Exercise a
, solution :: Solution
, entry :: Entry
, source :: Maybe String
, examinator :: Maybe String
}
instance ToXML (DiagnosisReply a) where
toXML diag = XML.makeXML "diagnosis" $ mconcat
[ "source" XML..=. fromMaybe "" (source diag)
, "user" XML..=. fromMaybe "" (userId $ solution diag)
, "exercise" XML..=. showId (exercise diag)
, "inputs" XML..=. intercalate "," (map (showId . getInputId) (inputs $ solution diag))
, "examinator" XML..=. fromMaybe "" (examinator diag)
, XML.builder . XML.toXML . mconcat . map evidence . diagnoses . entry $ diag
, XML.tag "debug" . XML.text . entry $ diag
]
tDiagnosis :: Type a (DiagnosisReply b)
tDiagnosis = Tag "Diagnosis" $ Iso (f <-> toXML) tXML
where
f = error "diagnosis from xml not implemented"
data UserRequest = UserRequest
{ ids :: [String]
, lang :: String
}
tUserRequest :: Type a UserRequest
tUserRequest = Tag "users" $ Iso (f <-> g) tXML
where
g = error "UserRequest cannot be written to xml, only parsed"
f xml = either error id $ do
unless (XML.name xml == "users") $ fail "Expecting <users> tag"
lang' <- XML.findAttribute "language" xml
let ids' = map XML.getData $ XML.findChildren "userid" xml
return $ UserRequest { ids = ids', lang = lang' }
tUserIdTag :: Type a String
tUserIdTag = Tag "userid" $ Iso (f <-> g) tXML
where
g = error "StudentID cannot be written to xml, only parsed"
f xml = do
unless (XML.name xml == "userid") $ fail "expecting <userid> tag"
XML.getData xml