-----------------------------------------------------------------------------
-- 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 Task.VPattern.Assess where

import Data.Monoid
import Bayes.Evidence
import Recognize.Data.Approach
import Recognize.Data.Attribute hiding (Other)
import Recognize.Data.Diagnosis as S
import Recognize.Data.Step
import Recognize.Model.Assess
import Recognize.Model.Connectives
import Recognize.Model.EvidenceBuilder
import Task.Network.VPattern

assess' :: Diagnosis -> Evidence
assess' sd =
  stringNode (apprtostring appr) ans1Strat <> --check which approach has been used
  generateEvidence buildStepsEvidence appr attrs
  where attrs = map (snd . getValue) $ steps sd
        appr  = approach sd
        apprtostring Algebraic = Just "Algebraic1"
        apprtostring (Other "Algebraic2") = Just "Algebraic2"
        apprtostring (Other "Algebraic3") = Just "Algebraic3"
        apprtostring (Other "Algebraic4") = Just "Algebraic4"
        apprtostring _         = Nothing

buildStepsEvidence :: Approach -> EvBuilder ()
buildStepsEvidence Algebraic            = stepsA1Builder
buildStepsEvidence (Other "Algebraic2") = stepsA2Builder
buildStepsEvidence (Other "Algebraic3") = stepsA3Builder
buildStepsEvidence (Other "Algebraic4") = stepsA4Builder
buildStepsEvidence _                    = return ()

stepsA1Builder :: EvBuilder ()
stepsA1Builder = do
  giveNodeAndCollect ans1Strat1Step1 $ withoutFailure (exists1 (Label "A1"))

  giveNodeAndCollect ans1Strat1Step2 $ withoutFailure (exists1 (Label "S"))

  giveNodeAndCollect ans1 $ withoutFailure (exists1 (Label "S"))

stepsA2Builder :: EvBuilder ()
stepsA2Builder = do
  giveNodeAndCollect ans1Strat2Step1 $ withoutFailure (exists1 (Label "A2"))

  giveNodeAndCollect ans1Strat2Step2 $ withoutFailure (exists1 (Label "S"))

  giveNodeAndCollect ans1 $ withoutFailure (exists1 (Label "S"))

stepsA3Builder :: EvBuilder ()
stepsA3Builder = do
  giveNodeAndCollect ans1Strat3Step2 $ withoutFailure (exists1 (Label "A3_1"))

  giveNodeAndCollect ans1Strat3Step3 $ withoutFailure (exists1 (Label "A3_2"))

  giveNodeAndCollect ans1Strat3Step4 $ withoutFailure (exists1 (Label "S"))

  giveNodeAndCollect ans1 $ withoutFailure (exists1 (Label "S"))

stepsA4Builder :: EvBuilder ()
stepsA4Builder = do
  giveNodeAndCollect ans1Strat4Step2 $ withoutFailure (exists1 (Label "2"))

  giveNodeAndCollect ans1Strat4Step3 $ withoutFailure (exists1 (Label "S"))

  giveNodeAndCollect ans1 $ withoutFailure (exists1 (Label "S"))