    {-# OPTIONS_HADDOCK hide #-}

    {- |
       Module      : Data.GraphViz.Attributes.Same
       Description : Consider Attributes equal on constructors.
       Copyright   : (c) Ivan Lazar Miljenovic
       License     : 3-Clause BSD-style
       Maintainer  : Ivan.Miljenovic@gmail.com

       This module is used when @a1 == a2@ should return @True@ if they
       are the same Attribute, even if they don't have the same value
       (typically for 'Set's).
    -}
    module Data.GraphViz.Attributes.Same
           ( SameAttr
           , SAttrs
           , toSAttr
           , unSame
           , unSameSet
           ) where

    import Data.GraphViz.Attributes.Complete(Attribute, Attributes, sameAttribute)

    import Data.Function(on)
    import qualified Data.Set as Set
    import Data.Set(Set)

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

    -- | Defined as a wrapper around 'Attribute' where equality is based
    --   solely upon the constructor, not the contents.
    newtype SameAttr = SA { SameAttr -> Attribute
    getAttr :: Attribute }
                     deriving (Int -> SameAttr -> ShowS
    [SameAttr] -> ShowS
    SameAttr -> String
    (Int -> SameAttr -> ShowS)
    -> (SameAttr -> String) -> ([SameAttr] -> ShowS) -> Show SameAttr
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> SameAttr -> ShowS
    showsPrec :: Int -> SameAttr -> ShowS
    $cshow :: SameAttr -> String
    show :: SameAttr -> String
    $cshowList :: [SameAttr] -> ShowS
    showList :: [SameAttr] -> ShowS
    Show, ReadPrec [SameAttr]
    ReadPrec SameAttr
    Int -> ReadS SameAttr
    ReadS [SameAttr]
    (Int -> ReadS SameAttr)
    -> ReadS [SameAttr]
    -> ReadPrec SameAttr
    -> ReadPrec [SameAttr]
    -> Read SameAttr
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: Int -> ReadS SameAttr
    readsPrec :: Int -> ReadS SameAttr
    $creadList :: ReadS [SameAttr]
    readList :: ReadS [SameAttr]
    $creadPrec :: ReadPrec SameAttr
    readPrec :: ReadPrec SameAttr
    $creadListPrec :: ReadPrec [SameAttr]
    readListPrec :: ReadPrec [SameAttr]
    Read)

    instance Eq SameAttr where
      == :: SameAttr -> SameAttr -> Bool
    (==) = Attribute -> Attribute -> Bool
    sameAttribute (Attribute -> Attribute -> Bool)
    -> (SameAttr -> Attribute) -> SameAttr -> SameAttr -> Bool
    forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
    `on` SameAttr -> Attribute
    getAttr

    instance Ord SameAttr where
      compare :: SameAttr -> SameAttr -> Ordering
    compare SameAttr
    sa1 SameAttr
    sa2
        | SameAttr
    sa1 SameAttr -> SameAttr -> Bool
    forall a. Eq a => a -> a -> Bool
    == SameAttr
    sa2 = Ordering
    EQ
        | Bool
    otherwise  = (Attribute -> Attribute -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare (Attribute -> Attribute -> Ordering)
    -> (SameAttr -> Attribute) -> SameAttr -> SameAttr -> Ordering
    forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
    `on` SameAttr -> Attribute
    getAttr) SameAttr
    sa1 SameAttr
    sa2

    type SAttrs = Set SameAttr

    toSAttr :: Attributes -> SAttrs
    toSAttr :: Attributes -> SAttrs
    toSAttr = [SameAttr] -> SAttrs
    forall a. Ord a => [a] -> Set a
    Set.fromList ([SameAttr] -> SAttrs)
    -> (Attributes -> [SameAttr]) -> Attributes -> SAttrs
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Attribute -> SameAttr) -> Attributes -> [SameAttr]
    forall a b. (a -> b) -> [a] -> [b]
    map Attribute -> SameAttr
    SA

    unSame :: SAttrs -> Attributes
    unSame :: SAttrs -> Attributes
    unSame = (SameAttr -> Attribute) -> [SameAttr] -> Attributes
    forall a b. (a -> b) -> [a] -> [b]
    map SameAttr -> Attribute
    getAttr ([SameAttr] -> Attributes)
    -> (SAttrs -> [SameAttr]) -> SAttrs -> Attributes
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SAttrs -> [SameAttr]
    forall a. Set a -> [a]
    Set.toList

    unSameSet :: SAttrs -> Set Attribute
    unSameSet :: SAttrs -> Set Attribute
    unSameSet = (SameAttr -> Attribute) -> SAttrs -> Set Attribute
    forall a b. (a -> b) -> Set a -> Set b
    Set.mapMonotonic SameAttr -> Attribute
    getAttr