fgl-arbitrary-0.1.0.0: test/TestSuite.hs

{- |
   Module      : TestSuite
   Description : fgl-arbitrary test suite
   Copyright   : Ivan Lazar Miljenovic
   License     : BSD3
   Maintainer  : Ivan.Miljenovic@gmail.com



 -}
module Main where

import Data.Graph.Inductive.Arbitrary
import Data.Graph.Inductive.Graph
import Data.Graph.Inductive.PatriciaTree

import Test.Hspec
import Test.Hspec.QuickCheck
import Test.QuickCheck

import qualified Data.Set  as S
import           Data.Word (Word8)

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

main :: IO ()
main = hspec $ do
  propShrink "nodes and edges" prop_gnes
  propShrink "connectivity"    is_connected

-- Also ensure the shrink implementations are valid.
propShrink :: (Arbitrary a, Show a) => String -> (a -> Bool) -> Spec
propShrink nm f = prop nm f'
  where
    f' a = all f (a : shrink a)

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

prop_gnes :: GraphNodesEdges NLabel ELabel -> Bool
prop_gnes (GNEs lns les) = uniqueNs && validEs
  where
    uniqueNs = length ns == S.size nsS
    validEs = all (`S.member` nsS) ens

    ns = map fst lns
    nsS = S.fromList ns

    ens = concatMap (\(v,w,_) -> [v,w]) les

is_connected :: Connected Gr NLabel ELabel -> Bool
is_connected cg
  | isEmpty g = True
  | otherwise = go S.empty (S.singleton . node' . fst . matchAny $ g)
  where
    g = connGraph cg
    ns = S.fromList (nodes g)

    go vis cnd
      | S.null cnd = vis == ns
      | otherwise  = go vis'
                     . S.unions
                     . map ((`S.difference`vis') . S.fromList . neighbors g)
                     . S.toList
                     $ cnd
      where
        vis' = vis `S.union` cnd

-- -----------------------------------------------------------------------------
-- Rather than defining proxies for this test-suite, just pre-define
-- the node and edge label types.

type NLabel = Char
type ELabel = Word8