module Bayes.StudentReport where
import Text.Printf (printf)
import Data.Maybe ( listToMaybe )
import Control.Monad ( forM )
import qualified Ideas.Text.XML as XML
import qualified Data.Map as M
import Util.String ( trim )
import Bayes.Evidence (allProbabilities, Evidence)
import Bayes.Network (Network, Node, nodes, parentIds, nodeId, parents, label)
import Bayes.NetworkReader (readNetwork)
data StudentReport = StudentReport
{ studentID :: String
, competences :: [Competence]
}
data Translation = Translation
{ translationLabel :: XML.XMLBuilder
, translationDescription :: Maybe XML.XMLBuilder
, translationExample :: Maybe XML.XMLBuilder
}
data Competence = Competence
{ skillID :: String
, skillText :: Translation
, skillValue :: Maybe Double
, subskills :: [Competence]
}
limitNesting :: Int -> StudentReport -> StudentReport
limitNesting n report = report { competences = map (limit n) $ competences report}
where
limit :: Int -> Competence -> Competence
limit 0 c = c { subskills = [] }
limit i c = c { subskills = map (limit (i-1)) $ subskills c }
buildStudentReport :: M.Map String Translation -> String -> Network () -> Evidence -> StudentReport
buildStudentReport dictionary sID nw sm = StudentReport
{ studentID = sID
, competences = map makeCompetence roots
}
where
makeCompetence :: Node () -> Competence
makeCompetence node = Competence
{ skillID = nodeId node
, skillText = M.findWithDefault defaultTranslation (nodeId node) dictionary
, skillValue = listToMaybe
[ fromRational p :: Double
| (nodeId', stateLabel, p) <- allProbabilities sm
, nodeId node == nodeId'
, stateLabel == "Yes"
]
, subskills = map makeCompetence $ children node
}
where
defaultTranslation = Translation
{ translationLabel = XML.string $ label node
, translationDescription = mempty
, translationExample = mempty
}
roots :: [Node ()]
roots = filter (null . parents nw)
$ nodes nw
children :: Node () -> [Node ()]
children node = filter ((nodeId node `elem`) . parentIds)
$ nodes nw
getTranslations :: String -> IO (M.Map String Translation)
getTranslations requestedLanguage = do
xml <- XML.parseXMLFile "networks/labels.xml"
fmap M.fromList . forM (XML.findChildren "node" xml) $ \nodeXml -> do
nodeID <- XML.findAttribute "id" nodeXml
title <- XML.findChild "title" nodeXml >>= getDataLang
description <- maybe (return Nothing) (return . getDataLang) $ XML.findChild "description" nodeXml
example <- maybe (return Nothing) (return . getDataLang) $ XML.findChild "example" nodeXml
return (nodeID, Translation { translationLabel = title, translationDescription = description, translationExample = example })
where
getDataLang :: Monad m => XML.XML -> m XML.XMLBuilder
getDataLang =
maybe (fail $ "No such language " ++ requestedLanguage) return
. listToMaybe
. map (mconcat . map (either (XML.string . trim) XML.builder) . XML.content )
. filter (\lang -> XML.findAttribute "id" lang == Just requestedLanguage)
. XML.findChildren "lang"
toReport :: String -> String -> Evidence -> IO StudentReport
toReport sID lang sm = do
nw <- snd <$> readNetwork "networks/StudentModel.xdsl"
dictionary <- getTranslations lang
return . limitNesting 2 $ buildStudentReport dictionary sID nw sm
instance XML.ToXML Competence where
toXML c = XML.makeXML "competence" . mconcat $
[ "id" XML..=. skillID c
, "value" XML..=. (maybe "0.5" (printf "%.3f") . skillValue $ c)
, mconcat $
XML.tag "title" (translationLabel text')
: (maybe mempty (XML.tag "description") (translationDescription text'))
: (maybe mempty (XML.tag "example") (translationExample text'))
: map XML.builderXML (subskills c)
]
where
text' = skillText c
instance XML.ToXML StudentReport where
toXML report = XML.makeXML "user" $ mconcat
[ "id" XML..=. studentID report
, mconcat $ map XML.builderXML (competences report)
]