From 6e67bedd1682e9c7a13f9cc11e19cc6b2e830505 Mon Sep 17 00:00:00 2001
From: Steve Baker <scsavtnk@gmail.com>
Date: Wed, 7 Apr 2021 15:34:41 +0200
Subject: [PATCH] Fix colors on Windows (#749)

Calling the `hSupportsANSIWithoutEmulation` function on Windows 10+
enables terminal colors where supported.
https://hackage.haskell.org/package/ansi-terminal-0.11/docs/System-Console-ANSI.html#v:hSupportsANSIWithoutEmulation

Also has the added benefit that (on Windows), the ANSI codes aren't
present when output is redirected to a text file.
---
 CHANGELOG.md        | 1 +
 spago.cabal         | 3 ++-
 src/Spago/RunEnv.hs | 8 ++++++--
 3 files changed, 9 insertions(+), 3 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 89574ee62..668af24f8 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -14,6 +14,7 @@ Breaking changes (😱!!!):
 
 Bugfixes:
 - Properly call `psa` to avoid warnings (#730)
+- Color output now works on Windows (#749)
 
 Other improvements:
 - `spago build` now detects and warns about unused dependencies (#730, #598)
diff --git a/spago.cabal b/spago.cabal
index b6b593254..58998d653 100644
--- a/spago.cabal
+++ b/spago.cabal
@@ -139,7 +139,8 @@ executable spago
   default-extensions: ApplicativeDo BangPatterns BinaryLiterals ConstraintKinds DataKinds DefaultSignatures DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable DerivingStrategies DoAndIfThenElse DuplicateRecordFields EmptyDataDecls ExistentialQuantification FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase LiberalTypeSynonyms MonadFailDesugaring MultiParamTypeClasses MultiWayIf NamedFieldPuns NoImplicitPrelude NoMonomorphismRestriction OverloadedStrings PartialTypeSignatures PatternGuards PolyKinds QuantifiedConstraints RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TupleSections TypeApplications TypeFamilies TypeSynonymInstances UndecidableInstances ViewPatterns
   ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wredundant-constraints -fprint-potential-instances -optP-Wno-nonportable-include-path
   build-depends:
-      base >=4.7 && <5
+      ansi-terminal
+    , base >=4.7 && <5
     , spago
     , text <1.3
     , turtle
diff --git a/src/Spago/RunEnv.hs b/src/Spago/RunEnv.hs
index 27f1d09ce..81bacda90 100644
--- a/src/Spago/RunEnv.hs
+++ b/src/Spago/RunEnv.hs
@@ -3,6 +3,7 @@ module Spago.RunEnv where
 import Spago.Prelude
 import Spago.Env
 
+import           System.Console.ANSI (hSupportsANSIWithoutEmulation)
 import qualified System.Environment  as Env
 import qualified Distribution.System as OS
 import qualified RIO
@@ -20,14 +21,17 @@ import qualified Spago.Purs as Purs
 --   and runs the app
 withEnv :: GlobalOptions -> RIO Env a -> IO a
 withEnv GlobalOptions{..} app = do
+  let logHandle = stderr
   let verbose = not globalQuiet && (globalVerbose || globalVeryVerbose)
 
   -- https://github.com/purescript/spago/issues/579
   maybeTerm <- Env.lookupEnv "TERM"
   let termDumb = maybeTerm == Just "dumb" || maybeTerm == Just "win"
-  let useColor = globalUseColor && not termDumb
+  supportsAnsi <- hSupportsANSIWithoutEmulation logHandle
+  let useColor = case supportsAnsi of
+        Just True -> globalUseColor && not termDumb
+        _ -> False
 
-  let logHandle = stderr
   logOptions' <- logOptionsHandle logHandle verbose
   let logOptions
         = setLogUseTime globalVeryVerbose