content: {-# OPTIONS_GHC -fno-warn-orphans #-}
  {-# OPTIONS_HADDOCK hide #-}
  
  {- |
     Module      : Data.GraphViz.Testing.Instances.Common()
     Description : Attribute instances for Arbitrary.
     Copyright   : (c) Ivan Lazar Miljenovic
     License     : 3-Clause BSD-style
     Maintainer  : Ivan.Miljenovic@gmail.com
   -}
  module Data.GraphViz.Testing.Instances.Common
         ( gaGraph
         , gaSubGraph
         , gaClusters
         ) where
  
  import Data.GraphViz.Testing.Instances.Attributes
  import Data.GraphViz.Testing.Instances.Helpers
  
  import Data.GraphViz.Algorithms            (CanonicaliseOptions (..))
  import Data.GraphViz.Attributes            (Attributes)
  import Data.GraphViz.Types.Internal.Common (DotEdge (..), DotNode (..),
                                              GlobalAttributes (..), GraphID (..))
  
  import Test.QuickCheck
  
  import Control.Monad (liftM, liftM2, liftM3)
  
  -- -----------------------------------------------------------------------------
  -- Common values
  
  instance Arbitrary GraphID where
    arbitrary = oneof [ liftM Str arbitrary
                      , liftM Num arbitrary
                      ]
  
    shrink (Str s) = map Str $ shrink s
    shrink (Num n) = map Num $ shrink n
  
  instance (Arbitrary n) => Arbitrary (DotNode n) where
    arbitrary = liftM2 DotNode arbitrary arbNodeAttrs
  
    shrink (DotNode n as) = map (DotNode n) $ shrink as
  
  instance (Arbitrary n) => Arbitrary (DotEdge n) where
    arbitrary = liftM3 DotEdge arbitrary arbitrary arbEdgeAttrs
  
    shrink (DotEdge f t as) = map (DotEdge f t) $ shrink as
  
  instance Arbitrary GlobalAttributes where
    arbitrary = gaGraph
  
    shrink (GraphAttrs atts) = map GraphAttrs $ nonEmptyShrinks atts
    shrink (NodeAttrs  atts) = map NodeAttrs  $ nonEmptyShrinks atts
    shrink (EdgeAttrs  atts) = map EdgeAttrs  $ nonEmptyShrinks atts
  
  gaGraph :: Gen GlobalAttributes
  gaGraph = gaFor arbGraphAttrs
  
  gaSubGraph :: Gen GlobalAttributes
  gaSubGraph = gaFor arbSubGraphAttrs
  
  gaClusters :: Gen GlobalAttributes
  gaClusters = gaFor arbClusterAttrs
  
  gaFor   :: Gen Attributes -> Gen GlobalAttributes
  gaFor g = oneof [ liftM GraphAttrs g
                  , liftM NodeAttrs  arbNodeAttrs
                  , liftM EdgeAttrs  arbEdgeAttrs
                  ]
  
  instance Arbitrary CanonicaliseOptions where
    arbitrary = liftM2 COpts arbitrary arbitrary
  