style hamming code widget

hamming.cabal

@@ -41,6 +41,7 @@ library
     , microlens >=0.4.13.1 && <0.5
     , microlens-th >=0.4.3.15 && <0.5
     , mtl >=2.3.1 && <2.4
+    , vty ==6.1.*
   default-language: Haskell2010
 
 executable hamming
@@ -59,6 +60,7 @@ executable hamming
     , microlens >=0.4.13.1 && <0.5
     , microlens-th >=0.4.3.15 && <0.5
     , mtl >=2.3.1 && <2.4
+    , vty ==6.1.*
   default-language: Haskell2010
 
 test-suite hamming-test
@@ -84,4 +86,5 @@ test-suite hamming-test
     , microlens >=0.4.13.1 && <0.5
     , microlens-th >=0.4.3.15 && <0.5
     , mtl >=2.3.1 && <2.4
+    , vty ==6.1.*
   default-language: Haskell2010

package.yaml

@@ -24,6 +24,7 @@ dependencies:
 - microlens >= 0.4.13.1 && < 0.5
 - microlens-th >= 0.4.3.15 && < 0.5
 - mtl >= 2.3.1 && < 2.4
+- vty >= 6.1 && < 6.2
 
 ghc-options:
 - -Wall

src/Hamming/App.hs

@@ -26,13 +26,16 @@ License along with this program.  If not, see
 
 module Hamming.App (mainApp, initialState) where
 
-import Brick.AttrMap (forceAttrMap)
+import Brick.AttrMap (attrMap)
 import Brick.Main (App (..), neverShowCursor)
-import Brick.Util (style)
+import Brick.Util (fg, style)
+import Graphics.Vty.Attributes (bold)
+import Graphics.Vty.Attributes.Color (green, red)
 
 import Hamming.App.Draw
 import Hamming.App.Events
 import Hamming.App.Types
+import Hamming.App.Widgets
 
 mainApp :: App AppState () ResName
 mainApp = App
@@ -40,7 +43,11 @@ mainApp = App
   , appChooseCursor = neverShowCursor
   , appHandleEvent  = eventHandler
   , appStartEvent   = return ()
-  , appAttrMap      = const $ forceAttrMap $ style 0
+  , appAttrMap      = const $ attrMap (style 0)
+    [ ( marginAttr, fg green    )
+    , ( checkAttr,  style bold )
+    , ( zeroAttr,   fg red     )
+    ]
   }
 
 --jl

src/Hamming/App/Widgets.hs

@@ -29,12 +29,11 @@ module Hamming.App.Widgets (
   hammingW,
   -- ** Attribute Names
   hammingAttr,
-  hammingMarginAttr,
+  marginAttr,
-  hammingCheckAttr,
+  checkAttr,
-  hammingZeroAttr,
+  zeroAttr,
   ) where
 
-import Brick.AttrMap (AttrName, attrName)
 import Brick.Types (Widget)
 import Brick.Widgets.Core (hBox, str, vBox, withAttr)
 
@@ -45,21 +44,9 @@ import Hamming.App.Widgets.Internal
 hammingW
   :: AppState
   -> Widget ResName
-hammingW = withAttr (attrName "hamming")
+hammingW = withAttr hammingAttr
   . vBox
   . map (hBox . map (\(a, w) -> withAttr a $ str [w]))
   . hammingW'
 
-hammingAttr :: AttrName
-hammingAttr = attrName "hamming"
-
-hammingMarginAttr :: AttrName
-hammingMarginAttr = hammingAttr <> marginAttr
-
-hammingCheckAttr :: AttrName
-hammingCheckAttr = hammingAttr <> checkAttr
-
-hammingZeroAttr :: AttrName
-hammingZeroAttr = hammingAttr <> zeroAttr
-
 --jl

src/Hamming/App/Widgets/Internal.hs

@@ -33,6 +33,7 @@ module Hamming.App.Widgets.Internal (
   -- * Hamming Code Widget
   hammingW',
   -- ** Attribute Names
+  hammingAttr,
   marginAttr,
   checkAttr,
   zeroAttr,
@@ -54,11 +55,14 @@ hammingW' state = let
     ['0'..'3']
     body
 
+hammingAttr :: AttrName
+hammingAttr = attrName "hamming"
+
 marginAttr :: AttrName
-marginAttr = attrName "margin"
+marginAttr = hammingAttr <> attrName "margin"
 
 checkAttr :: AttrName
-checkAttr = attrName "check"
+checkAttr = hammingAttr <> attrName "check"
 
 zeroAttr :: AttrName
 zeroAttr = checkAttr <> attrName "zero"