-- |Intended for internal use: Generic representation of 'Data' vales.
{-# LANGUAGE ScopedTypeVariables #-}
module Data.Data.GenRep.Functions
    ( mistify
    , numberErrors
    ) where

import System.IO.Parallel
import System.SimpleTimeout.Limits
import Data.Data.GenRep

import Control.Exception
import Control.DeepSeq (deepseq)
import Control.Monad.State (State, runState, get, put)
import Prelude hiding (catch)

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

-- | True for 'Hole', 'ListHole' and 'Detail' constructors.
-- Used in 'mistify'.
isJoker :: GenericData -> Bool
isJoker Hole        = True
isJoker ListHole    = True
isJoker (Detail _)  = True
isJoker _ = False

-- could be better
-- | Try to hide some part of the value.
--
-- This is used in the evaluation of exercises, when the result
-- is wrong. We would like to show the erroneous part but not the whole result.
mistify :: GenericData -> GenericData
mistify (Constructor _ []) = Hole
mistify (Constructor p ss) | not (any isJoker ss) = Constructor p $ map mistify ss
mistify x = x

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

-- |Collect and number of 'Error' values and replace them
-- by an indexed bottom sign.
-- Repeated errors will get the same number.
numberErrors 
    :: TimeLimit    -- ^ time limit for showing error messages
    -> SizeLimit    -- ^ size penalty per errors
    -> SizeLimit    -- ^ global size limit
    -> [GenericData] 
    -> IO ([GenericData], [(String, String)])
numberErrors tl psl sl l = do
    budget <- newBudget tl sl
    errs <- manyParallel $ map (chk budget) errs
    return (res, reverse $ concat errs)
 where
    chk budget (a, b)
      = checkBudget budget psl
            (const $ return [(b, "Timeout in error!")]) 
            (return []) 
            (checkError a >>= \a -> 
                decSizeBudget budget $ chkSize a)
      where
        checkError :: String -> IO String
        checkError e
            = (e `deepseq` return e)
                 `catch` (\(_ :: ErrorCall) -> return "Nested error!")

        chkSize a lim = case splitAt lim a of
            (a, []) -> (lim - length a, [(b, a)])
            (a, _)  -> (lim - length a, [(b, a ++ "…")])

    (res, (_, errs)) = runState (mapM replace l) (0, [])

    replace :: GenericData -> State (Int, [(String, String)]) GenericData
    replace (Constructor p ss) = do
        ss' <- mapM replace ss
        return $ Constructor p ss'
    replace (Error e) = do
        i <- getErrorIndex e
        return $ Error i
    replace (Timeout d) = do
        i <- getErrorIndex $ showTimeout d
        return $ Error i
    replace (Detail s) = do
        s' <- replace s
        return $ Detail s'
    replace x = return x

    showTimeout d  
        = "timeout at " ++ show (round $ 100 * d :: Int) ++ "%" 

    getErrorIndex :: String -> State (Int, [(String, String)]) String
    getErrorIndex e = do
        (len, es) <- get
        case lookup e es of
            Just x  -> return x
            Nothing -> do
                let n = len+1
                    x = '⊥': map toLowerIndex (show n)
                put (n, (e, x): es)
                return x

    toLowerIndex c = case c of
        '0' -> '₀'
        '1' -> '₁'
        '2' -> '₂'
        '3' -> '₃'
        '4' -> '₄'
        '5' -> '₅'
        '6' -> '₆'
        '7' -> '₇'
        '8' -> '₈'
        '9' -> '₉'
        _   -> error $ "toLowerIndex: " ++ show c