{-# LANGUAGE CPP #-}

{- |
Copyright: (c) 2020-2021 Kowainik
SPDX-License-Identifier: MPL-2.0
Maintainer: Kowainik <xrom.xkov@gmail.com>

Functions to output formatted 'T.Text' directly to terminal.
-}

module Colourista.IO
    ( -- * Colour
      -- ** Direct
      redMessage
    , greenMessage
    , blueMessage
    , yellowMessage
    , blackMessage
    , whiteMessage
    , magentaMessage
    , cyanMessage
      -- ** Aliases with unicode indicators
    , successMessage
    , infoMessage
    , skipMessage
    , warningMessage
    , errorMessage
      -- * Emphasis
    , boldMessage
    , italicMessage
      -- * General purpose
    , formattedMessage
    ) where

#if __GLASGOW_HASKELL__ < 804
import Data.Semigroup (Semigroup (..))
#endif
import Data.Text (Text)

import qualified Data.Text.IO as TIO

import qualified Colourista.Pure as Colourista

----------------------------------------------------------------------------
-- Direct IO functions
----------------------------------------------------------------------------

-- | Print 'Text' coloured in 'Colourista.red'.
redMessage :: Text -> IO ()
redMessage :: Text -> IO ()
redMessage = [Text] -> Text -> IO ()
formattedMessage [Text
forall str. IsString str => str
Colourista.red]
{-# INLINE redMessage #-}

-- | Print 'Text' coloured in 'Colourista.green'.
greenMessage :: Text -> IO ()
greenMessage :: Text -> IO ()
greenMessage = [Text] -> Text -> IO ()
formattedMessage [Text
forall str. IsString str => str
Colourista.green]
{-# INLINE greenMessage #-}

-- | Print 'Text' coloured in 'Colourista.blue'.
blueMessage :: Text -> IO ()
blueMessage :: Text -> IO ()
blueMessage = [Text] -> Text -> IO ()
formattedMessage [Text
forall str. IsString str => str
Colourista.blue]
{-# INLINE blueMessage #-}

-- | Print 'Text' coloured in 'Colourista.yellow'.
yellowMessage :: Text -> IO ()
yellowMessage :: Text -> IO ()
yellowMessage = [Text] -> Text -> IO ()
formattedMessage [Text
forall str. IsString str => str
Colourista.yellow]
{-# INLINE yellowMessage #-}

-- | Print 'Text' coloured in 'Colourista.black'.
blackMessage :: Text -> IO ()
blackMessage :: Text -> IO ()
blackMessage = [Text] -> Text -> IO ()
formattedMessage [Text
forall str. IsString str => str
Colourista.black]
{-# INLINE blackMessage #-}

-- | Print 'Text' coloured in 'Colourista.white'.
whiteMessage :: Text -> IO ()
whiteMessage :: Text -> IO ()
whiteMessage = [Text] -> Text -> IO ()
formattedMessage [Text
forall str. IsString str => str
Colourista.white]
{-# INLINE whiteMessage #-}

-- | Print 'Text' coloured in 'Colourista.magenta'.
magentaMessage :: Text -> IO ()
magentaMessage :: Text -> IO ()
magentaMessage = [Text] -> Text -> IO ()
formattedMessage [Text
forall str. IsString str => str
Colourista.magenta]
{-# INLINE magentaMessage #-}

-- | Print 'Text' coloured in 'Colourista.cyan'.
cyanMessage :: Text -> IO ()
cyanMessage :: Text -> IO ()
cyanMessage = [Text] -> Text -> IO ()
formattedMessage [Text
forall str. IsString str => str
Colourista.cyan]
{-# INLINE cyanMessage #-}

----------------------------------------------------------------------------
-- Informative aliases
----------------------------------------------------------------------------

{- | Similar to 'greenMessage', but add unicode indicator.

<<https://user-images.githubusercontent.com/4276606/80867598-dbd99000-8c8c-11ea-9fac-81a1a606d8d8.png Success message>>
-}
successMessage :: Text -> IO ()
successMessage :: Text -> IO ()
successMessage Text
t = Text -> IO ()
greenMessage (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"  ✔ " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
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 :: Text -> IO ()
infoMessage Text
t = Text -> IO ()
blueMessage (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"  ⓘ " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
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 :: Text -> IO ()
skipMessage Text
t = Text -> IO ()
cyanMessage (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"  ▶ " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
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 :: Text -> IO ()
warningMessage Text
t = Text -> IO ()
yellowMessage (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"  ⚠ " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
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 :: Text -> IO ()
errorMessage Text
t = Text -> IO ()
redMessage (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"  \128721 " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t
{-# INLINE errorMessage #-}

----------------------------------------------------------------------------
-- Emphasis
----------------------------------------------------------------------------

-- | Print 'Text' emphasized with 'Colourista.bold'.
boldMessage :: Text -> IO ()
boldMessage :: Text -> IO ()
boldMessage = [Text] -> Text -> IO ()
formattedMessage [Text
forall str. IsString str => str
Colourista.bold]
{-# INLINE boldMessage #-}

-- | Print 'Text' emphasized with 'Colourista.italic'.
italicMessage :: Text -> IO ()
italicMessage :: Text -> IO ()
italicMessage = [Text] -> Text -> IO ()
formattedMessage [Text
forall str. IsString str => str
Colourista.italic]
{-# INLINE italicMessage #-}

----------------------------------------------------------------------------
-- General purposes
----------------------------------------------------------------------------

{- | Print message with specified list of formatting options. See
'Colourista.formatWith' for more details. If this function takes empty
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 :: [Text] -> Text -> IO ()
formattedMessage [Text]
formatting = Text -> IO ()
TIO.putStrLn (Text -> IO ()) -> (Text -> Text) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text -> Text
forall str. (IsString str, Semigroup str) => [str] -> str -> str
Colourista.formatWith [Text]
formatting
{-# INLINE formattedMessage #-}