activehs-0.3.2: Result.hs

{-# LANGUAGE OverloadedStrings #-}
module Result
    ( Result (..)
    , hasError
    , filterResults
    ) where

import Lang
import Data.Data.Compare

import Text.XHtml.Strict
import Control.DeepSeq

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

type Err = (String, String)

data Result
    = ExprType Bool String String [Err]        
            -- expression with type and error messages
            -- True: this is an error (can't do better just show the type)
    | TypeKind String String [Err]        -- type with kind and error messages
    | Comparison String Answer String [Err]
    | SearchResults Bool [String]
    | Error Bool String         -- True: important error message
    | Dia Html [Err]
    | Message String (Maybe Result)
    | ShowFailedTestCase String Result
    | ShowInterpreter Language Int String String{-Id-} Char String (Maybe Result)
        deriving (Show)

instance NFData Result where
    rnf (ExprType e a b l) = rnf (e,a,b,l)
    rnf (TypeKind a b l) = rnf (a,b,l)
    rnf (Comparison a x b l) = rnf (a,x,b,l)
    rnf (SearchResults b l) = rnf (b,l)
    rnf (Error b s) = rnf (b, s)
    rnf (Message s r) = rnf (s, r)
    rnf (Dia h e) = length (showHtmlFragment h) `seq` rnf e
    rnf (ShowFailedTestCase testcase res) = rnf (testcase, res)
    rnf (ShowInterpreter a b c d e f g) = rnf (a,b,c,d,e,f,g)

errors :: Result -> Bool
errors (ExprType _ _ _ l) = not $ null l
errors (TypeKind _ _ l) = not $ null l
errors (Comparison _ x _ l) = x /= Yes || not (null l)
errors (Dia _ l) = not $ null l
errors (Error i _) = i
errors (Message _ x) = maybe False errors x
errors (ShowInterpreter _ _ _ _ _ _ g) = maybe False errors g
errors _ = False

filterResults :: [Result] -> [Result]
filterResults rs = case filter (not . weakOrHardError) rs of
    [] -> case [e | e@(Error True _) <- rs] of
            [] -> take 1 rs
            rs -> take 1 rs
    rs -> case filter (not . searchResult) rs of
        [] -> rs
        rs -> {- nubBy f -} rs
{-
 where
    f (ExprType _ _ _ _) (ExprType _ _ _ _) = True
    f _ _ = False
-}

hasError :: [Result] -> Bool
hasError rs = case filter (not . weakOrHardError) rs of
    [] -> True
    rs -> any errors rs

weakOrHardError :: Result -> Bool
weakOrHardError (Error _ _) = True
weakOrHardError (ExprType b _ _ _) = b
weakOrHardError _ = False

searchResult :: Result -> Bool
searchResult (SearchResults _ _) = True
searchResult _ = False