{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
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
, 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 ]