ConstraintServices.hs

-----------------------------------------------------------------------------
-- Copyright 2020, Ideas 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.
-----------------------------------------------------------------------------
module Service.ConstraintServices
  ( constraintServiceList
  ) where

import Ideas.Common.Library
import Ideas.Service.Diagnose
import Ideas.Service.BasicServices
import Ideas.Service.State
import Ideas.Service.Types

-- Constraint services that are available
constraintServiceList :: [Service]
constraintServiceList = [diagnoseS, constraintsS, onehintS, allhintsS]

diagnoseS :: Service
diagnoseS = makeService "basic.diagnose"
   "Diagnose an expression submitted by a student. Possible diagnosis are \
   \Buggy (a common misconception was detected), NotEquivalent (something is \
   \wrong, but we don't know what), Similar (the expression is pretty similar \
   \to the last expression in the derivation), Expected (the submitted \
   \expression was anticipated by the strategy), Detour (the submitted \
   \expression was not expected by the strategy, but the applied rule was \
   \detected), and Correct (it is correct, but we don't know which rule was \
   \applied). Extended version for statistics domain: check predicates for NotEquiv." $
   diagnoseWithConstraints ::: tState .-> tContext .-> tMaybe tId .-> tDiagnosis

constraintsS :: Service
constraintsS = makeService "basic.constraints"
   "Check all constraints" $
   checkConstraints ::: tState .-> tList (tPair tConstraint tString)

onehintS :: Service
onehintS = makeService "basic.onehint"
   "Check constraints, and provide a hint" $
   onehint ::: tState .-> tError (Tag "elem" tHint)

allhintsS :: Service
allhintsS = makeService "basic.allhints"
   "Check constraints, and provide (multiple) hints" $
   allhints ::: tState .-> tError (tList tHint)

--------------------------------------------------------------------------------

diagnoseWithConstraints :: State a -> Context a -> Maybe Id -> Diagnosis a
diagnoseWithConstraints st ctx mid = f (diagnose st ctx mid)
 where
   f (NotEquivalent "") =
      case violations (exercise st) ctx of
         (n, msg):_ -> NotEquivalent $ violationMsg n msg
         [] | null (violations (exercise st) (stateContext st)) ->
                 NotEquivalent []
            | otherwise -> -- special case: previous state is invalid (constraint violated)
                 Correct (finished st) st
   f d = d

data Hint a = Violation (Constraint (Context a)) String
            | HintStep (StepInfo a) (State a)

tHint :: Type a (Hint a)
tHint = Iso (f <-> g) tp
 where
    tp = tPair tConstraint tString :|: tPair tStepInfo tState

    f (Left (c, msg))   = Violation c msg
    f (Right (stp, st)) = HintStep stp st
    g (Violation c msg) = Left (c, msg)
    g (HintStep stp st) = Right (stp, st)

allhints :: State a -> Either String [Hint a]
allhints st = 
   case violations (exercise st) (stateContext st) of 
      [] -> fmap (map (uncurry HintStep)) (allfirsts st)
      xs -> Right (map (uncurry Violation) xs)

onehint :: State a -> Either String (Hint a)
onehint st = 
   case allhints st of
      Left msg    -> Left msg
      Right []    -> Left "no hint available"
      Right (h:_) -> Right h

checkConstraints :: State a -> [(Constraint (Context a), String)]
checkConstraints st = map f (constraints (exercise st))
 where
   f c = (c, show $ getResult c (stateContext st))

violationMsg :: Constraint a -> String -> String
violationMsg n msg = show n ++ if null msg then "" else ": " ++ msg