module Ideas.Service.Diagnose
( Diagnosis(..), diagnose, restartIfNeeded, newState
) where
import Data.List (sortBy)
import Data.Maybe
import Ideas.Common.Library hiding (ready)
import Ideas.Service.BasicServices hiding (apply)
import Ideas.Service.State
import Ideas.Service.Types
data Diagnosis a
= Buggy Environment (Rule (Context a))
| NotEquivalent
| Similar Bool (State a)
| Expected Bool (State a) (Rule (Context a))
| Detour Bool (State a) Environment (Rule (Context a))
| Correct Bool (State a)
instance Show (Diagnosis a) where
show diagnosis =
case diagnosis of
Buggy as r -> "Buggy rule " ++ show (show r) ++ showArgs as
NotEquivalent -> "Unknown mistake"
Similar _ _ -> "Very similar"
Expected _ _ r -> "Rule " ++ show (show r) ++ ", expected by strategy"
Detour _ _ _ r -> "Rule " ++ show (show r) ++ ", not following strategy"
Correct _ _ -> "Unknown step"
where
showArgs as
| noBindings as = ""
| otherwise = " (" ++ show as ++ ")"
newState :: Diagnosis a -> Maybe (State a)
newState diagnosis =
case diagnosis of
Buggy _ _ -> Nothing
NotEquivalent -> Nothing
Similar _ s -> Just s
Expected _ s _ -> Just s
Detour _ s _ _ -> Just s
Correct _ s -> Just s
diagnose :: State a -> Context a -> Diagnosis a
diagnose state new
| not (equivalence ex (stateContext state) new) =
case discovered True of
Just (r, as) -> Buggy as r
Nothing -> NotEquivalent
| isJust expected =
let ((r, _, _), ns) = fromJust expected
in Expected (ready ns) ns r
| similar = Similar (ready state) state
| otherwise =
case discovered False of
Just (r, as) ->
Detour (ready restarted) restarted as r
Nothing ->
Correct (ready restarted) restarted
where
ex = exercise state
restarted = restartIfNeeded (makeNoState ex new)
similar = similarity ex (stateContext state) new
expected = do
let xs = either (const []) id $ allfirsts (restartIfNeeded state)
p (_, ns) = similarity ex new (stateContext ns)
listToMaybe (filter p xs)
discovered searchForBuggy = listToMaybe
[ (r, env)
| r <- sortBy (ruleOrdering ex) (ruleset ex)
, isBuggy r == searchForBuggy
, (_, env) <- recognizeRule ex r sub1 sub2
]
where
diff = if searchForBuggy then difference else differenceEqual
(sub1, sub2) = fromMaybe (stateContext state, new) $ do
newTerm <- fromContext new
(a, b) <- diff ex (stateTerm state) newTerm
return (inContext ex a, inContext ex b)
restartIfNeeded :: State a -> State a
restartIfNeeded state
| null (statePrefixes state) && canBeRestarted ex =
emptyState ex (stateTerm state)
| otherwise = state
where
ex = exercise state
instance Typed a (Diagnosis a) where
typed = Tag "Diagnosis" $ Iso (f <-> g) typed
where
f (Left (Left (as, r))) = Buggy as r
f (Left (Right ())) = NotEquivalent
f (Right (Left (b, s))) = Similar b s
f (Right (Right (Left (b, s, r)))) = Expected b s r
f (Right (Right (Right (Left (b, s, as, r))))) = Detour b s as r
f (Right (Right (Right (Right (b, s))))) = Correct b s
g (Buggy as r) = Left (Left (as, r))
g NotEquivalent = Left (Right ())
g (Similar b s) = Right (Left (b, s))
g (Expected b s r) = Right (Right (Left (b, s, r)))
g (Detour b s as r) = Right (Right (Right (Left (b, s, as, r))))
g (Correct b s) = Right (Right (Right (Right (b, s))))