{-# 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)
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
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
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