{-# 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