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
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
|
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_HADDOCK hide #-}
{- |
Module : Data.GraphViz.Testing.Instances.Common()
Description : Attribute instances for Arbitrary.
Copyright : (c) Ivan Lazar Miljenovic
License : 3-Clause BSD-style
Maintainer : Ivan.Miljenovic@gmail.com
-}
module Data.GraphViz.Testing.Instances.Common
( gaGraph
, gaSubGraph
, gaClusters
) where
import Data.GraphViz.Testing.Instances.Attributes
import Data.GraphViz.Testing.Instances.Helpers
import Data.GraphViz.Algorithms (CanonicaliseOptions (..))
import Data.GraphViz.Attributes (Attributes)
import Data.GraphViz.Types.Internal.Common (DotEdge (..), DotNode (..),
GlobalAttributes (..), GraphID (..))
import Test.QuickCheck
import Control.Monad (liftM, liftM2, liftM3)
-- -----------------------------------------------------------------------------
-- Common values
instance Arbitrary GraphID where
arbitrary = oneof [ liftM Str arbitrary
, liftM Num arbitrary
]
shrink (Str s) = map Str $ shrink s
shrink (Num n) = map Num $ shrink n
instance (Arbitrary n) => Arbitrary (DotNode n) where
arbitrary = liftM2 DotNode arbitrary arbNodeAttrs
shrink (DotNode n as) = map (DotNode n) $ shrink as
instance (Arbitrary n) => Arbitrary (DotEdge n) where
arbitrary = liftM3 DotEdge arbitrary arbitrary arbEdgeAttrs
shrink (DotEdge f t as) = map (DotEdge f t) $ shrink as
instance Arbitrary GlobalAttributes where
arbitrary = gaGraph
shrink (GraphAttrs atts) = map GraphAttrs $ nonEmptyShrinks atts
shrink (NodeAttrs atts) = map NodeAttrs $ nonEmptyShrinks atts
shrink (EdgeAttrs atts) = map EdgeAttrs $ nonEmptyShrinks atts
gaGraph :: Gen GlobalAttributes
gaGraph = gaFor arbGraphAttrs
gaSubGraph :: Gen GlobalAttributes
gaSubGraph = gaFor arbSubGraphAttrs
gaClusters :: Gen GlobalAttributes
gaClusters = gaFor arbClusterAttrs
gaFor :: Gen Attributes -> Gen GlobalAttributes
gaFor g = oneof [ liftM GraphAttrs g
, liftM NodeAttrs arbNodeAttrs
, liftM EdgeAttrs arbEdgeAttrs
]
instance Arbitrary CanonicaliseOptions where
arbitrary = liftM2 COpts arbitrary arbitrary
|
