{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-} ----------------------------------------------------------------------------- -- 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 Recognize.Data.Diagnosis ( Diagnosis(..), Step , newDiagnosis, hasMistakes , getMath, getMaths, addAttribute, mergeSteps , makeFAStep, getAttributes ) where import Data.List import Data.Semigroup import Domain.Math.Expr import Ideas.Common.Id import Ideas.Text.HTML import Ideas.Text.HTML.W3CSS import Ideas.Text.XML hiding (Attribute) import Recognize.Data.Attribute import Recognize.Data.Approach import Recognize.Data.Math import Recognize.Data.Step import Util.W3CSSHTML import qualified Text.PrettyPrint.Leijen as PP data Diagnosis = Diagnosis { category :: Approach , correctResult :: Bool , resultIsSimplified :: Bool , parenthesisMismatch :: Bool , payload :: Maybe Expr -- exercise specific data (only used for MagicExpression in MagicTrick) , steps :: [Step] , result :: Maybe Expr } deriving Eq instance Show Diagnosis where show = show . PP.pretty instance PP.Pretty Diagnosis where pretty d = PP.vcat [ pp "Category" $ PP.string (show (category d)) , pp "Payload" $ PP.string (show (payload d)) , PP.string "Steps:" , PP.vcat $ map (PP.indent 2 . PP.string . show) (steps d) , pp "Result" $ PP.string (show (result d)) , pp "Properties" $ PP.string (intercalate ", " xs) ] where xs = [ s | (s, f, _) <- propList, f d ] pp s a = PP.string (s ++ ": ") PP.<> a instance HasApproach Diagnosis where approach = category propList :: [(String, Diagnosis -> Bool, Color)] propList = [ ("correct result", correctResult, Green) , ("result is simplified", resultIsSimplified, Green) , ("parenthesis mismatch", parenthesisMismatch, Red) ] newDiagnosis :: Approach -> [Step] -> Diagnosis newDiagnosis app st = Diagnosis { category = app , correctResult = False , resultIsSimplified = False , parenthesisMismatch = any (elem NonMatchingParentheses) attrs , payload = Nothing , steps = st , result = Nothing } where attrs = map getAttributes st instance ToXML Diagnosis where toXML d = makeXML "standarddiagnosis" $ mconcat [ element "category" [string (show $ category d)] , element "correctResult" [string (show $ correctResult d)] , element "resultIsSimplified" [string (show $ resultIsSimplified d)] , element "parenthesisMismatch" [string (show $ parenthesisMismatch d)] , element "payload" [builderXML $ payload d] , element "steps" (map builderXML $ steps d) , element "result" [builderXML $ result d] ] instance ToHTML Diagnosis where toHTML d = mconcat [ toHTML (steps d) , maybe mempty (para . string . ("result: " ++) . show) (result d) , let body = toHTML (payload d) in h3 "payload" <> body , htmlProps $ (show (category d), const True, Yellow) : propList ] where htmlProps = para . w3tags . concatMap f where f (s, p, c) = [ (s, c) | p d ]