module Test.FitSpec.Dot where
import Test.FitSpec
import Test.FitSpec.Engine
import Test.FitSpec.Utils
import Data.List
groupImplications :: Eq i => [([[i]], [i])] -> [([[i]],[[i]])]
groupImplications [] = []
groupImplications (n:ns) = [ (fst n, fst n')
| n' <- filterU (not ... implies)
. filter (n `implies`)
$ ns
] ++ groupImplications ns
where actual (iss,is) = foldr union [] iss `union` is
n `implies` m = actual n `contains` actual m
isObvious :: Eq i => [[i]] -> [[i]] -> Bool
isObvious as bs = or [ a `contains` b
| a <- as
, b <- bs ]
attachObviousness :: Eq i => [([[i]], [[i]])] -> [([[i]],[[i]],Bool)]
attachObviousness = map attachObviousness'
where attachObviousness' (as,bs) = (as,bs,isObvious as bs)
genDotfileFromGI :: Show i
=> [([[i]],[[i]],Bool)]
-> String
genDotfileFromGI = (\s -> "digraph G {\n" ++ s ++ "}\n")
. unlines
. map showEntry
where showG = unwords . map show
showEntry (iss,jss,p) = "\"" ++ showG iss ++ "\" -> \""
++ showG jss ++ "\""
++ if p
then " [ color = grey ]"
else ""
getDotfile :: (Mutable a)
=> [a]
-> Int -> Int -> a -> (a -> [Property])
-> String
getDotfile ems m n f ps = genDotfileFromGI
. attachObviousness
. groupImplications
. map (\r -> (sets r, implied r))
$ getResultsExtra ems f ps m n
writeDotfile :: (Mutable a)
=> String
-> [a]
-> Int -> Int -> a -> (a -> [Property])
-> IO ()
writeDotfile fn ems m n f = writeFile fn . getDotfile ems m n f
putDotfile :: (Mutable a)
=> [a]
-> Int -> Int -> a -> (a -> [Property])
-> IO ()
putDotfile ems m n f = putStr . getDotfile ems m n f