Submit.hs

-----------------------------------------------------------------------------
-- Copyright 2010, Open Universiteit Nederland. This file is distributed 
-- under the terms of the GNU General Public License. For more information, 
-- see the file "LICENSE.txt", which is included in the distribution.
-----------------------------------------------------------------------------
-- |
-- Maintainer  :  bastiaan.heeren@ou.nl
-- Stability   :  provisional
-- Portability :  portable (depends on ghc)
--
-- Diagnose a term submitted by a student. Deprecated (see diagnose service).
--
-----------------------------------------------------------------------------
module Service.Submit 
   ( submit, Result(..), getResultState
   , submitType, submitTypeSynonym
   ) where

import Common.Library
import qualified Service.Diagnose as Diagnose
import Service.Diagnose (Diagnosis, diagnose)
import Service.State
import Service.Types

-- Note that in the typed setting there is no syntax error
data Result a = Buggy  [Rule (Context a)]   
              | NotEquivalent      
              | Ok     [Rule (Context a)] (State a)  -- equivalent
              | Detour [Rule (Context a)] (State a)  -- equivalent
              | Unknown                   (State a)  -- equivalent
 
fromDiagnose :: Diagnosis a -> Result a
fromDiagnose diagnosis =
   case diagnosis of
      Diagnose.Buggy r        -> Buggy [r]
      Diagnose.NotEquivalent  -> NotEquivalent
      Diagnose.Similar _ s    -> Ok [] s
      Diagnose.Expected _ s r -> Ok [r] s
      Diagnose.Detour _ s r   -> Detour [r] s
      Diagnose.Correct _ s    -> Unknown s
          
submit :: State a -> a -> Result a 
submit state = fromDiagnose . diagnose state
   
getResultState :: Result a -> Maybe (State a)
getResultState result =
   case result of
      Ok _ st     -> return st
      Detour _ st -> return st
      Unknown st  -> return st
      _           -> Nothing
      
submitType :: Type a (Result a)
submitType = useSynonym submitTypeSynonym

submitTypeSynonym :: TypeSynonym a (Result a)
submitTypeSynonym = typeSynonym "Result" to from tp
 where
   to (Left rs) = Buggy rs
   to (Right (Left ())) = NotEquivalent
   to (Right (Right (Left (rs, s)))) = Ok rs s
   to (Right (Right (Right (Left (rs, s))))) = Detour rs s
   to (Right (Right (Right (Right s)))) = Unknown s

   from (Buggy rs)      = Left rs
   from (NotEquivalent) = Right (Left ())
   from (Ok rs s)       = Right (Right (Left (rs, s)))
   from (Detour rs s)   = Right (Right (Right (Left (rs, s))))
   from (Unknown s)     = Right (Right (Right (Right s))) 

   tp  =  List Rule 
      :|: Unit
      :|: Pair (List Rule) stateTp
      :|: Pair (List Rule) stateTp
      :|: stateTp