{-# 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SameAttr] -> ShowS
$cshowList :: [SameAttr] -> ShowS
show :: SameAttr -> String
$cshow :: SameAttr -> String
showsPrec :: Int -> SameAttr -> ShowS
$cshowsPrec :: Int -> SameAttr -> ShowS
Show, ReadPrec [SameAttr]
ReadPrec SameAttr
Int -> ReadS SameAttr
ReadS [SameAttr]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SameAttr]
$creadListPrec :: ReadPrec [SameAttr]
readPrec :: ReadPrec SameAttr
$creadPrec :: ReadPrec SameAttr
readList :: ReadS [SameAttr]
$creadList :: ReadS [SameAttr]
readsPrec :: Int -> ReadS SameAttr
$creadsPrec :: Int -> ReadS SameAttr
Read)

instance Eq SameAttr where
  == :: SameAttr -> SameAttr -> Bool
(==) = Attribute -> Attribute -> Bool
sameAttribute 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 forall a. Eq a => a -> a -> Bool
== SameAttr
sa2 = Ordering
EQ
    | Bool
otherwise  = (forall a. Ord a => a -> a -> Ordering
compare 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 = forall a. Ord a => [a] -> Set a
Set.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Attribute -> SameAttr
SA

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

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