summaryrefslogtreecommitdiff
path: root/tests/Data/Graph/Dynamic/Action.hs
blob: cab2ce6b3b99a47d6a75c3c4f80503022726ef61 (plain)
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
74
75
76
77
78
-- | Generate arbitrary "actions" (cut, link...) to test the connectivity
-- algorithms.
{-# LANGUAGE DataKinds          #-}
{-# LANGUAGE DeriveFunctor      #-}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE FlexibleInstances  #-}
{-# LANGUAGE GADTs              #-}
{-# LANGUAGE KindSignatures     #-}
{-# LANGUAGE StandaloneDeriving #-}
module Data.Graph.Dynamic.Action
    ( ActionType (..)
    , Action (..)

    , runSlowForestAction
    , runSlowGraphAction
    ) where

import qualified Data.Graph.Dynamic.Slow as Slow
import           Data.Hashable           (Hashable)
import           Test.QuickCheck

data ActionType = LinkCut | Toggl

data Action (t :: ActionType) v where
  Cut :: !v -> !v -> Action 'LinkCut v
  Link :: !v -> !v -> Action 'LinkCut v
  Toggle :: !v -> !v -> Action 'Toggl v
  Query :: !v -> !v -> Action a v

deriving instance Show v => Show (Action t v)

deriving instance Functor (Action t)

instance Arbitrary v => Arbitrary (Action 'LinkCut v) where
  arbitrary = oneof
    [ Cut <$> arbitrary <*> arbitrary
    , Link <$> arbitrary <*> arbitrary
    , Query <$> arbitrary <*> arbitrary
    ]
  shrink (Link a b)  = Link <$> shrink a <*> shrink b
  shrink (Cut a b)   = Cut <$> shrink a <*> shrink b
  shrink (Query a b) = Query <$> shrink a <*> shrink b

instance Arbitrary v => Arbitrary (Action 'Toggl v) where
  arbitrary = oneof
    [ Toggle <$> arbitrary <*> arbitrary
    , Query <$> arbitrary <*> arbitrary
    ]
  shrink (Toggle a b) = Toggle <$> shrink a <*> shrink b
  shrink (Query a b)  = Query <$> shrink a <*> shrink b

runSlowForestAction
    :: (Eq v, Hashable v)
    => Slow.Graph v -> Action t v -> (Slow.Graph v, Maybe Bool)
runSlowForestAction graph (Cut x y) =
    (Slow.cut x y graph, Nothing)
runSlowForestAction graph (Link x y)
    | Slow.connected x y graph = (graph, Nothing)
    | otherwise                = (Slow.link x y graph, Nothing)
runSlowForestAction graph (Toggle x y)
    | Slow.edge x y graph      = (Slow.cut x y graph, Nothing)
    | Slow.connected x y graph = (graph, Nothing)
    | otherwise                = (Slow.link x y graph, Nothing)
runSlowForestAction graph (Query x y) =
    (graph, Just (Slow.connected x y graph))

runSlowGraphAction
    :: (Eq v, Hashable v)
    => Slow.Graph v -> Action t v -> (Slow.Graph v, Maybe Bool)
runSlowGraphAction graph (Cut x y) =
    (Slow.cut x y graph, Nothing)
runSlowGraphAction graph (Link x y) =
    (Slow.link x y graph, Nothing)
runSlowGraphAction graph (Toggle x y)
    | Slow.edge x y graph = (Slow.cut x y graph, Nothing)
    | otherwise           = (Slow.link x y graph, Nothing)
runSlowGraphAction graph (Query x y) =
    (graph, Just (Slow.connected x y graph))