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)
isJoker :: GenericData -> Bool
isJoker Hole = True
isJoker ListHole = True
isJoker (Detail _) = True
isJoker _ = False
mistify :: GenericData -> GenericData
mistify (Constructor _ []) = Hole
mistify (Constructor p ss) | not (any isJoker ss) = Constructor p $ map mistify ss
mistify x = x
numberErrors
:: [GenericData]
-> ([GenericData], [(String, String)])
numberErrors l
= (res, reverse $ map swap errs)
where
swap (a,b) = (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 (NestedError e) = do
e' <- replace e
i <- getErrorIndex (show $ toDoc 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
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
where
toLowerIndex c = case c of
'0' -> '₀'
'1' -> '₁'
'2' -> '₂'
'3' -> '₃'
'4' -> '₄'
'5' -> '₅'
'6' -> '₆'
'7' -> '₇'
'8' -> '₈'
'9' -> '₉'
_ -> error $ "toLowerIndex: " ++ show c