# LANGUAGE FlexibleContexts , MultiParamTypeClasses #

  | 
    Module       : Data . GraphViz . Testing . Properties 
    Description : Properties for testing . 
    Copyright    : ( c )    
    License      : 3 - Clause BSD - style 
    Maintainer   :  

    Various properties that should hold true for the graphviz library . 

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

   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.Testing.Proxy     (DGProxy(..))
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 '  ' 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 (DGProxy :: DGProxy G.DotGraph) dg

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

  | This property verifies that '  ' , 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 '  ' ) 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, 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)
                           => DGProxy dg -> g nl el -> Bool
prop_findAllNodes dgp g = ((==) `on` sort) gns dgns
  where
    gns = nodes g
    dg = canonicalToType dgp $ 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)
                            => DGProxy dg -> g nl el -> Bool
prop_findAllNodesE dgp g = ((==) `on` sort) gns dgns
  where
    gns = nodes g
    dg = canonicalToType dgp . 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, Graph g) => DGProxy dg -> g nl el -> Bool
prop_findAllEdges dgp g = ((==) `on` sort) ges dges
  where
    ges = edges g
    dg = canonicalToType dgp $ 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)
                          => DGProxy dg -> g nl el -> Bool
prop_noGraphInfo dgp g = info == (GraphAttrs [], Map.empty)
  where
    dg = canonicalToType dgp
         $ 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 '  ' 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) => DGProxy dg -> DotGraph n -> dg n
canonicalToType _ = fromCanonical

 -----------------------------------------------------------------------------
 The properties to test for
   its own output.
 | 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).
   This should work for all 'PrintDot' instances, but is more
   original graph; that is, the actual nodes, edges and labels for
   each remain unchanged.  Whilst 'dotize', etc. only require
   'Attributes' augmentations.
 | After augmentation, each node and edge should have a non-empty
 | list of 'Attributes'.
 | 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).
 Needs to have at least /one/ Attribute!
   finds all the nodes.
   removed.
   finds all the nodes.
 | There should be no clusters or global attributes when converting
   or clustering.
 | Canonicalisation should be idempotent.
 | Canonicalisation shouldn't change any nodes.
 | Canonicalisation shouldn't change any edges.
 | Removing transitive edges should be idempotent.
 | Transitive reduction shouldn't change any nodes.
 -----------------------------------------------------------------------------
 Helper utility functions
 | A utility function to use for debugging purposes for trying to
   using @'parseIt' . 'printIt'@ directly, since it avoids having to
   enter and explicit type signature.
   entire 'String' *is* fully consumed.
 | A wrapper around 'fromCanonical' that lets you specify up-front
   what type to create (it need not be a sensible value).
# LANGUAGE FlexibleContexts , MultiParamTypeClasses #

  | 
    Module       : Data . GraphViz . Testing . Properties 
    Description : Properties for testing . 
    Copyright    : ( c )    
    License      : 3 - Clause BSD - style 
    Maintainer   :  

    Various properties that should hold true for the graphviz library . 

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

   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.Testing.Proxy     (DGProxy(..))
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)


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

prop_printParseListID    :: (ParseDot a, PrintDot a, Eq a) => [a] -> Property
prop_printParseListID as =  not (null as) ==> prop_printParseID as

  | When converting a canonical '  ' 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 (DGProxy :: DGProxy G.DotGraph) dg

  | Pre - processing should n't change the output of printed Dot code .
    specific to '  ' values .
prop_preProcessingID    :: (PrintDotRepr dg n) => dg n -> Bool
prop_preProcessingID dg = preProcess dotCode == dotCode
  where
    dotCode = printDotGraph dg

  | This property verifies that '  ' , etc . only /augment/ the
    ' Graph ' instances , this property requires ' DynGraph ' ( which is a
    sub - class of '  ' ) instances to be able to strip off the
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

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'

prop_dotizeAugmentUniq   :: (DynGraph g, 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 ls = ls == nub ls

  | Ensure that the definition of ' nodeInformation ' for a DotRepr
prop_findAllNodes       :: (DotRepr dg Int, Ord el, Graph g)
                           => DGProxy dg -> g nl el -> Bool
prop_findAllNodes dgp g = ((==) `on` sort) gns dgns
  where
    gns = nodes g
    dg = canonicalToType dgp $ 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
prop_findAllNodesE       :: (DotRepr dg Int, Ord el, Graph g)
                            => DGProxy dg -> g nl el -> Bool
prop_findAllNodesE dgp g = ((==) `on` sort) gns dgns
  where
    gns = nodes g
    dg = canonicalToType dgp . 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
prop_findAllEdges       :: (DotRepr dg Int, Graph g) => DGProxy dg -> g nl el -> Bool
prop_findAllEdges dgp g = ((==) `on` sort) ges dges
  where
    ges = edges g
    dg = canonicalToType dgp $ graphToDot nonClusteredParams g
    dges = map (fromNode &&& toNode) $ graphEdges dg

    a ' Graph ' to a DotRepr ( via fromCanonical ) without any formatting
prop_noGraphInfo       :: (DotRepr dg Int, Ord el, Graph g)
                          => DGProxy dg -> g nl el -> Bool
prop_noGraphInfo dgp g = info == (GraphAttrs [], Map.empty)
  where
    dg = canonicalToType dgp
         $ setDirectedness graphToDot nonClusteredParams g
    info = graphStructureInformation dg

prop_canonicalise :: (DotRepr dg n) => CanonicaliseOptions -> dg n -> Bool
prop_canonicalise copts g = cdg == canonicaliseOptions copts cdg
  where
    cdg = canonicaliseOptions copts g

prop_canonicaliseNodes :: (DotRepr dg n) => CanonicaliseOptions -> dg n -> Bool
prop_canonicaliseNodes copts g = nodeInformationClean True g
                                 == nodeInformationClean True cdg
  where
    cdg = canonicaliseOptions copts g

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

prop_transitive :: (DotRepr dg n) => CanonicaliseOptions -> dg n -> Bool
prop_transitive copts g = tdg == transitiveReductionOptions copts tdg
  where
    tdg = transitiveReductionOptions copts g

prop_transitiveNodes :: (DotRepr dg n) => CanonicaliseOptions -> dg n -> Bool
prop_transitiveNodes copts g = nodeInformationClean True g
                               == nodeInformationClean True cdg
  where
    cdg = transitiveReductionOptions copts g


    find how graphviz /is/ parsing something .   This is easier than
tryParse :: (ParseDot a, PrintDot a) => a -> (a, Text)
tryParse = parseIt . printIt

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

canonicalToType   :: (DotRepr dg n) => DGProxy dg -> DotGraph n -> dg n
canonicalToType _ = fromCanonical
