Remove Monoid and Semigroup instances for Attr and MaybeDefault (relevant to brick/#351)

This change removes the aforementioned instances because they were
misbehaved; merging Attr and MaybeDefault values with these instances
resulted in field value losses. For example, before this change,

  (defAttr `withForeColor` blue) <> (defAttr `withBackColor` green)

would result in just

  (defAttr `withBackColor` green)

because the instances were designed to favor the right-hand arguments'
fields even if they had not been explicitly set (a consequence of the
MaybeDefault Semigroup instance). While that behavior was sensible
specifically in the context of Graphics.Vty.Inline, it wasn't a useful
user-facing API and it made for surprising instance behavior. Since
there is actually no good way to handle this in a Semigroup instance for
Attr -- some choices have to be made about how to merge two attributes'
foreground colors, and that won't be much better than what we had -- the
instance was just removed. I suspect that the risk of this impacting
users negatively is very low, given that the instance behavior was not
very useful.

src/Graphics/Vty/Attributes.hs

@@ -61,9 +61,6 @@ where
 
 import Control.DeepSeq
 import Data.Bits
-#if !(MIN_VERSION_base(4,11,0))
-import Data.Semigroup
-#endif
 import Data.Text (Text)
 import Data.Word
 import GHC.Generics
@@ -116,19 +113,6 @@ data Attr = Attr
 --  Then the foreground color encoded into 8 bits.
 --  Then the background color encoded into 8 bits.
 
-instance Semigroup Attr where
-    attr0 <> attr1 =
-        Attr ( attrStyle attr0     <> attrStyle attr1 )
-             ( attrForeColor attr0 <> attrForeColor attr1 )
-             ( attrBackColor attr0 <> attrBackColor attr1 )
-             ( attrURL attr0       <> attrURL attr1 )
-
-instance Monoid Attr where
-    mempty = Attr mempty mempty mempty mempty
-#if !(MIN_VERSION_base(4,11,0))
-    mappend = (<>)
-#endif
-
 -- | Specifies the display attributes such that the final style and
 -- color values do not depend on the previously applied display
 -- attribute. The display attributes can still depend on the terminal's
@@ -151,17 +135,6 @@ instance (NFData v) => NFData (MaybeDefault v) where
     rnf KeepCurrent = ()
     rnf (SetTo v) = rnf v
 
-instance Semigroup (MaybeDefault v) where
-    _        <> v@(SetTo _) = v
-    x        <> KeepCurrent = x
-    _        <> Default     = Default
-
-instance Monoid ( MaybeDefault v ) where
-    mempty = KeepCurrent
-#if !(MIN_VERSION_base(4,11,0))
-    mappend = (<>)
-#endif
-
 -- | Styles are represented as an 8 bit word. Each bit in the word is 1
 -- if the style attribute assigned to that bit should be applied and 0
 -- if the style attribute should not be applied.

src/Graphics/Vty/Inline.hs

@@ -56,13 +56,13 @@ data InlineState =
 -- | Set the background color to the provided 'Color'.
 backColor :: Color -> InlineM ()
 backColor c = modify $ \s ->
-    s { inlineAttr = inlineAttr s `mappend` (currentAttr `withBackColor` c)
+    s { inlineAttr = inlineAttr s `withBackColor` c
       }
 
 -- | Set the foreground color to the provided 'Color'.
 foreColor :: Color -> InlineM ()
 foreColor c = modify $ \s ->
-    s { inlineAttr = inlineAttr s `mappend` (currentAttr `withForeColor` c)
+    s { inlineAttr = inlineAttr s `withForeColor` c
       }
 
 -- | Attempt to change the 'Style' of the following text..
@@ -71,7 +71,7 @@ foreColor c = modify $ \s ->
 -- produced. The style can still be removed.
 applyStyle :: Style -> InlineM ()
 applyStyle st = modify $ \s ->
-    s { inlineAttr = inlineAttr s `mappend` (currentAttr `withStyle` st)
+    s { inlineAttr = inlineAttr s `withStyle` st
       }
 
 -- | Attempt to remove the specified 'Style' from the display of the

test/VerifyAttributes.hs

@@ -1,30 +0,0 @@
-module VerifyAttributes where
-
-import Verify
-
-import Data.Semigroup((<>))
-
-import Graphics.Vty.Attributes(MaybeDefault(Default, KeepCurrent, SetTo))
-
-instance Arbitrary a => Arbitrary (MaybeDefault a) where
-  arbitrary = oneof [pure Default, pure KeepCurrent, SetTo <$> arbitrary]
-
-oldSem :: MaybeDefault a -> MaybeDefault a -> MaybeDefault a
-oldSem Default Default = Default
-oldSem Default KeepCurrent = Default
-oldSem Default (SetTo v) = SetTo v
-oldSem KeepCurrent Default = Default
-oldSem KeepCurrent KeepCurrent = KeepCurrent
-oldSem KeepCurrent (SetTo v) = SetTo v
-oldSem (SetTo _v) Default = Default
-oldSem (SetTo v) KeepCurrent = SetTo v
-oldSem (SetTo _) (SetTo v) = SetTo v
-
-sameSemigroupValue :: MaybeDefault Int -> MaybeDefault Int -> Bool
-sameSemigroupValue xa xb = xa <> xb == oldSem xa xb
-
-tests :: IO [Test]
-tests = return
-  [ verify "check that the new Semigroup of MaybeDefault is equivalent to the old one" sameSemigroupValue
-  ]
-

vty.cabal

@@ -554,33 +554,6 @@ test-suite verify-color-mapping
                        utf8-string >= 0.3 && < 1.1,
                        vector >= 0.7
 
-test-suite verify-semigroup-maybedefault
-  default-language:    Haskell2010
-  default-extensions:  ScopedTypeVariables
-
-  type:                detailed-0.9
-
-  hs-source-dirs:      test
-
-  test-module:         VerifyAttributes
-
-  other-modules:       Verify
-
-  build-depends:       vty,
-                       Cabal >= 1.20,
-                       QuickCheck >= 2.7,
-                       random >= 1.0 && < 1.3,
-                       base >= 4.8 && < 5,
-                       bytestring,
-                       containers,
-                       deepseq >= 1.1 && < 1.5,
-                       mtl >= 1.1.1.0 && < 2.3,
-                       text >= 0.11.3,
-                       unix,
-                       utf8-string >= 0.3 && < 1.1,
-                       vector >= 0.7
-
-
 test-suite verify-utf8-width
   default-language:    Haskell2010
   default-extensions:  ScopedTypeVariables