-----------------------------------------------------------------------------
-- 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)
--
-- Provides reports of the user models.
--
-----------------------------------------------------------------------------

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]
     }


-- | Limit nested competences to n levels.
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
         }

   -- Top-level nodes have no parents
   roots :: [Node ()]
   roots = filter (null . parents nw) 
         $ nodes nw

   -- Each successive level is a child of one of the previous levels
   children :: Node () -> [Node ()]
   children node = filter ((nodeId node `elem`) . parentIds) 
                  $ nodes nw




-- | Get a mapping from NodeIDs to labels and descriptions in the requested
-- language.
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"


-- | Create a student report from a student model.
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)
      ]