{- |
Module                  : Iris.Colour.Mode
Copyright               : (c) 2020 Kowainik
                          (c) 2022 Dmitrii Kovanikov
SPDX-License-Identifier : MPL-2.0
Maintainer              : Dmitrii Kovanikov <kovanikov@gmail.com>
Stability               : Experimental
Portability             : Portable

The 'ColourMode' data type that allows disabling and enabling of
colouring.

@since 0.0.0.0
-}

module Iris.Colour.Mode
    ( ColourMode (..)
    , handleColourMode
    ) where

import System.Console.ANSI (hSupportsANSIColor)
import System.IO (Handle)


{- | Data type that tells whether the colouring is enabled or
disabled. Its value is detected automatically on application start and
stored in 'Iris.Env.CliEnv'.

@since 0.0.0.0
-}
data ColourMode
    -- | @since 0.0.0.0
    = DisableColour

    -- | @since 0.0.0.0
    | EnableColour
    deriving stock
        ( Int -> ColourMode -> ShowS
[ColourMode] -> ShowS
ColourMode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColourMode] -> ShowS
$cshowList :: [ColourMode] -> ShowS
show :: ColourMode -> String
$cshow :: ColourMode -> String
showsPrec :: Int -> ColourMode -> ShowS
$cshowsPrec :: Int -> ColourMode -> ShowS
Show     -- ^ @since 0.0.0.0
        , ColourMode -> ColourMode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ColourMode -> ColourMode -> Bool
$c/= :: ColourMode -> ColourMode -> Bool
== :: ColourMode -> ColourMode -> Bool
$c== :: ColourMode -> ColourMode -> Bool
Eq       -- ^ @since 0.0.0.0
        , Eq ColourMode
ColourMode -> ColourMode -> Bool
ColourMode -> ColourMode -> Ordering
ColourMode -> ColourMode -> ColourMode
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ColourMode -> ColourMode -> ColourMode
$cmin :: ColourMode -> ColourMode -> ColourMode
max :: ColourMode -> ColourMode -> ColourMode
$cmax :: ColourMode -> ColourMode -> ColourMode
>= :: ColourMode -> ColourMode -> Bool
$c>= :: ColourMode -> ColourMode -> Bool
> :: ColourMode -> ColourMode -> Bool
$c> :: ColourMode -> ColourMode -> Bool
<= :: ColourMode -> ColourMode -> Bool
$c<= :: ColourMode -> ColourMode -> Bool
< :: ColourMode -> ColourMode -> Bool
$c< :: ColourMode -> ColourMode -> Bool
compare :: ColourMode -> ColourMode -> Ordering
$ccompare :: ColourMode -> ColourMode -> Ordering
Ord      -- ^ @since 0.0.0.0
        , Int -> ColourMode
ColourMode -> Int
ColourMode -> [ColourMode]
ColourMode -> ColourMode
ColourMode -> ColourMode -> [ColourMode]
ColourMode -> ColourMode -> ColourMode -> [ColourMode]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ColourMode -> ColourMode -> ColourMode -> [ColourMode]
$cenumFromThenTo :: ColourMode -> ColourMode -> ColourMode -> [ColourMode]
enumFromTo :: ColourMode -> ColourMode -> [ColourMode]
$cenumFromTo :: ColourMode -> ColourMode -> [ColourMode]
enumFromThen :: ColourMode -> ColourMode -> [ColourMode]
$cenumFromThen :: ColourMode -> ColourMode -> [ColourMode]
enumFrom :: ColourMode -> [ColourMode]
$cenumFrom :: ColourMode -> [ColourMode]
fromEnum :: ColourMode -> Int
$cfromEnum :: ColourMode -> Int
toEnum :: Int -> ColourMode
$ctoEnum :: Int -> ColourMode
pred :: ColourMode -> ColourMode
$cpred :: ColourMode -> ColourMode
succ :: ColourMode -> ColourMode
$csucc :: ColourMode -> ColourMode
Enum     -- ^ @since 0.0.0.0
        , ColourMode
forall a. a -> a -> Bounded a
maxBound :: ColourMode
$cmaxBound :: ColourMode
minBound :: ColourMode
$cminBound :: ColourMode
Bounded  -- ^ @since 0.0.0.0
        )

{- | Returns 'ColourMode' of a 'Handle'. You can use this function on
output 'Handle's to find out whether they support colouring or
not.

Use a function like this to check whether you can print with colour
to terminal:

@
'handleColourMode' 'System.IO.stdout'
@

@since 0.0.0.0
-}
handleColourMode :: Handle -> IO ColourMode
handleColourMode :: Handle -> IO ColourMode
handleColourMode Handle
handle = do
    Bool
supportsANSI <- Handle -> IO Bool
hSupportsANSIColor Handle
handle
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ if Bool
supportsANSI then ColourMode
EnableColour else ColourMode
DisableColour

{-
------------------------
-- Original source code:
------------------------

{-# 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 <xrom.xkov@gmail.com>

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
-}