Properties.hs

{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses #-}

{- |
   Module      : Data.GraphViz.Testing.Properties
   Description : Properties for testing.
   Copyright   : (c) Ivan Lazar Miljenovic
   License     : 3-Clause BSD-style
   Maintainer  : Ivan.Miljenovic@gmail.com

   Various properties that should hold true for the graphviz library.
-}
module Data.GraphViz.Testing.Properties where

import           Data.GraphViz                   (dotizeGraph, graphToDot,
                                                  nonClusteredParams,
                                                  setDirectedness)
import           Data.GraphViz.Algorithms
import           Data.GraphViz.Internal.Util     (groupSortBy, isSingle)
import           Data.GraphViz.Parsing           (ParseDot (..), parseIt,
                                                  parseIt')
import           Data.GraphViz.PreProcessing     (preProcess)
import           Data.GraphViz.Printing          (PrintDot (..), printIt)
import           Data.GraphViz.Types             (DotEdge (..), DotNode (..),
                                                  DotRepr (..),
                                                  GlobalAttributes (..),
                                                  PrintDotRepr,
                                                  edgeInformationClean,
                                                  graphEdges, graphNodes,
                                                  nodeInformationClean,
                                                  printDotGraph)
import           Data.GraphViz.Types.Canonical   (DotGraph (..),
                                                  DotStatements (..))
import qualified Data.GraphViz.Types.Generalised as G

import Test.QuickCheck

import           Control.Arrow        ((&&&))
import           Data.Function        (on)
import           Data.Graph.Inductive (DynGraph, Graph, edges, emap, equal,
                                       labEdges, labNodes, nmap, nodes)
import           Data.List            (nub, sort)
import qualified Data.Map             as Map
import qualified Data.Set             as Set
import           Data.Text.Lazy       (Text)

-- -----------------------------------------------------------------------------
-- The properties to test for

-- | Checking that @parse . print == id@; that is, graphviz can parse
--   its own output.
prop_printParseID   :: (ParseDot a, PrintDot a, Eq a) => a -> Bool
prop_printParseID a = tryParse' a == a

-- | A version of 'prop_printParse' specifically for lists; it ensures
--   that the list is not empty (as most list-based parsers fail on
--   empty lists).
prop_printParseListID    :: (ParseDot a, PrintDot a, Eq a) => [a] -> Property
prop_printParseListID as =  not (null as) ==> prop_printParseID as

-- | When converting a canonical 'DotGraph' value to any other one,
--   they should generate the same Dot code.
prop_generalisedSameDot    :: (Ord n, PrintDot n, ParseDot n) => DotGraph n -> Bool
prop_generalisedSameDot dg = printDotGraph dg == printDotGraph gdg
  where
    gdg = canonicalToType (undefined :: G.DotGraph n) dg

-- | Pre-processing shouldn't change the output of printed Dot code.
--   This should work for all 'PrintDot' instances, but is more
--   specific to 'DotGraph' values.
prop_preProcessingID    :: (PrintDotRepr dg n) => dg n -> Bool
prop_preProcessingID dg = preProcess dotCode == dotCode
  where
    dotCode = printDotGraph dg

-- | This property verifies that 'dotizeGraph', etc. only /augment/ the
--   original graph; that is, the actual nodes, edges and labels for
--   each remain unchanged.  Whilst 'dotize', etc. only require
--   'Graph' instances, this property requires 'DynGraph' (which is a
--   sub-class of 'Graph') instances to be able to strip off the
--   'Attributes' augmentations.
prop_dotizeAugment   :: (DynGraph g, Eq n, Ord e) => g n e -> Bool
prop_dotizeAugment g = equal g (unAugment g')
  where
    g' = setDirectedness dotizeGraph nonClusteredParams g
    unAugment = nmap snd . emap snd

-- | After augmentation, each node and edge should have a non-empty
-- | list of 'Attributes'.
prop_dotizeHasAugment   :: (DynGraph g, Ord e) => g n e -> Bool
prop_dotizeHasAugment g = all (not . null) nodeAugments
                          && all (not . null) edgeAugments
  where
    g' = setDirectedness dotizeGraph nonClusteredParams g
    nodeAugments = map (fst . snd) $ labNodes g'
    edgeAugments = map (fst . \(_,_,l) -> l) $ labEdges g'

-- | When a graph with multiple edges is augmented, then all edges
--   should have unique 'Attributes' (namely the positions).  Note
--   that this may not hold true with custom supplied 'Attributes'
--   (i.e. not using one of the @dotize@ functions).
prop_dotizeAugmentUniq   :: (DynGraph g, Eq n, Ord e) => g n e -> Bool
prop_dotizeAugmentUniq g = all uniqLs lss
  where
    g' = setDirectedness dotizeGraph nonClusteredParams g
    les = map (\(f,t,l) -> ((f,t),l)) $ labEdges g'
    lss = map (map snd) . filter (not . isSingle)
          $ groupSortBy fst les
    uniqLs [] = False -- Needs to have at least /one/ Attribute!
    uniqLs ls = ls == nub ls

-- | Ensure that the definition of 'nodeInformation' for a DotRepr
--   finds all the nodes.
prop_findAllNodes       :: (DotRepr dg Int, Ord el, Graph g)
                           => dg Int -> g nl el -> Bool
prop_findAllNodes dg' g = ((==) `on` sort) gns dgns
  where
    gns = nodes g
    dg = canonicalToType dg' $ setDirectedness graphToDot nonClusteredParams g
    dgns = map nodeID $ graphNodes dg

-- | Ensure that the definition of 'nodeInformation' for DotReprs
--   finds all the nodes when the explicit 'DotNode' definitions are
--   removed.
prop_findAllNodesE       :: (DotRepr dg Int, Ord el, Graph g)
                            => dg Int -> g nl el -> Bool
prop_findAllNodesE dg' g = ((==) `on` sort) gns dgns
  where
    gns = nodes g
    dg = canonicalToType dg' . removeNodes $ setDirectedness graphToDot nonClusteredParams g
    dgns = map nodeID $ graphNodes dg
    removeNodes dot@DotGraph{graphStatements = stmts}
      = dot { graphStatements
               = stmts {nodeStmts = filter notInEdge $ nodeStmts stmts}
            }
    gnes = Set.fromList . concatMap (\(f,t) -> [f,t]) $ edges g
    notInEdge dn = nodeID dn `Set.notMember` gnes

-- | Ensure that the definition of 'edgeInformation' for DotReprs
--   finds all the nodes.
prop_findAllEdges       :: (DotRepr dg Int, Ord el, Graph g) => dg Int -> g nl el -> Bool
prop_findAllEdges dg' g = ((==) `on` sort) ges dges
  where
    ges = edges g
    dg = canonicalToType dg' $ graphToDot nonClusteredParams g
    dges = map (fromNode &&& toNode) $ graphEdges dg

-- | There should be no clusters or global attributes when converting
--   a 'Graph' to a DotRepr (via fromCanonical) without any formatting
--   or clustering.
prop_noGraphInfo       :: (DotRepr dg Int, Ord el, Graph g)
                          => dg Int -> g nl el -> Bool
prop_noGraphInfo dg' g = info == (GraphAttrs [], Map.empty)
  where
    dg = canonicalToType dg'
         $ setDirectedness graphToDot nonClusteredParams g
    info = graphStructureInformation dg

-- | Canonicalisation should be idempotent.
prop_canonicalise :: (DotRepr dg n) => CanonicaliseOptions -> dg n -> Bool
prop_canonicalise copts g = cdg == canonicaliseOptions copts cdg
  where
    cdg = canonicaliseOptions copts g

-- | Canonicalisation shouldn't change any nodes.
prop_canonicaliseNodes :: (DotRepr dg n) => CanonicaliseOptions -> dg n -> Bool
prop_canonicaliseNodes copts g = nodeInformationClean True g
                                 == nodeInformationClean True cdg
  where
    cdg = canonicaliseOptions copts g

-- | Canonicalisation shouldn't change any edges.
prop_canonicaliseEdges :: (DotRepr dg n) => CanonicaliseOptions -> dg n -> Bool
prop_canonicaliseEdges copts g = sort (edgeInformationClean True g)
                                 == sort (edgeInformationClean True cdg)
  where
    cdg = canonicaliseOptions copts g

-- | Removing transitive edges should be idempotent.
prop_transitive :: (DotRepr dg n) => CanonicaliseOptions -> dg n -> Bool
prop_transitive copts g = tdg == transitiveReductionOptions copts tdg
  where
    tdg = transitiveReductionOptions copts g

-- | Transitive reduction shouldn't change any nodes.
prop_transitiveNodes :: (DotRepr dg n) => CanonicaliseOptions -> dg n -> Bool
prop_transitiveNodes copts g = nodeInformationClean True g
                               == nodeInformationClean True cdg
  where
    cdg = transitiveReductionOptions copts g

-- -----------------------------------------------------------------------------
-- Helper utility functions

-- | A utility function to use for debugging purposes for trying to
--   find how graphviz /is/ parsing something.  This is easier than
--   using @'parseIt' . 'printIt'@ directly, since it avoids having to
--   enter and explicit type signature.
tryParse :: (ParseDot a, PrintDot a) => a -> (a, Text)
tryParse = parseIt . printIt

-- | Equivalent to 'tryParse' except that it is assumed that the
--   entire 'String' *is* fully consumed.
tryParse' :: (ParseDot a, PrintDot a) => a -> a
tryParse' = parseIt' . printIt

-- | A wrapper around 'fromCanonical' that lets you specify up-front
--   what type to create (it need not be a sensible value).
canonicalToType   :: (DotRepr dg n) => dg n -> DotGraph n -> dg n
canonicalToType _ = fromCanonical