-
Notifications
You must be signed in to change notification settings - Fork 0
/
digraphs.hs
67 lines (54 loc) · 1.72 KB
/
digraphs.hs
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
{-# LANGUAGE CPP, DeriveDataTypeable, StandaloneDeriving #-} -- for GHC < 7.10
import Test.Speculate
import Digraph
#if __GLASGOW_HASKELL__ < 710
#if __GLASGOW_HASKELL__ < 708
import Data.Typeable (Typeable1)
deriving instance Typeable1 Digraph
#else
deriving instance Typeable Digraph
#endif
#endif
instance Ord a => Ord (Digraph a) where
g1 <= g2 = all (`elem` nodes g2) (nodes g1)
&& all (`elem` edges g2) (edges g1)
instance (Ord a, Listable a) => Listable (Digraph a) where
tiers = concatMapT graphs $ setsOf tiers
where
graphs ns = mapT (D . zip ns)
$ listsOfLength (length ns) (setsOf $ toTiers ns)
instance Name (Digraph a) where name _ = "a"
instance Name Nat where name _ = "x"
digraph :: a -> Digraph a
digraph = undefined
main :: IO ()
main = speculate args
{ instances =
[ reifyInstances nat
, reifyInstances (digraph nat)
]
, maxTests = 500
, maxVars = 2
, showConditions = True
, constants =
let
-- totalize functions for nicer output
-- (but also works without totalized functions)
addNode' n g | isNode n g = g
| otherwise = addNode n g
addEdge' n1 n2 g | isEdge n1 n2 g = g
| otherwise = addEdge n1 n2 g
in
[ background
, showConstant ([]::[Nat])
, constant "elem" $ elem ->:> [nat]
, foreground
, constant "empty" $ empty -: digraph nat
, constant "addNode" $ addNode' -:> nat
, constant "addEdge" $ addEdge' -:> nat
, constant "isNode" $ isNode -:> nat
, constant "isEdge" $ isEdge -:> nat
, constant "isPath" $ isPath -:> nat
, constant "subgraph" $ subgraph -:> [nat]
]
}