Satisfy NO_COLOR requirements as per https://no-color.org

I replicated the same style as settings' and logger' found here—is that close to acceptable?

list

tui

app/ghcup/BrickMain.hs

@@ -44,6 +44,7 @@ import           Data.Vector                    ( Vector
 import           Data.Versions           hiding ( str )
 import           Haskus.Utils.Variant.Excepts
 import           Prelude                 hiding ( appendFile )
+import           System.Environment
 import           System.Exit
 import           System.IO.Unsafe
 import           URI.ByteString
@@ -250,19 +251,35 @@ app = App { appDraw         = \st -> [ui st]
 defaultAttributes :: AttrMap
 defaultAttributes = attrMap
   Vty.defAttr
-  [ ("active"       , Vty.defAttr `Vty.withBackColor` Vty.blue)
-  , ("not-installed", Vty.defAttr `Vty.withForeColor` Vty.red)
-  , ("set"          , Vty.defAttr `Vty.withForeColor` Vty.green)
-  , ("installed"    , Vty.defAttr `Vty.withForeColor` Vty.green)
-  , ("recommended"  , Vty.defAttr `Vty.withForeColor` Vty.green)
-  , ("hls-powered"  , Vty.defAttr `Vty.withForeColor` Vty.green)
-  , ("latest"       , Vty.defAttr `Vty.withForeColor` Vty.yellow)
-  , ("prerelease"   , Vty.defAttr `Vty.withForeColor` Vty.red)
-  , ("compiled"     , Vty.defAttr `Vty.withForeColor` Vty.blue)
-  , ("stray"        , Vty.defAttr `Vty.withForeColor` Vty.blue)
+  [ ("active"       , Vty.defAttr `withBackColor` Vty.blue)
+  , ("not-installed", Vty.defAttr `withForeColor` Vty.red)
+  , ("set"          , Vty.defAttr `withForeColor` Vty.green)
+  , ("installed"    , Vty.defAttr `withForeColor` Vty.green)
+  , ("recommended"  , Vty.defAttr `withForeColor` Vty.green)
+  , ("hls-powered"  , Vty.defAttr `withForeColor` Vty.green)
+  , ("latest"       , Vty.defAttr `withForeColor` Vty.yellow)
+  , ("prerelease"   , Vty.defAttr `withForeColor` Vty.red)
+  , ("compiled"     , Vty.defAttr `withForeColor` Vty.blue)
+  , ("stray"        , Vty.defAttr `withForeColor` Vty.blue)
   , ("help"         , Vty.defAttr `Vty.withStyle` Vty.italic)
-  , ("hooray"       , Vty.defAttr `Vty.withForeColor` Vty.brightWhite)
+  , ("hooray"       , Vty.defAttr `withForeColor` Vty.brightWhite)
   ]
+  where
+    withForeColor :: Vty.Attr -> Vty.Color -> Vty.Attr
+    {-# NOINLINE withForeColor #-}
+    withForeColor = unsafePerformIO $ do
+      x <- lookupEnv "NO_COLOR"
+      pure $ case x of
+        Nothing -> Vty.withForeColor
+        Just _  -> const
+
+    withBackColor :: Vty.Attr -> Vty.Color -> Vty.Attr
+    {-# NOINLINE withBackColor #-}
+    withBackColor = unsafePerformIO $ do
+      x <- lookupEnv "NO_COLOR"
+      pure $ case x of
+        Nothing -> Vty.withBackColor
+        Just _  -> \attr _ -> attr `Vty.withStyle` Vty.reverseVideo
 
 
 dimAttributes :: AttrMap

[Julian Ospald]

I think there should be a more idiomatic way without unsafePerformIO. I'm not even sure if this triggers sharing properly despite NOINLINE. We can adjust app:

app :: App BrickState e String
app = App { appDraw         = \st -> [ui st]
          , appHandleEvent  = eventHandler
          , appStartEvent   = return
          , appAttrMap      = const defaultAttributes
          , appChooseCursor = neverShowCursor
          }

to be

app :: AttrMap -> App BrickState e String
...

And then do the env lookup in brickMain: https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/app/ghcup/BrickMain.hs#L527