1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
|
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_HADDOCK hide #-}
{- |
Module : Data.GraphViz.Testing.Instances.Canonical
Description : Canonical dot graph instances for Arbitrary.
Copyright : (c) Ivan Lazar Miljenovic
License : 3-Clause BSD-style
Maintainer : Ivan.Miljenovic@gmail.com
-}
module Data.GraphViz.Testing.Instances.Canonical where
import Data.GraphViz.Testing.Instances.Common
import Data.GraphViz.Testing.Instances.Helpers
import Data.GraphViz.Internal.Util (bool)
import Data.GraphViz.Types.Canonical
import Test.QuickCheck
import Control.Monad (liftM2, liftM4)
-- -----------------------------------------------------------------------------
-- Defining Arbitrary instances for the overall types
instance (Eq n, Arbitrary n) => Arbitrary (DotGraph n) where
arbitrary = liftM4 DotGraph arbitrary arbitrary arbitrary arbitrary
shrink (DotGraph str dir gid stmts) = map (DotGraph str dir gid)
$ shrink stmts
instance (Eq n, Arbitrary n) => Arbitrary (DotStatements n) where
arbitrary = sized (arbDS gaGraph True)
shrink ds@(DotStmts gas sgs ns es) = do gas' <- shrink gas
sgs' <- shrink sgs
ns' <- shrink ns
es' <- shrink es
returnCheck ds
$ DotStmts gas' sgs' ns' es'
-- | If 'True', generate 'DotSubGraph's; otherwise don't.
arbDS :: (Arbitrary n, Eq n) => Gen GlobalAttributes -> Bool
-> Int -> Gen (DotStatements n)
arbDS ga haveSGs s = liftM4 DotStmts (listOf ga) genSGs arbitrary arbitrary
where
s' = min s 2
genSGs = if haveSGs
then resize s' arbitrary
else return []
instance (Eq n, Arbitrary n) => Arbitrary (DotSubGraph n) where
arbitrary = do isClust <- arbitrary
let ga = bool gaSubGraph gaClusters isClust
liftM2 (DotSG isClust) arbitrary (sized $ arbDS ga False)
shrink (DotSG isCl mid stmts) = map (DotSG isCl mid) $ shrink stmts
|
