[#26] Ability to disable and enable colouring (#38)

* [#26] Ability to disable and enable colouring

Resolves #26

* Fix build on old GHCs

* [#26] Move ColourMode to separate module, improve docs

Resolves #26

Author: chshersh

CHANGELOG.md

@@ -3,6 +3,19 @@
 `colourista` uses [PVP Versioning][1].
 The changelog is available [on GitHub][2].
 
+## 0.2.0.0
+
+* [#26](https://github.com/kowainik/colourista/issues/26):
+  Support enabling and disable of colouring with implicit parameters.
+
+  __Migration guide:__ You can continue using `colourista` without
+  changing anything and you still get colourful formatting.
+
+  However, if you want to enable or disable colouring, you need to add
+  the `HasColourMode =>` constraint to all functions that format data
+  or call such formatting functions, and set the value of the
+  `?colourMode` variable in the beginning of your application.
+
 ## 0.1.0.0 — May 2, 2020 🌈
 
 * [#22](https://github.com/kowainik/colourista/issues/22):

README.md

@@ -14,11 +14,16 @@
 >
 > — Coco Chanel
 
-`colourista` is the library that provides a convenient interface for printing
-colourful messages to the terminal. It is based on
-[`ansi-terminal`](https://hackage.haskell.org/package/ansi-terminal), however,
-in contradistinction to this Haskell library, `colourista` is a high-level
-wrapper focused on easily achieved output modification without low-level setup.
+`colourista` is the library that provides a simple and convenient
+interface for printing colourful messages to the
+terminal. Additionally, `colourista` allows to easily control enabling
+and disabling of colours.
+
+The library is based on
+[`ansi-terminal`](https://hackage.haskell.org/package/ansi-terminal),
+however, in contradistinction to this Haskell library, `colourista` is
+a high-level wrapper focused on easily achieved output modification
+without low-level setup.
 
 ## Interface
 
@@ -32,10 +37,17 @@ The two main functions that `colourista` provides are:
 The library also provides a set of different pure and impure helpers for the
 colouring and emphasis.
 
-## Example
+## Examples
+
+Simple output example:
 
 ![output](https://user-images.githubusercontent.com/8126674/74609327-0a5dbb00-50e1-11ea-8c4b-2db4ab5b42a2.png)
 
+Example of disabling colouring. The colour mode controlling is based on the
+[Implicit Parameters](https://downloads.haskell.org/ghc/latest/docs/html/users_guide/glasgow_exts.html#implicit-parameters) GHC feature.
+
+![Colour mode](https://user-images.githubusercontent.com/4276606/90915207-0c2d7180-e3d7-11ea-934c-ec840118ed73.png)
+
 ## How to use
 
 `colourista` is compatible with the latest GHC compiler versions starting from `8.2.2`.

colourista.cabal

@@ -1,8 +1,17 @@
 cabal-version:       2.4
 name:                colourista
-version:             0.1.0.0
-synopsis:            Convenient interface for printing colourful messages
-description:         Convenient interface for printing colourful messages based on the @ansi-terminal@ library.
+version:             0.2.0.0
+synopsis:            Simple and convenient interface for colourful outputting
+description:
+    Convenient interface for printing colourful messages based on the @ansi-terminal@ library.
+    Supports enabling and disabling of colouring based on
+    the [Implicit Parameters](https://downloads.haskell.org/ghc/latest/docs/html/users_guide/glasgow_exts.html#implicit-parameters)
+    GHC feature.
+    .
+    Usage and output example:
+    .
+    * ![Example](https://user-images.githubusercontent.com/4276606/90915207-0c2d7180-e3d7-11ea-934c-ec840118ed73.png)
+
 homepage:            https://github.com/kowainik/colourista
 bug-reports:         https://github.com/kowainik/colourista/issues
 license:             MPL-2.0
@@ -28,12 +37,14 @@ library
   hs-source-dirs:      src
   exposed-modules:     Colourista
                          Colourista.IO
+                         Colourista.Mode
                          Colourista.Pure
                          Colourista.Short
 
   build-depends:       base >= 4.10.1.0 && < 4.15
                      , ansi-terminal ^>= 0.10
                      , bytestring ^>= 0.10
+                     , ghc-prim >= 0.5 && < 0.7
                      , text ^>= 1.2.3.0
 
   ghc-options:         -Wall

src/Colourista.hs

@@ -14,9 +14,12 @@ module Colourista
          -- $pure
        , module Colourista.IO
          -- $io
+       , module Colourista.Mode
+         -- $mode
        ) where
 
 import Colourista.IO
+import Colourista.Mode
 import Colourista.Pure
 
 
@@ -29,3 +32,8 @@ customisation: colouring and emphasis.
 The set of functions that work in 'IO' to output formatted messages
 directly to terminal.
 -}
+
+{- $mode
+'ColourMode' data type that allows disabling and enabling colouring
+based on the implicit @?colourMode@ parameter in scope.
+-}

src/Colourista/IO.hs

@@ -37,6 +37,8 @@ import Data.Semigroup (Semigroup (..))
 #endif
 import Data.Text (Text)
 
+import Colourista.Mode (HasColourMode)
+
 import qualified Data.Text.IO as TIO
 
 import qualified Colourista.Pure as Colourista
@@ -46,42 +48,42 @@ import qualified Colourista.Pure as Colourista
 ----------------------------------------------------------------------------
 
 -- | Print 'Text' coloured in 'Colourista.red'.
-redMessage :: Text -> IO ()
+redMessage :: HasColourMode => Text -> IO ()
 redMessage = formattedMessage [Colourista.red]
 {-# INLINE redMessage #-}
 
 -- | Print 'Text' coloured in 'Colourista.green'.
-greenMessage :: Text -> IO ()
+greenMessage :: HasColourMode => Text -> IO ()
 greenMessage = formattedMessage [Colourista.green]
 {-# INLINE greenMessage #-}
 
 -- | Print 'Text' coloured in 'Colourista.blue'.
-blueMessage :: Text -> IO ()
+blueMessage :: HasColourMode => Text -> IO ()
 blueMessage = formattedMessage [Colourista.blue]
 {-# INLINE blueMessage #-}
 
 -- | Print 'Text' coloured in 'Colourista.yellow'.
-yellowMessage :: Text -> IO ()
+yellowMessage :: HasColourMode => Text -> IO ()
 yellowMessage = formattedMessage [Colourista.yellow]
 {-# INLINE yellowMessage #-}
 
 -- | Print 'Text' coloured in 'Colourista.black'.
-blackMessage :: Text -> IO ()
+blackMessage :: HasColourMode => Text -> IO ()
 blackMessage = formattedMessage [Colourista.black]
 {-# INLINE blackMessage #-}
 
 -- | Print 'Text' coloured in 'Colourista.white'.
-whiteMessage :: Text -> IO ()
+whiteMessage :: HasColourMode => Text -> IO ()
 whiteMessage = formattedMessage [Colourista.white]
 {-# INLINE whiteMessage #-}
 
 -- | Print 'Text' coloured in 'Colourista.magenta'.
-magentaMessage :: Text -> IO ()
+magentaMessage :: HasColourMode => Text -> IO ()
 magentaMessage = formattedMessage [Colourista.magenta]
 {-# INLINE magentaMessage #-}
 
 -- | Print 'Text' coloured in 'Colourista.cyan'.
-cyanMessage :: Text -> IO ()
+cyanMessage :: HasColourMode => Text -> IO ()
 cyanMessage = formattedMessage [Colourista.cyan]
 {-# INLINE cyanMessage #-}
 
@@ -93,39 +95,39 @@ cyanMessage = formattedMessage [Colourista.cyan]
 
 <<https://user-images.githubusercontent.com/4276606/80867598-dbd99000-8c8c-11ea-9fac-81a1a606d8d8.png Success message>>
 -}
-successMessage :: Text -> IO ()
+successMessage :: HasColourMode => Text -> IO ()
 successMessage t = greenMessage $ "  ✔ " <> t
 {-# INLINE successMessage #-}
 
 {- | Similar to 'blueMessage', but add unicode indicator.
 
 <<https://user-images.githubusercontent.com/4276606/80867597-db40f980-8c8c-11ea-9775-e8a3c4a7aaa2.png Information message>>
 -}
-infoMessage :: Text -> IO ()
+infoMessage :: HasColourMode => Text -> IO ()
 infoMessage t = blueMessage $ "  ⓘ " <> t
 {-# INLINE infoMessage #-}
 
 {- | Similar to 'cyanMessage', but add unicode indicator.
 
 <<https://user-images.githubusercontent.com/4276606/80867596-db40f980-8c8c-11ea-8131-9c7cba32a4fd.png Skip message>>
 -}
-skipMessage :: Text -> IO ()
+skipMessage :: HasColourMode => Text -> IO ()
 skipMessage t = cyanMessage $ "  ▶ " <> t
 {-# INLINE skipMessage #-}
 
 {- | Similar to 'yellowMessage', but add unicode indicator.
 
 <<https://user-images.githubusercontent.com/4276606/80867594-daa86300-8c8c-11ea-9c6a-a42b634a1e4b.png Warning message>>
 -}
-warningMessage :: Text -> IO ()
+warningMessage :: HasColourMode => Text -> IO ()
 warningMessage t = yellowMessage $ "  ⚠ " <> t
 {-# INLINE warningMessage #-}
 
 {- | Similar to 'redMessage', but add unicode indicator.
 
 <<https://user-images.githubusercontent.com/4276606/80867592-da0fcc80-8c8c-11ea-90e0-42aae8770c18.png Error message>>
 -}
-errorMessage :: Text -> IO ()
+errorMessage :: HasColourMode => Text -> IO ()
 errorMessage t = redMessage $ "  \128721 " <> t
 {-# INLINE errorMessage #-}
 
@@ -134,12 +136,12 @@ errorMessage t = redMessage $ "  \128721 " <> t
 ----------------------------------------------------------------------------
 
 -- | Print 'Text' emphasized with 'Colourista.bold'.
-boldMessage :: Text -> IO ()
+boldMessage :: HasColourMode => Text -> IO ()
 boldMessage = formattedMessage [Colourista.bold]
 {-# INLINE boldMessage #-}
 
 -- | Print 'Text' emphasized with 'Colourista.italic'.
-italicMessage :: Text -> IO ()
+italicMessage :: HasColourMode => Text -> IO ()
 italicMessage = formattedMessage [Colourista.italic]
 {-# INLINE italicMessage #-}
 
@@ -153,6 +155,6 @@ list, no formatting is applied.
 
 ![formattedMessage-example](https://user-images.githubusercontent.com/4276606/74608898-e6987600-50dc-11ea-9a93-bda701fd3c43.png)
 -}
-formattedMessage :: [Text] -> Text -> IO ()
+formattedMessage :: HasColourMode => [Text] -> Text -> IO ()
 formattedMessage formatting = TIO.putStrLn . Colourista.formatWith formatting
 {-# INLINE formattedMessage #-}

src/Colourista/Mode.hs

@@ -0,0 +1,108 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+{-# LANGUAGE DataKinds             #-}
+{-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE ImplicitParams        #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+
+{- |
+Copyright: (c) 2020 Kowainik
+SPDX-License-Identifier: MPL-2.0
+Maintainer: Kowainik <[email protected]>
+
+The 'ColourMode' data type that allows disabling and enabling of
+colouring. Implemented using the [Implicit Parameters](https://downloads.haskell.org/ghc/latest/docs/html/users_guide/glasgow_exts.html#implicit-parameters)
+GHC feature.
+
+By default, all formatting and printing functions in @colourista@
+print with colour. However, you control this behaviour by adding the
+@HasColourMode@ constraint to your functions and setting the value of
+the implicit @?colourMode@ variable.
+
+@since 0.2.0.0
+-}
+
+module Colourista.Mode
+    ( ColourMode (..)
+    , HasColourMode
+    , withColourMode
+    , handleColourMode
+    ) where
+
+import System.IO (Handle)
+import System.Console.ANSI (hSupportsANSIWithoutEmulation)
+import Data.String (IsString)
+
+import GHC.Classes (IP (..))
+
+
+{- | Data type that tells whether the colouring is enabled or
+disabled. It's used with the @-XImplicitParams@ GHC extension.
+
+@since 0.2.0.0
+-}
+data ColourMode
+    = DisableColour
+    | EnableColour
+    deriving stock (Show, Eq, Enum, Bounded)
+
+{- | Magic instance to set the value of the implicit variable
+@?colourMode@ to 'EnableColour' by default. Equivalent to the
+following code:
+
+@
+?colourMode = 'EnableColour'
+@
+
+However, you still can override @?colourMode@ with any possible value.
+
+@since 0.2.0.0
+-}
+instance IP "colourMode" ColourMode where
+    ip = EnableColour
+
+{- | Constraint that stores 'ColourMode' as an implicit parameter.
+
+@since 0.2.0.0
+-}
+type HasColourMode = (?colourMode :: ColourMode)
+
+{- | Helper function for writing custom formatter. The function takes
+'ColourMode' from the implicit parameter context and either returns a
+given string or an empty string.
+
+@since 0.2.0.0
+-}
+withColourMode :: (HasColourMode, IsString str) => str -> str
+withColourMode str = case ?colourMode of
+    EnableColour  -> str
+    DisableColour -> ""
+{-# INLINE withColourMode #-}
+
+{- | Returns 'ColourMode' of a 'Handle'. You can use this function on
+output 'Handle's to find out whether they support colouring or
+now. Use this function like this to check whether you can print with
+colour to terminal:
+
+@
+'handleColourMode' 'System.IO.stdout'
+@
+
+Typical usage can look like this:
+
+@
+main :: IO ()
+main = do
+    colourMode <- 'handleColourMode' 'System.IO.stdout'
+    let ?colourMode = fromMaybe 'DisableColour'
+    'Colourista.IO.successMessage' "Success!"
+@
+
+@since 0.2.0.0
+-}
+handleColourMode :: Handle -> IO (Maybe ColourMode)
+handleColourMode handle = do
+    supportsANSI <- hSupportsANSIWithoutEmulation handle
+    pure $ fmap
+        (\supportsColour -> if supportsColour then EnableColour else DisableColour)
+        supportsANSI