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

import Data.Data.GenRep.Doc (toDoc)
import Data.Data.GenRep
import System.SimpleTimeout.Limits (showTimeout)

import Control.Monad.State (State, runState, get, put)

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

-- | True for 'Hole', 'ListHole' and 'Detail' constructors.
-- Used in 'mistify'.
isJoker :: GenericData -> Bool
isJoker :: GenericData -> Bool
isJoker GenericData
Hole        = Bool
True
isJoker GenericData
ListHole    = Bool
True
isJoker (Detail GenericData
_)  = Bool
True
isJoker GenericData
_ = Bool
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 :: GenericData -> GenericData
mistify (Constructor ConstructorName
_ []) = GenericData
Hole
mistify (Constructor ConstructorName
p [GenericData]
ss) | Bool -> Bool
not ((GenericData -> Bool) -> [GenericData] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any GenericData -> Bool
isJoker [GenericData]
ss) = ConstructorName -> [GenericData] -> GenericData
Constructor ConstructorName
p ([GenericData] -> GenericData) -> [GenericData] -> GenericData
forall a b. (a -> b) -> a -> b
$ (GenericData -> GenericData) -> [GenericData] -> [GenericData]
forall a b. (a -> b) -> [a] -> [b]
map GenericData -> GenericData
mistify [GenericData]
ss
mistify GenericData
x = GenericData
x

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

-- |Collect and number 'Error' values and replace them
-- by an indexed bottom sign.
-- Repeated errors will get the same number.
numberErrors 
    :: [GenericData]
    -> ([GenericData], [(String, String)])
numberErrors :: [GenericData] -> ([GenericData], [(String, String)])
numberErrors [GenericData]
l
    = ([GenericData]
res, [(String, String)] -> [(String, String)]
forall a. [a] -> [a]
reverse ([(String, String)] -> [(String, String)])
-> [(String, String)] -> [(String, String)]
forall a b. (a -> b) -> a -> b
$ ((String, String) -> (String, String))
-> [(String, String)] -> [(String, String)]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> (String, String)
forall b a. (b, a) -> (a, b)
swap [(String, String)]
errs)
 where
    swap :: (b, a) -> (a, b)
swap (b
a,a
b) = (a
b,b
a)

    ([GenericData]
res, (Int
_, [(String, String)]
errs)) = State (Int, [(String, String)]) [GenericData]
-> (Int, [(String, String)])
-> ([GenericData], (Int, [(String, String)]))
forall s a. State s a -> s -> (a, s)
runState ((GenericData
 -> StateT (Int, [(String, String)]) Identity GenericData)
-> [GenericData] -> State (Int, [(String, String)]) [GenericData]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM GenericData
-> StateT (Int, [(String, String)]) Identity GenericData
replace [GenericData]
l) (Int
0, [])

    replace :: GenericData -> State (Int, [(String, String)]) GenericData
    replace :: GenericData
-> StateT (Int, [(String, String)]) Identity GenericData
replace (Constructor ConstructorName
p [GenericData]
ss) = do
        [GenericData]
ss' <- (GenericData
 -> StateT (Int, [(String, String)]) Identity GenericData)
-> [GenericData] -> State (Int, [(String, String)]) [GenericData]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM GenericData
-> StateT (Int, [(String, String)]) Identity GenericData
replace [GenericData]
ss
        GenericData
-> StateT (Int, [(String, String)]) Identity GenericData
forall (m :: * -> *) a. Monad m => a -> m a
return (GenericData
 -> StateT (Int, [(String, String)]) Identity GenericData)
-> GenericData
-> StateT (Int, [(String, String)]) Identity GenericData
forall a b. (a -> b) -> a -> b
$ ConstructorName -> [GenericData] -> GenericData
Constructor ConstructorName
p [GenericData]
ss'
    replace (Error String
e) = do
        String
i <- String -> State (Int, [(String, String)]) String
getErrorIndex String
e
        GenericData
-> StateT (Int, [(String, String)]) Identity GenericData
forall (m :: * -> *) a. Monad m => a -> m a
return (GenericData
 -> StateT (Int, [(String, String)]) Identity GenericData)
-> GenericData
-> StateT (Int, [(String, String)]) Identity GenericData
forall a b. (a -> b) -> a -> b
$ String -> GenericData
Error String
i
    replace (NestedError GenericData
e) = do
        GenericData
e' <- GenericData
-> StateT (Int, [(String, String)]) Identity GenericData
replace GenericData
e
        String
i <- String -> State (Int, [(String, String)]) String
getErrorIndex (Doc -> String
forall a. Show a => a -> String
show (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ GenericData -> Doc
toDoc GenericData
e')
        GenericData
-> StateT (Int, [(String, String)]) Identity GenericData
forall (m :: * -> *) a. Monad m => a -> m a
return (GenericData
 -> StateT (Int, [(String, String)]) Identity GenericData)
-> GenericData
-> StateT (Int, [(String, String)]) Identity GenericData
forall a b. (a -> b) -> a -> b
$ String -> GenericData
Error String
i
    replace (Timeout Double
d) = do
        String
i <- String -> State (Int, [(String, String)]) String
getErrorIndex (String -> State (Int, [(String, String)]) String)
-> String -> State (Int, [(String, String)]) String
forall a b. (a -> b) -> a -> b
$ Double -> String
showTimeout Double
d
        GenericData
-> StateT (Int, [(String, String)]) Identity GenericData
forall (m :: * -> *) a. Monad m => a -> m a
return (GenericData
 -> StateT (Int, [(String, String)]) Identity GenericData)
-> GenericData
-> StateT (Int, [(String, String)]) Identity GenericData
forall a b. (a -> b) -> a -> b
$ String -> GenericData
Error String
i
    replace (Detail GenericData
s) = do
        GenericData
s' <- GenericData
-> StateT (Int, [(String, String)]) Identity GenericData
replace GenericData
s
        GenericData
-> StateT (Int, [(String, String)]) Identity GenericData
forall (m :: * -> *) a. Monad m => a -> m a
return (GenericData
 -> StateT (Int, [(String, String)]) Identity GenericData)
-> GenericData
-> StateT (Int, [(String, String)]) Identity GenericData
forall a b. (a -> b) -> a -> b
$ GenericData -> GenericData
Detail GenericData
s'
    replace GenericData
x = GenericData
-> StateT (Int, [(String, String)]) Identity GenericData
forall (m :: * -> *) a. Monad m => a -> m a
return GenericData
x

getErrorIndex :: String -> State (Int, [(String, String)]) String
getErrorIndex :: String -> State (Int, [(String, String)]) String
getErrorIndex String
e = do
    (Int
len, [(String, String)]
es) <- StateT (Int, [(String, String)]) Identity (Int, [(String, String)])
forall s (m :: * -> *). MonadState s m => m s
get
    case String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
e [(String, String)]
es of
        Just String
x  -> String -> State (Int, [(String, String)]) String
forall (m :: * -> *) a. Monad m => a -> m a
return String
x
        Maybe String
Nothing -> do
            let n :: Int
n = Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1
                x :: String
x = Char
'⊥'Char -> String -> String
forall a. a -> [a] -> [a]
: (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLowerIndex (Int -> String
forall a. Show a => a -> String
show Int
n)
            (Int, [(String, String)])
-> StateT (Int, [(String, String)]) Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Int
n, (String
e, String
x)(String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
: [(String, String)]
es)
            String -> State (Int, [(String, String)]) String
forall (m :: * -> *) a. Monad m => a -> m a
return String
x
  where
    toLowerIndex :: Char -> Char
toLowerIndex Char
c = case Char
c of
        Char
'0' -> Char
'₀'
        Char
'1' -> Char
'₁'
        Char
'2' -> Char
'₂'
        Char
'3' -> Char
'₃'
        Char
'4' -> Char
'₄'
        Char
'5' -> Char
'₅'
        Char
'6' -> Char
'₆'
        Char
'7' -> Char
'₇'
        Char
'8' -> Char
'₈'
        Char
'9' -> Char
'₉'
        Char
_   -> String -> Char
forall a. HasCallStack => String -> a
error (String -> Char) -> String -> Char
forall a b. (a -> b) -> a -> b
$ String
"toLowerIndex: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. Show a => a -> String
show Char
c