git.iko.soy/vty
on master help sign in
Merge pull request #225 from hapytex/improvement/maybedefault-semigroup

A simpler version of the Semigroup instance for MaybeDefault

commitfe501ccf2716826bf6ea05a666bbcfab36631ca6 authorJonathan Daugherty <cygnus@foobox.com> dateFri 11 Jun 2021, 05:45 (5 years ago) parentfa74b0ab1d5762
3 files changed+59−9
compare with master
unifiedsplit
src/Graphics/Vty/Attributes.hs+3−9 test/VerifyAttributes.hs+30 vty.cabal+26
src/Graphics/Vty/Attributes.hs+3−9
@@ -152,15 +152,9 @@ instance (NFData v) => NFData (MaybeDefault v) where
152152 rnf (SetTo v) = rnf v
153153
154154instance Eq v => Semigroup (MaybeDefault v) where
155− Default <> Default = Default
156− Default <> KeepCurrent = Default
157− Default <> SetTo v = SetTo v
158− KeepCurrent <> Default = Default
159− KeepCurrent <> KeepCurrent = KeepCurrent
160− KeepCurrent <> SetTo v = SetTo v
161− SetTo _v <> Default = Default
162− SetTo v <> KeepCurrent = SetTo v
163− SetTo _ <> SetTo v = SetTo v
155+ _ <> v@(SetTo _) = v
156+ x <> KeepCurrent = x
157+ _ <> Default = Default
164158
165159instance Eq v => Monoid ( MaybeDefault v ) where
166160 mempty = KeepCurrent
test/VerifyAttributes.hsnew file+30
@@ -0,0 +1,30 @@
1+module VerifyAttributes where
2+
3+import Verify
4+
5+import Data.Semigroup((<>))
6+
7+import Graphics.Vty.Attributes(MaybeDefault(Default, KeepCurrent, SetTo))
8+
9+instance Arbitrary a => Arbitrary (MaybeDefault a) where
10+ arbitrary = oneof [pure Default, pure KeepCurrent, SetTo <$> arbitrary]
11+
12+oldSem :: MaybeDefault a -> MaybeDefault a -> MaybeDefault a
13+oldSem Default Default = Default
14+oldSem Default KeepCurrent = Default
15+oldSem Default (SetTo v) = SetTo v
16+oldSem KeepCurrent Default = Default
17+oldSem KeepCurrent KeepCurrent = KeepCurrent
18+oldSem KeepCurrent (SetTo v) = SetTo v
19+oldSem (SetTo _v) Default = Default
20+oldSem (SetTo v) KeepCurrent = SetTo v
21+oldSem (SetTo _) (SetTo v) = SetTo v
22+
23+sameSemigroupValue :: MaybeDefault Int -> MaybeDefault Int -> Bool
24+sameSemigroupValue xa xb = xa <> xb == oldSem xa xb
25+
26+tests :: IO [Test]
27+tests = return
28+ [ verify "check that the new Semigroup of MaybeDefault is equivalent to the old one" sameSemigroupValue
29+ ]
30+
vty.cabal+26
@@ -554,6 +554,32 @@ test-suite verify-color-mapping
554554 utf8-string >= 0.3 && < 1.1,
555555 vector >= 0.7
556556
557+test-suite verify-semigroup-maybedefault
558+ default-language: Haskell2010
559+ default-extensions: ScopedTypeVariables
560+
561+ type: detailed-0.9
562+
563+ hs-source-dirs: test
564+
565+ test-module: VerifyAttributes
566+
567+ other-modules: Verify
568+
569+ build-depends: vty,
570+ Cabal >= 1.20,
571+ QuickCheck >= 2.7,
572+ random >= 1.0 && < 1.3,
573+ base >= 4.8 && < 5,
574+ bytestring,
575+ containers,
576+ deepseq >= 1.1 && < 1.5,
577+ mtl >= 1.1.1.0 && < 2.3,
578+ text >= 0.11.3,
579+ unix,
580+ utf8-string >= 0.3 && < 1.1,
581+ vector >= 0.7
582+
557583
558584test-suite verify-utf8-width
559585 default-language: Haskell2010