{-# LANGUAGE CPP, FlexibleContexts, ScopedTypeVariables, TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{- |
   Module      : Data.Graph.Inductive.Arbitrary
   Description : Arbitrary definition for fgl graphs
   Copyright   : (c) Ivan Lazar Miljenovic
   License     : BSD3
   Maintainer  : Ivan.Miljenovic@gmail.com

This module provides default definitions for use with QuickCheck's
'Arbitrary' class.

Both "Data.Graph.Inductive.Tree"- and
"Data.Graph.Inductive.PatriciaTree"-based graph implementations have
'Arbitrary' instances.  In most cases, this is all you will need.

If, however, you want to create arbitrary custom graph-like data
structures, then you will probably want to do some custom processing
from an arbitrary 'GraphNodesEdges' value, either directly or with a
custom 'ArbGraph' instance.

 -}
module Data.Graph.Inductive.Arbitrary
       ( -- * Explicit graph creation
         -- $explicit
         arbitraryGraph
       , arbitraryGraphWith
       , shrinkGraph
       , shrinkGraphWith
         -- * Types of graphs
       , ArbGraph(..)
       , GrProxy(..)
       , shrinkF
       , arbitraryGraphBy
         -- ** Specific graph structures
       , NoMultipleEdges(..)
       , NoLoops(..)
       , SimpleGraph
       , Undirected(..)
         -- ** Connected graphs
       , Connected(..)
       , connGraph
         -- * Node and edge lists
       , arbitraryNodes
       , arbitraryEdges
       , GraphNodesEdges(..)
       ) where

import           Data.Graph.Inductive.Graph        (DynGraph, Graph, LEdge,
                                                    LNode, Node, delNode,
                                                    insEdges, insNode, mkGraph,
                                                    newNodes, nodes, toEdge)
import qualified Data.Graph.Inductive.PatriciaTree as P
import qualified Data.Graph.Inductive.Tree         as T

import Test.QuickCheck (Arbitrary (..), Gen, elements, listOf)

import Control.Applicative (liftA3)
import Control.Arrow       (second)
import Data.Function       (on)
import Data.List           (deleteBy, groupBy, sortBy)
import Data.Maybe          (mapMaybe)

#if __GLASGOW_HASKELL__ < 710
import Control.Applicative ((<$>), (<*>))
#endif

-- -----------------------------------------------------------------------------

-- | Generally a list of labelled nodes.
arbitraryNodes :: (Arbitrary a) => Gen [LNode a]
arbitraryNodes :: Gen [LNode a]
arbitraryNodes = Gen [Node]
forall a. Arbitrary a => Gen a
arbitrary Gen [Node] -> ([Node] -> Gen [LNode a]) -> Gen [LNode a]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Node -> Gen (LNode a)) -> [Node] -> Gen [LNode a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (((a -> LNode a) -> Gen a -> Gen (LNode a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
forall a. Arbitrary a => Gen a
arbitrary) ((a -> LNode a) -> Gen (LNode a))
-> (Node -> a -> LNode a) -> Node -> Gen (LNode a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,)) ([Node] -> Gen [LNode a])
-> ([Node] -> [Node]) -> [Node] -> Gen [LNode a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Node] -> [Node]
uniq

-- | Given a specified list of nodes, generate a list of edges.
arbitraryEdges :: (Arbitrary b) => [LNode a] -> Gen [LEdge b]
arbitraryEdges :: [LNode a] -> Gen [LEdge b]
arbitraryEdges lns :: [LNode a]
lns
  | [LNode a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LNode a]
lns  = [LEdge b] -> Gen [LEdge b]
forall (m :: * -> *) a. Monad m => a -> m a
return []
  | Bool
otherwise = Gen (LEdge b) -> Gen [LEdge b]
forall a. Gen a -> Gen [a]
listOf ((Node -> Node -> b -> LEdge b)
-> Gen Node -> Gen Node -> Gen b -> Gen (LEdge b)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 (,,) Gen Node
nGen Gen Node
nGen Gen b
forall a. Arbitrary a => Gen a
arbitrary)
  where
    nGen :: Gen Node
nGen = [Node] -> Gen Node
forall a. [a] -> Gen a
elements ((LNode a -> Node) -> [LNode a] -> [Node]
forall a b. (a -> b) -> [a] -> [b]
map LNode a -> Node
forall a b. (a, b) -> a
fst [LNode a]
lns)

-- | Defined so as to be able to generate valid 'arbitrary' node and
--   edge lists.
--
--   If any specific structure (no multiple edges, no loops, etc.) is
--   required then you will need to post-process this after generating
--   it, or else create a new instance of 'ArbGraph'.
data GraphNodesEdges a b = GNEs { GraphNodesEdges a b -> [LNode a]
graphNodes :: [LNode a]
                                , GraphNodesEdges a b -> [LEdge b]
graphEdges :: [LEdge b]
                                }
  deriving (GraphNodesEdges a b -> GraphNodesEdges a b -> Bool
(GraphNodesEdges a b -> GraphNodesEdges a b -> Bool)
-> (GraphNodesEdges a b -> GraphNodesEdges a b -> Bool)
-> Eq (GraphNodesEdges a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b.
(Eq a, Eq b) =>
GraphNodesEdges a b -> GraphNodesEdges a b -> Bool
/= :: GraphNodesEdges a b -> GraphNodesEdges a b -> Bool
$c/= :: forall a b.
(Eq a, Eq b) =>
GraphNodesEdges a b -> GraphNodesEdges a b -> Bool
== :: GraphNodesEdges a b -> GraphNodesEdges a b -> Bool
$c== :: forall a b.
(Eq a, Eq b) =>
GraphNodesEdges a b -> GraphNodesEdges a b -> Bool
Eq, Eq (GraphNodesEdges a b)
Eq (GraphNodesEdges a b) =>
(GraphNodesEdges a b -> GraphNodesEdges a b -> Ordering)
-> (GraphNodesEdges a b -> GraphNodesEdges a b -> Bool)
-> (GraphNodesEdges a b -> GraphNodesEdges a b -> Bool)
-> (GraphNodesEdges a b -> GraphNodesEdges a b -> Bool)
-> (GraphNodesEdges a b -> GraphNodesEdges a b -> Bool)
-> (GraphNodesEdges a b
    -> GraphNodesEdges a b -> GraphNodesEdges a b)
-> (GraphNodesEdges a b
    -> GraphNodesEdges a b -> GraphNodesEdges a b)
-> Ord (GraphNodesEdges a b)
GraphNodesEdges a b -> GraphNodesEdges a b -> Bool
GraphNodesEdges a b -> GraphNodesEdges a b -> Ordering
GraphNodesEdges a b -> GraphNodesEdges a b -> GraphNodesEdges a b
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a b. (Ord a, Ord b) => Eq (GraphNodesEdges a b)
forall a b.
(Ord a, Ord b) =>
GraphNodesEdges a b -> GraphNodesEdges a b -> Bool
forall a b.
(Ord a, Ord b) =>
GraphNodesEdges a b -> GraphNodesEdges a b -> Ordering
forall a b.
(Ord a, Ord b) =>
GraphNodesEdges a b -> GraphNodesEdges a b -> GraphNodesEdges a b
min :: GraphNodesEdges a b -> GraphNodesEdges a b -> GraphNodesEdges a b
$cmin :: forall a b.
(Ord a, Ord b) =>
GraphNodesEdges a b -> GraphNodesEdges a b -> GraphNodesEdges a b
max :: GraphNodesEdges a b -> GraphNodesEdges a b -> GraphNodesEdges a b
$cmax :: forall a b.
(Ord a, Ord b) =>
GraphNodesEdges a b -> GraphNodesEdges a b -> GraphNodesEdges a b
>= :: GraphNodesEdges a b -> GraphNodesEdges a b -> Bool
$c>= :: forall a b.
(Ord a, Ord b) =>
GraphNodesEdges a b -> GraphNodesEdges a b -> Bool
> :: GraphNodesEdges a b -> GraphNodesEdges a b -> Bool
$c> :: forall a b.
(Ord a, Ord b) =>
GraphNodesEdges a b -> GraphNodesEdges a b -> Bool
<= :: GraphNodesEdges a b -> GraphNodesEdges a b -> Bool
$c<= :: forall a b.
(Ord a, Ord b) =>
GraphNodesEdges a b -> GraphNodesEdges a b -> Bool
< :: GraphNodesEdges a b -> GraphNodesEdges a b -> Bool
$c< :: forall a b.
(Ord a, Ord b) =>
GraphNodesEdges a b -> GraphNodesEdges a b -> Bool
compare :: GraphNodesEdges a b -> GraphNodesEdges a b -> Ordering
$ccompare :: forall a b.
(Ord a, Ord b) =>
GraphNodesEdges a b -> GraphNodesEdges a b -> Ordering
$cp1Ord :: forall a b. (Ord a, Ord b) => Eq (GraphNodesEdges a b)
Ord, Node -> GraphNodesEdges a b -> ShowS
[GraphNodesEdges a b] -> ShowS
GraphNodesEdges a b -> String
(Node -> GraphNodesEdges a b -> ShowS)
-> (GraphNodesEdges a b -> String)
-> ([GraphNodesEdges a b] -> ShowS)
-> Show (GraphNodesEdges a b)
forall a.
(Node -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b.
(Show a, Show b) =>
Node -> GraphNodesEdges a b -> ShowS
forall a b. (Show a, Show b) => [GraphNodesEdges a b] -> ShowS
forall a b. (Show a, Show b) => GraphNodesEdges a b -> String
showList :: [GraphNodesEdges a b] -> ShowS
$cshowList :: forall a b. (Show a, Show b) => [GraphNodesEdges a b] -> ShowS
show :: GraphNodesEdges a b -> String
$cshow :: forall a b. (Show a, Show b) => GraphNodesEdges a b -> String
showsPrec :: Node -> GraphNodesEdges a b -> ShowS
$cshowsPrec :: forall a b.
(Show a, Show b) =>
Node -> GraphNodesEdges a b -> ShowS
Show, ReadPrec [GraphNodesEdges a b]
ReadPrec (GraphNodesEdges a b)
Node -> ReadS (GraphNodesEdges a b)
ReadS [GraphNodesEdges a b]
(Node -> ReadS (GraphNodesEdges a b))
-> ReadS [GraphNodesEdges a b]
-> ReadPrec (GraphNodesEdges a b)
-> ReadPrec [GraphNodesEdges a b]
-> Read (GraphNodesEdges a b)
forall a.
(Node -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall a b. (Read a, Read b) => ReadPrec [GraphNodesEdges a b]
forall a b. (Read a, Read b) => ReadPrec (GraphNodesEdges a b)
forall a b. (Read a, Read b) => Node -> ReadS (GraphNodesEdges a b)
forall a b. (Read a, Read b) => ReadS [GraphNodesEdges a b]
readListPrec :: ReadPrec [GraphNodesEdges a b]
$creadListPrec :: forall a b. (Read a, Read b) => ReadPrec [GraphNodesEdges a b]
readPrec :: ReadPrec (GraphNodesEdges a b)
$creadPrec :: forall a b. (Read a, Read b) => ReadPrec (GraphNodesEdges a b)
readList :: ReadS [GraphNodesEdges a b]
$creadList :: forall a b. (Read a, Read b) => ReadS [GraphNodesEdges a b]
readsPrec :: Node -> ReadS (GraphNodesEdges a b)
$creadsPrec :: forall a b. (Read a, Read b) => Node -> ReadS (GraphNodesEdges a b)
Read)

instance (Arbitrary a, Arbitrary b) => Arbitrary (GraphNodesEdges a b) where
  arbitrary :: Gen (GraphNodesEdges a b)
arbitrary = do [LNode a]
ns <- Gen [LNode a]
forall a. Arbitrary a => Gen [LNode a]
arbitraryNodes
                 [LNode a] -> [LEdge b] -> GraphNodesEdges a b
forall a b. [LNode a] -> [LEdge b] -> GraphNodesEdges a b
GNEs [LNode a]
ns ([LEdge b] -> GraphNodesEdges a b)
-> Gen [LEdge b] -> Gen (GraphNodesEdges a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LNode a] -> Gen [LEdge b]
forall b a. Arbitrary b => [LNode a] -> Gen [LEdge b]
arbitraryEdges [LNode a]
ns

  shrink :: GraphNodesEdges a b -> [GraphNodesEdges a b]
shrink (GNEs ns :: [LNode a]
ns es :: [LEdge b]
es) = case [LNode a]
ns of
                          _:_:_ -> (LNode a -> GraphNodesEdges a b)
-> [LNode a] -> [GraphNodesEdges a b]
forall a b. (a -> b) -> [a] -> [b]
map LNode a -> GraphNodesEdges a b
delN [LNode a]
ns
                          _     -> []
    where
      delN :: LNode a -> GraphNodesEdges a b
delN ln :: LNode a
ln@(n :: Node
n,_) = [LNode a] -> [LEdge b] -> GraphNodesEdges a b
forall a b. [LNode a] -> [LEdge b] -> GraphNodesEdges a b
GNEs [LNode a]
ns' [LEdge b]
es'
        where
          ns' :: [LNode a]
ns' = (LNode a -> LNode a -> Bool) -> LNode a -> [LNode a] -> [LNode a]
forall a. (a -> a -> Bool) -> a -> [a] -> [a]
deleteBy (Node -> Node -> Bool
forall a. Eq a => a -> a -> Bool
(==)(Node -> Node -> Bool)
-> (LNode a -> Node) -> LNode a -> LNode a -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on`LNode a -> Node
forall a b. (a, b) -> a
fst) LNode a
ln [LNode a]
ns
          es' :: [LEdge b]
es' = (LEdge b -> Bool) -> [LEdge b] -> [LEdge b]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (LEdge b -> Bool) -> LEdge b -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LEdge b -> Bool
hasN) [LEdge b]
es

          hasN :: LEdge b -> Bool
hasN (v :: Node
v,w :: Node
w,_) = Node
v Node -> Node -> Bool
forall a. Eq a => a -> a -> Bool
== Node
n Bool -> Bool -> Bool
|| Node
w Node -> Node -> Bool
forall a. Eq a => a -> a -> Bool
== Node
n

-- -----------------------------------------------------------------------------

-- | Representation of generating arbitrary graph structures.
--
--   Typically, you would only use this for the 'toBaseGraph' function
--   or if you wanted to make a custom graph wrapper.
--
--   The intent of this class is to simplify defining and using
--   different wrappers on top of graphs (e.g. you may wish to have an
--   'Undirected' graph, or one with 'NoLoops', or possibly both!).
class (DynGraph (BaseGraph ag)) => ArbGraph ag where
  type BaseGraph ag :: * -> * -> *

  toBaseGraph :: ag a b -> BaseGraph ag a b

  fromBaseGraph :: BaseGraph ag a b -> ag a b

  -- | Any manipulation of edges that should be done to satisfy the
  --   requirements of the specified wrapper.
  edgeF :: GrProxy ag -> [LEdge b] -> [LEdge b]

  -- | Shrinking function (assuming only one node is removed at a
  --   time) which also returns the node that is removed.
  shrinkFWith :: ag a b -> [(Node, ag a b)]

-- | In most cases, for an instance of 'ArbGraph' the 'Arbitrary'
--   instance definition will\/can have @shrink = shrinkF@.
shrinkF :: (ArbGraph ag) => ag a b -> [ag a b]
shrinkF :: ag a b -> [ag a b]
shrinkF = ((Node, ag a b) -> ag a b) -> [(Node, ag a b)] -> [ag a b]
forall a b. (a -> b) -> [a] -> [b]
map (Node, ag a b) -> ag a b
forall a b. (a, b) -> b
snd ([(Node, ag a b)] -> [ag a b])
-> (ag a b -> [(Node, ag a b)]) -> ag a b -> [ag a b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ag a b -> [(Node, ag a b)]
forall (ag :: * -> * -> *) a b.
ArbGraph ag =>
ag a b -> [(Node, ag a b)]
shrinkFWith

instance ArbGraph T.Gr where
  type BaseGraph T.Gr = T.Gr

  toBaseGraph :: Gr a b -> BaseGraph Gr a b
toBaseGraph = Gr a b -> BaseGraph Gr a b
forall a. a -> a
id
  fromBaseGraph :: BaseGraph Gr a b -> Gr a b
fromBaseGraph = BaseGraph Gr a b -> Gr a b
forall a. a -> a
id

  edgeF :: GrProxy Gr -> [LEdge b] -> [LEdge b]
edgeF _ = [LEdge b] -> [LEdge b]
forall a. a -> a
id

  shrinkFWith :: Gr a b -> [(Node, Gr a b)]
shrinkFWith = Gr a b -> [(Node, Gr a b)]
forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> [(Node, gr a b)]
shrinkGraphWith

instance ArbGraph P.Gr where
  type BaseGraph P.Gr = P.Gr

  toBaseGraph :: Gr a b -> BaseGraph Gr a b
toBaseGraph = Gr a b -> BaseGraph Gr a b
forall a. a -> a
id
  fromBaseGraph :: BaseGraph Gr a b -> Gr a b
fromBaseGraph = BaseGraph Gr a b -> Gr a b
forall a. a -> a
id

  edgeF :: GrProxy Gr -> [LEdge b] -> [LEdge b]
edgeF _ = [LEdge b] -> [LEdge b]
forall a. a -> a
id

  shrinkFWith :: Gr a b -> [(Node, Gr a b)]
shrinkFWith = Gr a b -> [(Node, Gr a b)]
forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> [(Node, gr a b)]
shrinkGraphWith

-- | A simple graph-specific proxy type.
data GrProxy (gr :: * -> * -> *) = GrProxy
  deriving (GrProxy gr -> GrProxy gr -> Bool
(GrProxy gr -> GrProxy gr -> Bool)
-> (GrProxy gr -> GrProxy gr -> Bool) -> Eq (GrProxy gr)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (gr :: * -> * -> *). GrProxy gr -> GrProxy gr -> Bool
/= :: GrProxy gr -> GrProxy gr -> Bool
$c/= :: forall (gr :: * -> * -> *). GrProxy gr -> GrProxy gr -> Bool
== :: GrProxy gr -> GrProxy gr -> Bool
$c== :: forall (gr :: * -> * -> *). GrProxy gr -> GrProxy gr -> Bool
Eq, Eq (GrProxy gr)
Eq (GrProxy gr) =>
(GrProxy gr -> GrProxy gr -> Ordering)
-> (GrProxy gr -> GrProxy gr -> Bool)
-> (GrProxy gr -> GrProxy gr -> Bool)
-> (GrProxy gr -> GrProxy gr -> Bool)
-> (GrProxy gr -> GrProxy gr -> Bool)
-> (GrProxy gr -> GrProxy gr -> GrProxy gr)
-> (GrProxy gr -> GrProxy gr -> GrProxy gr)
-> Ord (GrProxy gr)
GrProxy gr -> GrProxy gr -> Bool
GrProxy gr -> GrProxy gr -> Ordering
GrProxy gr -> GrProxy gr -> GrProxy gr
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall (gr :: * -> * -> *). Eq (GrProxy gr)
forall (gr :: * -> * -> *). GrProxy gr -> GrProxy gr -> Bool
forall (gr :: * -> * -> *). GrProxy gr -> GrProxy gr -> Ordering
forall (gr :: * -> * -> *). GrProxy gr -> GrProxy gr -> GrProxy gr
min :: GrProxy gr -> GrProxy gr -> GrProxy gr
$cmin :: forall (gr :: * -> * -> *). GrProxy gr -> GrProxy gr -> GrProxy gr
max :: GrProxy gr -> GrProxy gr -> GrProxy gr
$cmax :: forall (gr :: * -> * -> *). GrProxy gr -> GrProxy gr -> GrProxy gr
>= :: GrProxy gr -> GrProxy gr -> Bool
$c>= :: forall (gr :: * -> * -> *). GrProxy gr -> GrProxy gr -> Bool
> :: GrProxy gr -> GrProxy gr -> Bool
$c> :: forall (gr :: * -> * -> *). GrProxy gr -> GrProxy gr -> Bool
<= :: GrProxy gr -> GrProxy gr -> Bool
$c<= :: forall (gr :: * -> * -> *). GrProxy gr -> GrProxy gr -> Bool
< :: GrProxy gr -> GrProxy gr -> Bool
$c< :: forall (gr :: * -> * -> *). GrProxy gr -> GrProxy gr -> Bool
compare :: GrProxy gr -> GrProxy gr -> Ordering
$ccompare :: forall (gr :: * -> * -> *). GrProxy gr -> GrProxy gr -> Ordering
$cp1Ord :: forall (gr :: * -> * -> *). Eq (GrProxy gr)
Ord, Node -> GrProxy gr -> ShowS
[GrProxy gr] -> ShowS
GrProxy gr -> String
(Node -> GrProxy gr -> ShowS)
-> (GrProxy gr -> String)
-> ([GrProxy gr] -> ShowS)
-> Show (GrProxy gr)
forall a.
(Node -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (gr :: * -> * -> *). Node -> GrProxy gr -> ShowS
forall (gr :: * -> * -> *). [GrProxy gr] -> ShowS
forall (gr :: * -> * -> *). GrProxy gr -> String
showList :: [GrProxy gr] -> ShowS
$cshowList :: forall (gr :: * -> * -> *). [GrProxy gr] -> ShowS
show :: GrProxy gr -> String
$cshow :: forall (gr :: * -> * -> *). GrProxy gr -> String
showsPrec :: Node -> GrProxy gr -> ShowS
$cshowsPrec :: forall (gr :: * -> * -> *). Node -> GrProxy gr -> ShowS
Show, ReadPrec [GrProxy gr]
ReadPrec (GrProxy gr)
Node -> ReadS (GrProxy gr)
ReadS [GrProxy gr]
(Node -> ReadS (GrProxy gr))
-> ReadS [GrProxy gr]
-> ReadPrec (GrProxy gr)
-> ReadPrec [GrProxy gr]
-> Read (GrProxy gr)
forall a.
(Node -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall (gr :: * -> * -> *). ReadPrec [GrProxy gr]
forall (gr :: * -> * -> *). ReadPrec (GrProxy gr)
forall (gr :: * -> * -> *). Node -> ReadS (GrProxy gr)
forall (gr :: * -> * -> *). ReadS [GrProxy gr]
readListPrec :: ReadPrec [GrProxy gr]
$creadListPrec :: forall (gr :: * -> * -> *). ReadPrec [GrProxy gr]
readPrec :: ReadPrec (GrProxy gr)
$creadPrec :: forall (gr :: * -> * -> *). ReadPrec (GrProxy gr)
readList :: ReadS [GrProxy gr]
$creadList :: forall (gr :: * -> * -> *). ReadS [GrProxy gr]
readsPrec :: Node -> ReadS (GrProxy gr)
$creadsPrec :: forall (gr :: * -> * -> *). Node -> ReadS (GrProxy gr)
Read)

-- -----------------------------------------------------------------------------

{- $explicit

If you wish to explicitly create a generated graph value (rather than
using the 'Arbitrary' class) then you will want to use these
functions.

-}

-- | Generate an arbitrary graph.  Multiple edges are allowed.
arbitraryGraph :: (Graph gr, Arbitrary a, Arbitrary b) => Gen (gr a b)
arbitraryGraph :: Gen (gr a b)
arbitraryGraph = ([LEdge b] -> [LEdge b]) -> Gen (gr a b)
forall (gr :: * -> * -> *) a b.
(Graph gr, Arbitrary a, Arbitrary b) =>
([LEdge b] -> [LEdge b]) -> Gen (gr a b)
arbitraryGraphWith [LEdge b] -> [LEdge b]
forall a. a -> a
id

-- | Generate an arbitrary graph, using the specified function to
--   manipulate the generated list of edges (e.g. remove multiple
--   edges).
arbitraryGraphWith :: (Graph gr, Arbitrary a, Arbitrary b)
                      => ([LEdge b] -> [LEdge b]) -> Gen (gr a b)
arbitraryGraphWith :: ([LEdge b] -> [LEdge b]) -> Gen (gr a b)
arbitraryGraphWith f :: [LEdge b] -> [LEdge b]
f = do GNEs ns :: [LNode a]
ns es :: [LEdge b]
es <- Gen (GraphNodesEdges a b)
forall a. Arbitrary a => Gen a
arbitrary
                          let es' :: [LEdge b]
es' = [LEdge b] -> [LEdge b]
f [LEdge b]
es
                          gr a b -> Gen (gr a b)
forall (m :: * -> *) a. Monad m => a -> m a
return ([LNode a] -> [LEdge b] -> gr a b
forall (gr :: * -> * -> *) a b.
Graph gr =>
[LNode a] -> [LEdge b] -> gr a b
mkGraph [LNode a]
ns [LEdge b]
es')

-- | Generate an instance of 'ArbGraph' using the class methods.
arbitraryGraphBy :: forall ag a b. (ArbGraph ag, Arbitrary a, Arbitrary b)
                    => Gen (ag a b)
arbitraryGraphBy :: Gen (ag a b)
arbitraryGraphBy = BaseGraph ag a b -> ag a b
forall (ag :: * -> * -> *) a b.
ArbGraph ag =>
BaseGraph ag a b -> ag a b
fromBaseGraph
                   (BaseGraph ag a b -> ag a b)
-> Gen (BaseGraph ag a b) -> Gen (ag a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([LEdge b] -> [LEdge b]) -> Gen (BaseGraph ag a b)
forall (gr :: * -> * -> *) a b.
(Graph gr, Arbitrary a, Arbitrary b) =>
([LEdge b] -> [LEdge b]) -> Gen (gr a b)
arbitraryGraphWith (GrProxy ag -> [LEdge b] -> [LEdge b]
forall (ag :: * -> * -> *) b.
ArbGraph ag =>
GrProxy ag -> [LEdge b] -> [LEdge b]
edgeF (GrProxy ag
forall (gr :: * -> * -> *). GrProxy gr
GrProxy :: GrProxy ag))

-- Ensure we have a list of unique Node values; this will also sort
-- the list, but that shouldn't matter.
uniq :: [Node] -> [Node]
uniq :: [Node] -> [Node]
uniq = (Node -> Node) -> [Node] -> [Node]
forall b a. Ord b => (a -> b) -> [a] -> [a]
uniqBy Node -> Node
forall a. a -> a
id

uniqBy :: (Ord b) => (a -> b) -> [a] -> [a]
uniqBy :: (a -> b) -> [a] -> [a]
uniqBy f :: a -> b
f = ([a] -> a) -> [[a]] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> a
forall a. [a] -> a
head ([[a]] -> [a]) -> ([a] -> [[a]]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> Bool) -> [a] -> [[a]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (b -> b -> Bool
forall a. Eq a => a -> a -> Bool
(==) (b -> b -> Bool) -> (a -> b) -> a -> a -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` a -> b
f) ([a] -> [[a]]) -> ([a] -> [a]) -> [a] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> Ordering) -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (b -> b -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (b -> b -> Ordering) -> (a -> b) -> a -> a -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` a -> b
f)

-- | For a graph with at least two nodes, return every possible way of
--   deleting a single node (i.e. will never shrink to an empty
--   graph).
shrinkGraph :: (Graph gr) => gr a b -> [gr a b]
shrinkGraph :: gr a b -> [gr a b]
shrinkGraph = ((Node, gr a b) -> gr a b) -> [(Node, gr a b)] -> [gr a b]
forall a b. (a -> b) -> [a] -> [b]
map (Node, gr a b) -> gr a b
forall a b. (a, b) -> b
snd ([(Node, gr a b)] -> [gr a b])
-> (gr a b -> [(Node, gr a b)]) -> gr a b -> [gr a b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. gr a b -> [(Node, gr a b)]
forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> [(Node, gr a b)]
shrinkGraphWith

-- | As with 'shrinkGraph', but also return the node that was deleted.
shrinkGraphWith :: (Graph gr) => gr a b -> [(Node, gr a b)]
shrinkGraphWith :: gr a b -> [(Node, gr a b)]
shrinkGraphWith gr :: gr a b
gr = case gr a b -> [Node]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [Node]
nodes gr a b
gr of
                       -- Need to have at least 2 nodes before we delete one!
                       ns :: [Node]
ns@(_:_:_) -> (Node -> (Node, gr a b)) -> [Node] -> [(Node, gr a b)]
forall a b. (a -> b) -> [a] -> [b]
map ((,) (Node -> gr a b -> (Node, gr a b))
-> (Node -> gr a b) -> Node -> (Node, gr a b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Node -> gr a b -> gr a b
forall (gr :: * -> * -> *) a b.
Graph gr =>
Node -> gr a b -> gr a b
`delNode` gr a b
gr)) [Node]
ns
                       _          -> []

instance (Arbitrary a, Arbitrary b) => Arbitrary (T.Gr a b) where
  arbitrary :: Gen (Gr a b)
arbitrary = Gen (Gr a b)
forall (gr :: * -> * -> *) a b.
(Graph gr, Arbitrary a, Arbitrary b) =>
Gen (gr a b)
arbitraryGraph

  shrink :: Gr a b -> [Gr a b]
shrink = Gr a b -> [Gr a b]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [gr a b]
shrinkGraph

instance (Arbitrary a, Arbitrary b) => Arbitrary (P.Gr a b) where
  arbitrary :: Gen (Gr a b)
arbitrary = Gen (Gr a b)
forall (gr :: * -> * -> *) a b.
(Graph gr, Arbitrary a, Arbitrary b) =>
Gen (gr a b)
arbitraryGraph

  shrink :: Gr a b -> [Gr a b]
shrink = Gr a b -> [Gr a b]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [gr a b]
shrinkGraph

-- | A newtype wrapper to generate a graph without multiple edges
--   (loops allowed).
newtype NoMultipleEdges gr a b = NME { NoMultipleEdges gr a b -> gr a b
nmeGraph :: gr a b }
                                 deriving (NoMultipleEdges gr a b -> NoMultipleEdges gr a b -> Bool
(NoMultipleEdges gr a b -> NoMultipleEdges gr a b -> Bool)
-> (NoMultipleEdges gr a b -> NoMultipleEdges gr a b -> Bool)
-> Eq (NoMultipleEdges gr a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (gr :: * -> * -> *) a b.
Eq (gr a b) =>
NoMultipleEdges gr a b -> NoMultipleEdges gr a b -> Bool
/= :: NoMultipleEdges gr a b -> NoMultipleEdges gr a b -> Bool
$c/= :: forall (gr :: * -> * -> *) a b.
Eq (gr a b) =>
NoMultipleEdges gr a b -> NoMultipleEdges gr a b -> Bool
== :: NoMultipleEdges gr a b -> NoMultipleEdges gr a b -> Bool
$c== :: forall (gr :: * -> * -> *) a b.
Eq (gr a b) =>
NoMultipleEdges gr a b -> NoMultipleEdges gr a b -> Bool
Eq, Node -> NoMultipleEdges gr a b -> ShowS
[NoMultipleEdges gr a b] -> ShowS
NoMultipleEdges gr a b -> String
(Node -> NoMultipleEdges gr a b -> ShowS)
-> (NoMultipleEdges gr a b -> String)
-> ([NoMultipleEdges gr a b] -> ShowS)
-> Show (NoMultipleEdges gr a b)
forall a.
(Node -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (gr :: * -> * -> *) a b.
Show (gr a b) =>
Node -> NoMultipleEdges gr a b -> ShowS
forall (gr :: * -> * -> *) a b.
Show (gr a b) =>
[NoMultipleEdges gr a b] -> ShowS
forall (gr :: * -> * -> *) a b.
Show (gr a b) =>
NoMultipleEdges gr a b -> String
showList :: [NoMultipleEdges gr a b] -> ShowS
$cshowList :: forall (gr :: * -> * -> *) a b.
Show (gr a b) =>
[NoMultipleEdges gr a b] -> ShowS
show :: NoMultipleEdges gr a b -> String
$cshow :: forall (gr :: * -> * -> *) a b.
Show (gr a b) =>
NoMultipleEdges gr a b -> String
showsPrec :: Node -> NoMultipleEdges gr a b -> ShowS
$cshowsPrec :: forall (gr :: * -> * -> *) a b.
Show (gr a b) =>
Node -> NoMultipleEdges gr a b -> ShowS
Show, ReadPrec [NoMultipleEdges gr a b]
ReadPrec (NoMultipleEdges gr a b)
Node -> ReadS (NoMultipleEdges gr a b)
ReadS [NoMultipleEdges gr a b]
(Node -> ReadS (NoMultipleEdges gr a b))
-> ReadS [NoMultipleEdges gr a b]
-> ReadPrec (NoMultipleEdges gr a b)
-> ReadPrec [NoMultipleEdges gr a b]
-> Read (NoMultipleEdges gr a b)
forall a.
(Node -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall (gr :: * -> * -> *) a b.
Read (gr a b) =>
ReadPrec [NoMultipleEdges gr a b]
forall (gr :: * -> * -> *) a b.
Read (gr a b) =>
ReadPrec (NoMultipleEdges gr a b)
forall (gr :: * -> * -> *) a b.
Read (gr a b) =>
Node -> ReadS (NoMultipleEdges gr a b)
forall (gr :: * -> * -> *) a b.
Read (gr a b) =>
ReadS [NoMultipleEdges gr a b]
readListPrec :: ReadPrec [NoMultipleEdges gr a b]
$creadListPrec :: forall (gr :: * -> * -> *) a b.
Read (gr a b) =>
ReadPrec [NoMultipleEdges gr a b]
readPrec :: ReadPrec (NoMultipleEdges gr a b)
$creadPrec :: forall (gr :: * -> * -> *) a b.
Read (gr a b) =>
ReadPrec (NoMultipleEdges gr a b)
readList :: ReadS [NoMultipleEdges gr a b]
$creadList :: forall (gr :: * -> * -> *) a b.
Read (gr a b) =>
ReadS [NoMultipleEdges gr a b]
readsPrec :: Node -> ReadS (NoMultipleEdges gr a b)
$creadsPrec :: forall (gr :: * -> * -> *) a b.
Read (gr a b) =>
Node -> ReadS (NoMultipleEdges gr a b)
Read)

instance (ArbGraph gr) => ArbGraph (NoMultipleEdges gr) where
  type BaseGraph (NoMultipleEdges gr) = BaseGraph gr

  toBaseGraph :: NoMultipleEdges gr a b -> BaseGraph (NoMultipleEdges gr) a b
toBaseGraph = gr a b -> BaseGraph gr a b
forall (ag :: * -> * -> *) a b.
ArbGraph ag =>
ag a b -> BaseGraph ag a b
toBaseGraph(gr a b -> BaseGraph gr a b)
-> (NoMultipleEdges gr a b -> gr a b)
-> NoMultipleEdges gr a b
-> BaseGraph gr a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NoMultipleEdges gr a b -> gr a b
forall (gr :: * -> * -> *) a b. NoMultipleEdges gr a b -> gr a b
nmeGraph
  fromBaseGraph :: BaseGraph (NoMultipleEdges gr) a b -> NoMultipleEdges gr a b
fromBaseGraph = gr a b -> NoMultipleEdges gr a b
forall (gr :: * -> * -> *) a b. gr a b -> NoMultipleEdges gr a b
NME (gr a b -> NoMultipleEdges gr a b)
-> (BaseGraph gr a b -> gr a b)
-> BaseGraph gr a b
-> NoMultipleEdges gr a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BaseGraph gr a b -> gr a b
forall (ag :: * -> * -> *) a b.
ArbGraph ag =>
BaseGraph ag a b -> ag a b
fromBaseGraph

  edgeF :: GrProxy (NoMultipleEdges gr) -> [LEdge b] -> [LEdge b]
edgeF _ = (LEdge b -> Edge) -> [LEdge b] -> [LEdge b]
forall b a. Ord b => (a -> b) -> [a] -> [a]
uniqBy LEdge b -> Edge
forall b. LEdge b -> Edge
toEdge ([LEdge b] -> [LEdge b])
-> ([LEdge b] -> [LEdge b]) -> [LEdge b] -> [LEdge b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GrProxy gr -> [LEdge b] -> [LEdge b]
forall (ag :: * -> * -> *) b.
ArbGraph ag =>
GrProxy ag -> [LEdge b] -> [LEdge b]
edgeF (GrProxy gr
forall (gr :: * -> * -> *). GrProxy gr
GrProxy :: GrProxy gr)

  shrinkFWith :: NoMultipleEdges gr a b -> [(Node, NoMultipleEdges gr a b)]
shrinkFWith = ((Node, gr a b) -> (Node, NoMultipleEdges gr a b))
-> [(Node, gr a b)] -> [(Node, NoMultipleEdges gr a b)]
forall a b. (a -> b) -> [a] -> [b]
map ((gr a b -> NoMultipleEdges gr a b)
-> (Node, gr a b) -> (Node, NoMultipleEdges gr a b)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second gr a b -> NoMultipleEdges gr a b
forall (gr :: * -> * -> *) a b. gr a b -> NoMultipleEdges gr a b
NME) ([(Node, gr a b)] -> [(Node, NoMultipleEdges gr a b)])
-> (NoMultipleEdges gr a b -> [(Node, gr a b)])
-> NoMultipleEdges gr a b
-> [(Node, NoMultipleEdges gr a b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. gr a b -> [(Node, gr a b)]
forall (ag :: * -> * -> *) a b.
ArbGraph ag =>
ag a b -> [(Node, ag a b)]
shrinkFWith (gr a b -> [(Node, gr a b)])
-> (NoMultipleEdges gr a b -> gr a b)
-> NoMultipleEdges gr a b
-> [(Node, gr a b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NoMultipleEdges gr a b -> gr a b
forall (gr :: * -> * -> *) a b. NoMultipleEdges gr a b -> gr a b
nmeGraph

instance (ArbGraph gr, Arbitrary a, Arbitrary b) => Arbitrary (NoMultipleEdges gr a b) where
  arbitrary :: Gen (NoMultipleEdges gr a b)
arbitrary = Gen (NoMultipleEdges gr a b)
forall (ag :: * -> * -> *) a b.
(ArbGraph ag, Arbitrary a, Arbitrary b) =>
Gen (ag a b)
arbitraryGraphBy

  shrink :: NoMultipleEdges gr a b -> [NoMultipleEdges gr a b]
shrink = NoMultipleEdges gr a b -> [NoMultipleEdges gr a b]
forall (ag :: * -> * -> *) a b. ArbGraph ag => ag a b -> [ag a b]
shrinkF

-- | A newtype wrapper to generate a graph without loops (multiple
--   edges allowed).
newtype NoLoops gr a b = NL { NoLoops gr a b -> gr a b
looplessGraph :: gr a b }
                         deriving (NoLoops gr a b -> NoLoops gr a b -> Bool
(NoLoops gr a b -> NoLoops gr a b -> Bool)
-> (NoLoops gr a b -> NoLoops gr a b -> Bool)
-> Eq (NoLoops gr a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (gr :: * -> * -> *) a b.
Eq (gr a b) =>
NoLoops gr a b -> NoLoops gr a b -> Bool
/= :: NoLoops gr a b -> NoLoops gr a b -> Bool
$c/= :: forall (gr :: * -> * -> *) a b.
Eq (gr a b) =>
NoLoops gr a b -> NoLoops gr a b -> Bool
== :: NoLoops gr a b -> NoLoops gr a b -> Bool
$c== :: forall (gr :: * -> * -> *) a b.
Eq (gr a b) =>
NoLoops gr a b -> NoLoops gr a b -> Bool
Eq, Node -> NoLoops gr a b -> ShowS
[NoLoops gr a b] -> ShowS
NoLoops gr a b -> String
(Node -> NoLoops gr a b -> ShowS)
-> (NoLoops gr a b -> String)
-> ([NoLoops gr a b] -> ShowS)
-> Show (NoLoops gr a b)
forall a.
(Node -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (gr :: * -> * -> *) a b.
Show (gr a b) =>
Node -> NoLoops gr a b -> ShowS
forall (gr :: * -> * -> *) a b.
Show (gr a b) =>
[NoLoops gr a b] -> ShowS
forall (gr :: * -> * -> *) a b.
Show (gr a b) =>
NoLoops gr a b -> String
showList :: [NoLoops gr a b] -> ShowS
$cshowList :: forall (gr :: * -> * -> *) a b.
Show (gr a b) =>
[NoLoops gr a b] -> ShowS
show :: NoLoops gr a b -> String
$cshow :: forall (gr :: * -> * -> *) a b.
Show (gr a b) =>
NoLoops gr a b -> String
showsPrec :: Node -> NoLoops gr a b -> ShowS
$cshowsPrec :: forall (gr :: * -> * -> *) a b.
Show (gr a b) =>
Node -> NoLoops gr a b -> ShowS
Show, ReadPrec [NoLoops gr a b]
ReadPrec (NoLoops gr a b)
Node -> ReadS (NoLoops gr a b)
ReadS [NoLoops gr a b]
(Node -> ReadS (NoLoops gr a b))
-> ReadS [NoLoops gr a b]
-> ReadPrec (NoLoops gr a b)
-> ReadPrec [NoLoops gr a b]
-> Read (NoLoops gr a b)
forall a.
(Node -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall (gr :: * -> * -> *) a b.
Read (gr a b) =>
ReadPrec [NoLoops gr a b]
forall (gr :: * -> * -> *) a b.
Read (gr a b) =>
ReadPrec (NoLoops gr a b)
forall (gr :: * -> * -> *) a b.
Read (gr a b) =>
Node -> ReadS (NoLoops gr a b)
forall (gr :: * -> * -> *) a b.
Read (gr a b) =>
ReadS [NoLoops gr a b]
readListPrec :: ReadPrec [NoLoops gr a b]
$creadListPrec :: forall (gr :: * -> * -> *) a b.
Read (gr a b) =>
ReadPrec [NoLoops gr a b]
readPrec :: ReadPrec (NoLoops gr a b)
$creadPrec :: forall (gr :: * -> * -> *) a b.
Read (gr a b) =>
ReadPrec (NoLoops gr a b)
readList :: ReadS [NoLoops gr a b]
$creadList :: forall (gr :: * -> * -> *) a b.
Read (gr a b) =>
ReadS [NoLoops gr a b]
readsPrec :: Node -> ReadS (NoLoops gr a b)
$creadsPrec :: forall (gr :: * -> * -> *) a b.
Read (gr a b) =>
Node -> ReadS (NoLoops gr a b)
Read)

instance (ArbGraph gr) => ArbGraph (NoLoops gr) where
  type BaseGraph (NoLoops gr) = BaseGraph gr

  toBaseGraph :: NoLoops gr a b -> BaseGraph (NoLoops gr) a b
toBaseGraph = gr a b -> BaseGraph gr a b
forall (ag :: * -> * -> *) a b.
ArbGraph ag =>
ag a b -> BaseGraph ag a b
toBaseGraph (gr a b -> BaseGraph gr a b)
-> (NoLoops gr a b -> gr a b) -> NoLoops gr a b -> BaseGraph gr a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NoLoops gr a b -> gr a b
forall (gr :: * -> * -> *) a b. NoLoops gr a b -> gr a b
looplessGraph
  fromBaseGraph :: BaseGraph (NoLoops gr) a b -> NoLoops gr a b
fromBaseGraph = gr a b -> NoLoops gr a b
forall (gr :: * -> * -> *) a b. gr a b -> NoLoops gr a b
NL (gr a b -> NoLoops gr a b)
-> (BaseGraph gr a b -> gr a b)
-> BaseGraph gr a b
-> NoLoops gr a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BaseGraph gr a b -> gr a b
forall (ag :: * -> * -> *) a b.
ArbGraph ag =>
BaseGraph ag a b -> ag a b
fromBaseGraph

  edgeF :: GrProxy (NoLoops gr) -> [LEdge b] -> [LEdge b]
edgeF _ = (LEdge b -> Bool) -> [LEdge b] -> [LEdge b]
forall a. (a -> Bool) -> [a] -> [a]
filter LEdge b -> Bool
forall b. LEdge b -> Bool
notLoop ([LEdge b] -> [LEdge b])
-> ([LEdge b] -> [LEdge b]) -> [LEdge b] -> [LEdge b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GrProxy gr -> [LEdge b] -> [LEdge b]
forall (ag :: * -> * -> *) b.
ArbGraph ag =>
GrProxy ag -> [LEdge b] -> [LEdge b]
edgeF (GrProxy gr
forall (gr :: * -> * -> *). GrProxy gr
GrProxy :: GrProxy gr)

  shrinkFWith :: NoLoops gr a b -> [(Node, NoLoops gr a b)]
shrinkFWith = ((Node, gr a b) -> (Node, NoLoops gr a b))
-> [(Node, gr a b)] -> [(Node, NoLoops gr a b)]
forall a b. (a -> b) -> [a] -> [b]
map ((gr a b -> NoLoops gr a b)
-> (Node, gr a b) -> (Node, NoLoops gr a b)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second gr a b -> NoLoops gr a b
forall (gr :: * -> * -> *) a b. gr a b -> NoLoops gr a b
NL) ([(Node, gr a b)] -> [(Node, NoLoops gr a b)])
-> (NoLoops gr a b -> [(Node, gr a b)])
-> NoLoops gr a b
-> [(Node, NoLoops gr a b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. gr a b -> [(Node, gr a b)]
forall (ag :: * -> * -> *) a b.
ArbGraph ag =>
ag a b -> [(Node, ag a b)]
shrinkFWith (gr a b -> [(Node, gr a b)])
-> (NoLoops gr a b -> gr a b) -> NoLoops gr a b -> [(Node, gr a b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NoLoops gr a b -> gr a b
forall (gr :: * -> * -> *) a b. NoLoops gr a b -> gr a b
looplessGraph

notLoop :: LEdge b -> Bool
notLoop :: LEdge b -> Bool
notLoop (v :: Node
v,w :: Node
w,_) = Node
v Node -> Node -> Bool
forall a. Eq a => a -> a -> Bool
/= Node
w

instance (ArbGraph gr, Arbitrary a, Arbitrary b) => Arbitrary (NoLoops gr a b) where
  arbitrary :: Gen (NoLoops gr a b)
arbitrary = Gen (NoLoops gr a b)
forall (ag :: * -> * -> *) a b.
(ArbGraph ag, Arbitrary a, Arbitrary b) =>
Gen (ag a b)
arbitraryGraphBy

  shrink :: NoLoops gr a b -> [NoLoops gr a b]
shrink = NoLoops gr a b -> [NoLoops gr a b]
forall (ag :: * -> * -> *) a b. ArbGraph ag => ag a b -> [ag a b]
shrinkF

-- | A wrapper to generate a graph without multiple edges and
--   no loops.
type SimpleGraph gr = NoLoops (NoMultipleEdges gr)

-- | A newtype wrapper such that each (non-loop) edge also has its
--   reverse in the graph.
--
--   Note that there is no way to guarantee this after any additional
--   edges are added or removed.
--
--  You should also apply this wrapper /after/ 'NoMultipleEdges' or
--  else the wrong reverse edge might be removed.
newtype Undirected gr a b = UG { Undirected gr a b -> gr a b
undirGraph :: gr a b }
                            deriving (Undirected gr a b -> Undirected gr a b -> Bool
(Undirected gr a b -> Undirected gr a b -> Bool)
-> (Undirected gr a b -> Undirected gr a b -> Bool)
-> Eq (Undirected gr a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (gr :: * -> * -> *) a b.
Eq (gr a b) =>
Undirected gr a b -> Undirected gr a b -> Bool
/= :: Undirected gr a b -> Undirected gr a b -> Bool
$c/= :: forall (gr :: * -> * -> *) a b.
Eq (gr a b) =>
Undirected gr a b -> Undirected gr a b -> Bool
== :: Undirected gr a b -> Undirected gr a b -> Bool
$c== :: forall (gr :: * -> * -> *) a b.
Eq (gr a b) =>
Undirected gr a b -> Undirected gr a b -> Bool
Eq, Node -> Undirected gr a b -> ShowS
[Undirected gr a b] -> ShowS
Undirected gr a b -> String
(Node -> Undirected gr a b -> ShowS)
-> (Undirected gr a b -> String)
-> ([Undirected gr a b] -> ShowS)
-> Show (Undirected gr a b)
forall a.
(Node -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (gr :: * -> * -> *) a b.
Show (gr a b) =>
Node -> Undirected gr a b -> ShowS
forall (gr :: * -> * -> *) a b.
Show (gr a b) =>
[Undirected gr a b] -> ShowS
forall (gr :: * -> * -> *) a b.
Show (gr a b) =>
Undirected gr a b -> String
showList :: [Undirected gr a b] -> ShowS
$cshowList :: forall (gr :: * -> * -> *) a b.
Show (gr a b) =>
[Undirected gr a b] -> ShowS
show :: Undirected gr a b -> String
$cshow :: forall (gr :: * -> * -> *) a b.
Show (gr a b) =>
Undirected gr a b -> String
showsPrec :: Node -> Undirected gr a b -> ShowS
$cshowsPrec :: forall (gr :: * -> * -> *) a b.
Show (gr a b) =>
Node -> Undirected gr a b -> ShowS
Show, ReadPrec [Undirected gr a b]
ReadPrec (Undirected gr a b)
Node -> ReadS (Undirected gr a b)
ReadS [Undirected gr a b]
(Node -> ReadS (Undirected gr a b))
-> ReadS [Undirected gr a b]
-> ReadPrec (Undirected gr a b)
-> ReadPrec [Undirected gr a b]
-> Read (Undirected gr a b)
forall a.
(Node -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall (gr :: * -> * -> *) a b.
Read (gr a b) =>
ReadPrec [Undirected gr a b]
forall (gr :: * -> * -> *) a b.
Read (gr a b) =>
ReadPrec (Undirected gr a b)
forall (gr :: * -> * -> *) a b.
Read (gr a b) =>
Node -> ReadS (Undirected gr a b)
forall (gr :: * -> * -> *) a b.
Read (gr a b) =>
ReadS [Undirected gr a b]
readListPrec :: ReadPrec [Undirected gr a b]
$creadListPrec :: forall (gr :: * -> * -> *) a b.
Read (gr a b) =>
ReadPrec [Undirected gr a b]
readPrec :: ReadPrec (Undirected gr a b)
$creadPrec :: forall (gr :: * -> * -> *) a b.
Read (gr a b) =>
ReadPrec (Undirected gr a b)
readList :: ReadS [Undirected gr a b]
$creadList :: forall (gr :: * -> * -> *) a b.
Read (gr a b) =>
ReadS [Undirected gr a b]
readsPrec :: Node -> ReadS (Undirected gr a b)
$creadsPrec :: forall (gr :: * -> * -> *) a b.
Read (gr a b) =>
Node -> ReadS (Undirected gr a b)
Read)

instance (ArbGraph gr) => ArbGraph (Undirected gr) where
  type BaseGraph (Undirected gr) = BaseGraph gr

  toBaseGraph :: Undirected gr a b -> BaseGraph (Undirected gr) a b
toBaseGraph = gr a b -> BaseGraph gr a b
forall (ag :: * -> * -> *) a b.
ArbGraph ag =>
ag a b -> BaseGraph ag a b
toBaseGraph (gr a b -> BaseGraph gr a b)
-> (Undirected gr a b -> gr a b)
-> Undirected gr a b
-> BaseGraph gr a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Undirected gr a b -> gr a b
forall (gr :: * -> * -> *) a b. Undirected gr a b -> gr a b
undirGraph
  fromBaseGraph :: BaseGraph (Undirected gr) a b -> Undirected gr a b
fromBaseGraph = gr a b -> Undirected gr a b
forall (gr :: * -> * -> *) a b. gr a b -> Undirected gr a b
UG (gr a b -> Undirected gr a b)
-> (BaseGraph gr a b -> gr a b)
-> BaseGraph gr a b
-> Undirected gr a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BaseGraph gr a b -> gr a b
forall (ag :: * -> * -> *) a b.
ArbGraph ag =>
BaseGraph ag a b -> ag a b
fromBaseGraph

  edgeF :: GrProxy (Undirected gr) -> [LEdge b] -> [LEdge b]
edgeF _ = [LEdge b] -> [LEdge b]
forall b. [LEdge b] -> [LEdge b]
undirect ([LEdge b] -> [LEdge b])
-> ([LEdge b] -> [LEdge b]) -> [LEdge b] -> [LEdge b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GrProxy gr -> [LEdge b] -> [LEdge b]
forall (ag :: * -> * -> *) b.
ArbGraph ag =>
GrProxy ag -> [LEdge b] -> [LEdge b]
edgeF (GrProxy gr
forall (gr :: * -> * -> *). GrProxy gr
GrProxy :: GrProxy gr)

  shrinkFWith :: Undirected gr a b -> [(Node, Undirected gr a b)]
shrinkFWith = ((Node, gr a b) -> (Node, Undirected gr a b))
-> [(Node, gr a b)] -> [(Node, Undirected gr a b)]
forall a b. (a -> b) -> [a] -> [b]
map ((gr a b -> Undirected gr a b)
-> (Node, gr a b) -> (Node, Undirected gr a b)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second gr a b -> Undirected gr a b
forall (gr :: * -> * -> *) a b. gr a b -> Undirected gr a b
UG) ([(Node, gr a b)] -> [(Node, Undirected gr a b)])
-> (Undirected gr a b -> [(Node, gr a b)])
-> Undirected gr a b
-> [(Node, Undirected gr a b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. gr a b -> [(Node, gr a b)]
forall (ag :: * -> * -> *) a b.
ArbGraph ag =>
ag a b -> [(Node, ag a b)]
shrinkFWith (gr a b -> [(Node, gr a b)])
-> (Undirected gr a b -> gr a b)
-> Undirected gr a b
-> [(Node, gr a b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Undirected gr a b -> gr a b
forall (gr :: * -> * -> *) a b. Undirected gr a b -> gr a b
undirGraph

undirect :: [LEdge b] -> [LEdge b]
undirect :: [LEdge b] -> [LEdge b]
undirect = (LEdge b -> [LEdge b]) -> [LEdge b] -> [LEdge b]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap LEdge b -> [LEdge b]
forall b. (Node, Node, b) -> [(Node, Node, b)]
undir
  where
    undir :: (Node, Node, b) -> [(Node, Node, b)]
undir le :: (Node, Node, b)
le@(v :: Node
v,w :: Node
w,b :: b
b)
      | (Node, Node, b) -> Bool
forall b. LEdge b -> Bool
notLoop (Node, Node, b)
le = [(Node, Node, b)
le, (Node
w,Node
v,b
b)]
      | Bool
otherwise  = [(Node, Node, b)
le]

instance (ArbGraph gr, Arbitrary a, Arbitrary b) => Arbitrary (Undirected gr a b) where
  arbitrary :: Gen (Undirected gr a b)
arbitrary = Gen (Undirected gr a b)
forall (ag :: * -> * -> *) a b.
(ArbGraph ag, Arbitrary a, Arbitrary b) =>
Gen (ag a b)
arbitraryGraphBy

  shrink :: Undirected gr a b -> [Undirected gr a b]
shrink = Undirected gr a b -> [Undirected gr a b]
forall (ag :: * -> * -> *) a b. ArbGraph ag => ag a b -> [ag a b]
shrinkF

-- -----------------------------------------------------------------------------

-- | A brute-force approach to generating connected graphs.
--
--   The resultant graph (obtained with 'connGraph') will /never/ be
--   empty: it will, at the very least, contain an additional
--   connected node (obtained with 'connNode').
--
--   Note that this is /not/ an instance of 'ArbGraph' as it is not
--   possible to arbitrarily layer a transformer on top of this.
data Connected ag a b = CG { Connected ag a b -> Node
connNode     :: Node
                           , Connected ag a b -> ag a b
connArbGraph :: ag a b
                           }
                        deriving (Connected ag a b -> Connected ag a b -> Bool
(Connected ag a b -> Connected ag a b -> Bool)
-> (Connected ag a b -> Connected ag a b -> Bool)
-> Eq (Connected ag a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (ag :: * -> * -> *) a b.
Eq (ag a b) =>
Connected ag a b -> Connected ag a b -> Bool
/= :: Connected ag a b -> Connected ag a b -> Bool
$c/= :: forall (ag :: * -> * -> *) a b.
Eq (ag a b) =>
Connected ag a b -> Connected ag a b -> Bool
== :: Connected ag a b -> Connected ag a b -> Bool
$c== :: forall (ag :: * -> * -> *) a b.
Eq (ag a b) =>
Connected ag a b -> Connected ag a b -> Bool
Eq, Node -> Connected ag a b -> ShowS
[Connected ag a b] -> ShowS
Connected ag a b -> String
(Node -> Connected ag a b -> ShowS)
-> (Connected ag a b -> String)
-> ([Connected ag a b] -> ShowS)
-> Show (Connected ag a b)
forall a.
(Node -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (ag :: * -> * -> *) a b.
Show (ag a b) =>
Node -> Connected ag a b -> ShowS
forall (ag :: * -> * -> *) a b.
Show (ag a b) =>
[Connected ag a b] -> ShowS
forall (ag :: * -> * -> *) a b.
Show (ag a b) =>
Connected ag a b -> String
showList :: [Connected ag a b] -> ShowS
$cshowList :: forall (ag :: * -> * -> *) a b.
Show (ag a b) =>
[Connected ag a b] -> ShowS
show :: Connected ag a b -> String
$cshow :: forall (ag :: * -> * -> *) a b.
Show (ag a b) =>
Connected ag a b -> String
showsPrec :: Node -> Connected ag a b -> ShowS
$cshowsPrec :: forall (ag :: * -> * -> *) a b.
Show (ag a b) =>
Node -> Connected ag a b -> ShowS
Show, ReadPrec [Connected ag a b]
ReadPrec (Connected ag a b)
Node -> ReadS (Connected ag a b)
ReadS [Connected ag a b]
(Node -> ReadS (Connected ag a b))
-> ReadS [Connected ag a b]
-> ReadPrec (Connected ag a b)
-> ReadPrec [Connected ag a b]
-> Read (Connected ag a b)
forall a.
(Node -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall (ag :: * -> * -> *) a b.
Read (ag a b) =>
ReadPrec [Connected ag a b]
forall (ag :: * -> * -> *) a b.
Read (ag a b) =>
ReadPrec (Connected ag a b)
forall (ag :: * -> * -> *) a b.
Read (ag a b) =>
Node -> ReadS (Connected ag a b)
forall (ag :: * -> * -> *) a b.
Read (ag a b) =>
ReadS [Connected ag a b]
readListPrec :: ReadPrec [Connected ag a b]
$creadListPrec :: forall (ag :: * -> * -> *) a b.
Read (ag a b) =>
ReadPrec [Connected ag a b]
readPrec :: ReadPrec (Connected ag a b)
$creadPrec :: forall (ag :: * -> * -> *) a b.
Read (ag a b) =>
ReadPrec (Connected ag a b)
readList :: ReadS [Connected ag a b]
$creadList :: forall (ag :: * -> * -> *) a b.
Read (ag a b) =>
ReadS [Connected ag a b]
readsPrec :: Node -> ReadS (Connected ag a b)
$creadsPrec :: forall (ag :: * -> * -> *) a b.
Read (ag a b) =>
Node -> ReadS (Connected ag a b)
Read)

instance (ArbGraph ag, Arbitrary a, Arbitrary b) => Arbitrary (Connected ag a b) where
  arbitrary :: Gen (Connected ag a b)
arbitrary = Gen (ag a b)
forall (ag :: * -> * -> *) a b.
(ArbGraph ag, Arbitrary a, Arbitrary b) =>
Gen (ag a b)
arbitraryGraphBy Gen (ag a b)
-> (ag a b -> Gen (Connected ag a b)) -> Gen (Connected ag a b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ag a b -> Gen (Connected ag a b)
forall (ag :: * -> * -> *) a b.
(ArbGraph ag, Arbitrary a, Arbitrary b) =>
ag a b -> Gen (Connected ag a b)
toConnGraph

  shrink :: Connected ag a b -> [Connected ag a b]
shrink = Connected ag a b -> [Connected ag a b]
forall (ag :: * -> * -> *) a b.
ArbGraph ag =>
Connected ag a b -> [Connected ag a b]
shrinkConnGraph

toConnGraph :: forall ag a b. (ArbGraph ag, Arbitrary a, Arbitrary b)
               => ag a b -> Gen (Connected ag a b)
toConnGraph :: ag a b -> Gen (Connected ag a b)
toConnGraph ag :: ag a b
ag = do a
a <- Gen a
forall a. Arbitrary a => Gen a
arbitrary
                    [LEdge b]
ces <- [[LEdge b]] -> [LEdge b]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[LEdge b]] -> [LEdge b]) -> Gen [[LEdge b]] -> Gen [LEdge b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Node -> Gen [LEdge b]) -> [Node] -> Gen [[LEdge b]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Node -> Gen [LEdge b]
mkE [Node]
ws
                    Connected ag a b -> Gen (Connected ag a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Connected ag a b -> Gen (Connected ag a b))
-> Connected ag a b -> Gen (Connected ag a b)
forall a b. (a -> b) -> a -> b
$ CG :: forall (ag :: * -> * -> *) a b. Node -> ag a b -> Connected ag a b
CG { connNode :: Node
connNode     = Node
v
                                , connArbGraph :: ag a b
connArbGraph = BaseGraph ag a b -> ag a b
forall (ag :: * -> * -> *) a b.
ArbGraph ag =>
BaseGraph ag a b -> ag a b
fromBaseGraph
                                                 (BaseGraph ag a b -> ag a b)
-> (BaseGraph ag a b -> BaseGraph ag a b)
-> BaseGraph ag a b
-> ag a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LEdge b] -> BaseGraph ag a b -> BaseGraph ag a b
forall (gr :: * -> * -> *) b a.
DynGraph gr =>
[LEdge b] -> gr a b -> gr a b
insEdges [LEdge b]
ces
                                                 (BaseGraph ag a b -> BaseGraph ag a b)
-> (BaseGraph ag a b -> BaseGraph ag a b)
-> BaseGraph ag a b
-> BaseGraph ag a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LNode a -> BaseGraph ag a b -> BaseGraph ag a b
forall (gr :: * -> * -> *) a b.
DynGraph gr =>
LNode a -> gr a b -> gr a b
insNode (Node
v,a
a)
                                                 (BaseGraph ag a b -> ag a b) -> BaseGraph ag a b -> ag a b
forall a b. (a -> b) -> a -> b
$ BaseGraph ag a b
g
                                }
  where
    g :: BaseGraph ag a b
g = ag a b -> BaseGraph ag a b
forall (ag :: * -> * -> *) a b.
ArbGraph ag =>
ag a b -> BaseGraph ag a b
toBaseGraph ag a b
ag

    [v :: Node
v] = Node -> BaseGraph ag a b -> [Node]
forall (gr :: * -> * -> *) a b.
Graph gr =>
Node -> gr a b -> [Node]
newNodes 1 BaseGraph ag a b
g

    ws :: [Node]
ws = BaseGraph ag a b -> [Node]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [Node]
nodes BaseGraph ag a b
g

    mkE :: Node -> Gen [LEdge b]
mkE w :: Node
w = do b
b <- Gen b
forall a. Arbitrary a => Gen a
arbitrary
               [LEdge b] -> Gen [LEdge b]
forall (m :: * -> *) a. Monad m => a -> m a
return (GrProxy ag -> [LEdge b] -> [LEdge b]
forall (ag :: * -> * -> *) b.
ArbGraph ag =>
GrProxy ag -> [LEdge b] -> [LEdge b]
edgeF GrProxy ag
p [(Node
v,Node
w,b
b)])

    p :: GrProxy ag
    p :: GrProxy ag
p = GrProxy ag
forall (gr :: * -> * -> *). GrProxy gr
GrProxy

shrinkConnGraph :: (ArbGraph ag) => Connected ag a b -> [Connected ag a b]
shrinkConnGraph :: Connected ag a b -> [Connected ag a b]
shrinkConnGraph cg :: Connected ag a b
cg = ((Node, ag a b) -> Maybe (Connected ag a b))
-> [(Node, ag a b)] -> [Connected ag a b]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Node, ag a b) -> Maybe (Connected ag a b)
keepConn ([(Node, ag a b)] -> [Connected ag a b])
-> (ag a b -> [(Node, ag a b)]) -> ag a b -> [Connected ag a b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ag a b -> [(Node, ag a b)]
forall (ag :: * -> * -> *) a b.
ArbGraph ag =>
ag a b -> [(Node, ag a b)]
shrinkFWith (ag a b -> [Connected ag a b]) -> ag a b -> [Connected ag a b]
forall a b. (a -> b) -> a -> b
$ ag a b
g
  where
    v :: Node
v = Connected ag a b -> Node
forall (ag :: * -> * -> *) a b. Connected ag a b -> Node
connNode Connected ag a b
cg
    g :: ag a b
g = Connected ag a b -> ag a b
forall (ag :: * -> * -> *) a b. Connected ag a b -> ag a b
connArbGraph Connected ag a b
cg

    keepConn :: (Node, ag a b) -> Maybe (Connected ag a b)
keepConn (w :: Node
w,sgs :: ag a b
sgs) | Node
v Node -> Node -> Bool
forall a. Eq a => a -> a -> Bool
== Node
w    = Maybe (Connected ag a b)
forall a. Maybe a
Nothing
                     | Bool
otherwise = Connected ag a b -> Maybe (Connected ag a b)
forall a. a -> Maybe a
Just (Connected ag a b
cg { connArbGraph :: ag a b
connArbGraph = ag a b
sgs })

-- | The underlying graph represented by this 'Connected' value.
connGraph :: (ArbGraph ag) => Connected ag a b -> BaseGraph ag a b
connGraph :: Connected ag a b -> BaseGraph ag a b
connGraph = ag a b -> BaseGraph ag a b
forall (ag :: * -> * -> *) a b.
ArbGraph ag =>
ag a b -> BaseGraph ag a b
toBaseGraph (ag a b -> BaseGraph ag a b)
-> (Connected ag a b -> ag a b)
-> Connected ag a b
-> BaseGraph ag a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connected ag a b -> ag a b
forall (ag :: * -> * -> *) a b. Connected ag a b -> ag a b
connArbGraph

-- -----------------------------------------------------------------------------