-- |
-- Module      : Test.FitSpec.Dot
-- Copyright   : (c) 2015-2017 Rudy Matela
-- License     : 3-Clause BSD  (see the file LICENSE)
-- Maintainer  : Rudy Matela <rudy@matela.com.br>
--
-- Experimental module to generate dotfiles (for graphviz) with implications
-- between property sub-sets.
module Test.FitSpec.Dot where

import Test.FitSpec
import Test.FitSpec.Engine
import Test.FitSpec.Utils
import Data.List

-- | Given a list of pairs of property groups and their implications,
--   return implications between groups (transitive cases are ommitted).
groupImplications :: Eq i => [([[i]], [i])] -> [([[i]],[[i]])]
groupImplications :: [([[i]], [i])] -> [([[i]], [[i]])]
groupImplications [] = []
groupImplications (([[i]], [i])
n:[([[i]], [i])]
ns) = [ (([[i]], [i]) -> [[i]]
forall a b. (a, b) -> a
fst ([[i]], [i])
n, ([[i]], [i]) -> [[i]]
forall a b. (a, b) -> a
fst ([[i]], [i])
n')
                           | ([[i]], [i])
n' <- (([[i]], [i]) -> ([[i]], [i]) -> Bool)
-> [([[i]], [i])] -> [([[i]], [i])]
forall a. (a -> a -> Bool) -> [a] -> [a]
filterU (Bool -> Bool
not (Bool -> Bool)
-> (([[i]], [i]) -> ([[i]], [i]) -> Bool)
-> ([[i]], [i])
-> ([[i]], [i])
-> Bool
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
... ([[i]], [i]) -> ([[i]], [i]) -> Bool
forall a (t :: * -> *) (t :: * -> *).
(Eq a, Foldable t, Foldable t) =>
(t [a], [a]) -> (t [a], [a]) -> Bool
implies)
                                 ([([[i]], [i])] -> [([[i]], [i])])
-> ([([[i]], [i])] -> [([[i]], [i])])
-> [([[i]], [i])]
-> [([[i]], [i])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([[i]], [i]) -> Bool) -> [([[i]], [i])] -> [([[i]], [i])]
forall a. (a -> Bool) -> [a] -> [a]
filter (([[i]], [i])
n ([[i]], [i]) -> ([[i]], [i]) -> Bool
forall a (t :: * -> *) (t :: * -> *).
(Eq a, Foldable t, Foldable t) =>
(t [a], [a]) -> (t [a], [a]) -> Bool
`implies`)
                                 ([([[i]], [i])] -> [([[i]], [i])])
-> [([[i]], [i])] -> [([[i]], [i])]
forall a b. (a -> b) -> a -> b
$ [([[i]], [i])]
ns
                           ] [([[i]], [[i]])] -> [([[i]], [[i]])] -> [([[i]], [[i]])]
forall a. [a] -> [a] -> [a]
++ [([[i]], [i])] -> [([[i]], [[i]])]
forall i. Eq i => [([[i]], [i])] -> [([[i]], [[i]])]
groupImplications [([[i]], [i])]
ns
  where actual :: (t [a], [a]) -> [a]
actual (t [a]
iss,[a]
is) = ([a] -> [a] -> [a]) -> [a] -> t [a] -> [a]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a]
union [] t [a]
iss [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a]
`union` [a]
is
        (t [a], [a])
n implies :: (t [a], [a]) -> (t [a], [a]) -> Bool
`implies` (t [a], [a])
m = (t [a], [a]) -> [a]
forall a (t :: * -> *). (Eq a, Foldable t) => (t [a], [a]) -> [a]
actual (t [a], [a])
n [a] -> [a] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`contains` (t [a], [a]) -> [a]
forall a (t :: * -> *). (Eq a, Foldable t) => (t [a], [a]) -> [a]
actual (t [a], [a])
m

isObvious :: Eq i => [[i]] -> [[i]] -> Bool
isObvious :: [[i]] -> [[i]] -> Bool
isObvious [[i]]
as [[i]]
bs = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [ [i]
a [i] -> [i] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`contains` [i]
b
                     | [i]
a <- [[i]]
as
                     , [i]
b <- [[i]]
bs ]

attachObviousness :: Eq i => [([[i]], [[i]])] -> [([[i]],[[i]],Bool)]
attachObviousness :: [([[i]], [[i]])] -> [([[i]], [[i]], Bool)]
attachObviousness = (([[i]], [[i]]) -> ([[i]], [[i]], Bool))
-> [([[i]], [[i]])] -> [([[i]], [[i]], Bool)]
forall a b. (a -> b) -> [a] -> [b]
map ([[i]], [[i]]) -> ([[i]], [[i]], Bool)
forall i. Eq i => ([[i]], [[i]]) -> ([[i]], [[i]], Bool)
attachObviousness'
  where attachObviousness' :: ([[i]], [[i]]) -> ([[i]], [[i]], Bool)
attachObviousness' ([[i]]
as,[[i]]
bs) = ([[i]]
as,[[i]]
bs,[[i]] -> [[i]] -> Bool
forall i. Eq i => [[i]] -> [[i]] -> Bool
isObvious [[i]]
as [[i]]
bs)


-- | Given a list of relations, generate a graphviz graph containing those relations.
--   Generate a dotfile from implications between groups.
genDotfileFromGI :: Show i
                 => [([[i]],[[i]],Bool)]
                 -> String
genDotfileFromGI :: [([[i]], [[i]], Bool)] -> String
genDotfileFromGI = (\String
s -> String
"digraph G {\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"}\n")
                 (String -> String)
-> ([([[i]], [[i]], Bool)] -> String)
-> [([[i]], [[i]], Bool)]
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines
                 ([String] -> String)
-> ([([[i]], [[i]], Bool)] -> [String])
-> [([[i]], [[i]], Bool)]
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([[i]], [[i]], Bool) -> String)
-> [([[i]], [[i]], Bool)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ([[i]], [[i]], Bool) -> String
showEntry
  where showG :: [[i]] -> String
showG = [String] -> String
unwords ([String] -> String) -> ([[i]] -> [String]) -> [[i]] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([i] -> String) -> [[i]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map [i] -> String
forall a. Show a => a -> String
show
        showEntry :: ([[i]], [[i]], Bool) -> String
showEntry ([[i]]
iss,[[i]]
jss,Bool
p) = String
"\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [[i]] -> String
showG [[i]]
iss String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\" -> \""
                                     String -> String -> String
forall a. [a] -> [a] -> [a]
++ [[i]] -> String
showG [[i]]
jss String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\""
                             String -> String -> String
forall a. [a] -> [a] -> [a]
++ if Bool
p
                                  then String
" [ color = grey ]"
                                  else String
""

-- | Equivalent to 'getResults' but returns a dotfile
getDotfile :: (Mutable a)
           => [a]
           -> Int -> Int -> a -> (a -> [Property])
           -> String
getDotfile :: [a] -> Int -> Int -> a -> (a -> [Property]) -> String
getDotfile [a]
ems Int
m Int
n a
f a -> [Property]
ps = [([[Int]], [[Int]], Bool)] -> String
forall i. Show i => [([[i]], [[i]], Bool)] -> String
genDotfileFromGI
                        ([([[Int]], [[Int]], Bool)] -> String)
-> ([Result a] -> [([[Int]], [[Int]], Bool)])
-> [Result a]
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [([[Int]], [[Int]])] -> [([[Int]], [[Int]], Bool)]
forall i. Eq i => [([[i]], [[i]])] -> [([[i]], [[i]], Bool)]
attachObviousness
                        ([([[Int]], [[Int]])] -> [([[Int]], [[Int]], Bool)])
-> ([Result a] -> [([[Int]], [[Int]])])
-> [Result a]
-> [([[Int]], [[Int]], Bool)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [([[Int]], [Int])] -> [([[Int]], [[Int]])]
forall i. Eq i => [([[i]], [i])] -> [([[i]], [[i]])]
groupImplications
                        ([([[Int]], [Int])] -> [([[Int]], [[Int]])])
-> ([Result a] -> [([[Int]], [Int])])
-> [Result a]
-> [([[Int]], [[Int]])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Result a -> ([[Int]], [Int])) -> [Result a] -> [([[Int]], [Int])]
forall a b. (a -> b) -> [a] -> [b]
map (\Result a
r -> (Result a -> [[Int]]
forall a. Result a -> [[Int]]
sets Result a
r, Result a -> [Int]
forall a. Result a -> [Int]
implied Result a
r))
                        ([Result a] -> String) -> [Result a] -> String
forall a b. (a -> b) -> a -> b
$ [a] -> a -> (a -> [Property]) -> Int -> Int -> [Result a]
forall a.
Mutable a =>
[a] -> a -> (a -> [Property]) -> Int -> Int -> Results a
getResultsExtra [a]
ems a
f a -> [Property]
ps Int
m Int
n

-- | Equivalent to report, but writes a dotfile to a file
writeDotfile :: (Mutable a)
             => String
             -> [a]
             -> Int -> Int -> a -> (a -> [Property])
             -> IO ()
writeDotfile :: String -> [a] -> Int -> Int -> a -> (a -> [Property]) -> IO ()
writeDotfile String
fn [a]
ems Int
m Int
n a
f = String -> String -> IO ()
writeFile String
fn (String -> IO ())
-> ((a -> [Property]) -> String) -> (a -> [Property]) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Int -> Int -> a -> (a -> [Property]) -> String
forall a.
Mutable a =>
[a] -> Int -> Int -> a -> (a -> [Property]) -> String
getDotfile [a]
ems Int
m Int
n a
f

-- | Equivalent to report, but writes a dotfile to stdout
putDotfile :: (Mutable a)
           => [a]
           -> Int -> Int -> a -> (a -> [Property])
           -> IO ()
putDotfile :: [a] -> Int -> Int -> a -> (a -> [Property]) -> IO ()
putDotfile [a]
ems Int
m Int
n a
f = String -> IO ()
putStr (String -> IO ())
-> ((a -> [Property]) -> String) -> (a -> [Property]) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Int -> Int -> a -> (a -> [Property]) -> String
forall a.
Mutable a =>
[a] -> Int -> Int -> a -> (a -> [Property]) -> String
getDotfile [a]
ems Int
m Int
n a
f