{- SPDX-FileCopyrightText: 2018-2019 Serokell <https://serokell.io>
 -
 - SPDX-License-Identifier: MPL-2.0
 -}
{-# OPTIONS_GHC -Wno-orphans #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}

module Xrefcheck.Util.Colorize
  ( ColorMode(..)
  , Color(..)
  , Style(..)
  , colorizeIfNeeded
  , colorIfNeeded
  , styleIfNeeded
  ) where

import Universum

import Data.Reflection (Given (..))
import Fmt (Buildable (build), Builder, fmt)
import System.Console.Pretty (Color (..), Pretty (..), Section, Style (..))

{-# HLINT ignore  "Avoid style function that ignore ColorMode" #-}
{-# HLINT ignore  "Avoid color function that ignore ColorMode"#-}
{-# HLINT ignore  "Avoid colorize function that ignore ColorMode"#-}

data ColorMode = WithColors | WithoutColors

instance Pretty Builder where
    colorize :: Section -> Color -> Builder -> Builder
colorize Section
s Color
c = forall p. Buildable p => p -> Builder
build @Text (Text -> Builder) -> (Builder -> Text) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Section -> Color -> Text -> Text
forall a. Pretty a => Section -> Color -> a -> a
colorize Section
s Color
c (Text -> Text) -> (Builder -> Text) -> Builder -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
forall b. FromBuilder b => Builder -> b
fmt
    style :: Style -> Builder -> Builder
style Style
s = forall p. Buildable p => p -> Builder
build @Text (Text -> Builder) -> (Builder -> Text) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Style -> Text -> Text
forall a. Pretty a => Style -> a -> a
style Style
s (Text -> Text) -> (Builder -> Text) -> Builder -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
forall b. FromBuilder b => Builder -> b
fmt

colorIfNeeded :: (Pretty a, Given ColorMode) => Color -> a -> a
colorIfNeeded :: forall a. (Pretty a, Given ColorMode) => Color -> a -> a
colorIfNeeded = case ColorMode
forall a. Given a => a
given of
  ColorMode
WithColors -> Color -> a -> a
forall a. Pretty a => Color -> a -> a
color
  ColorMode
WithoutColors -> (a -> a) -> Color -> a -> a
forall a b. a -> b -> a
const a -> a
forall a. a -> a
id

styleIfNeeded :: (Pretty a, Given ColorMode) => Style -> a -> a
styleIfNeeded :: forall a. (Pretty a, Given ColorMode) => Style -> a -> a
styleIfNeeded = case ColorMode
forall a. Given a => a
given of
  ColorMode
WithColors -> Style -> a -> a
forall a. Pretty a => Style -> a -> a
style
  ColorMode
WithoutColors -> (a -> a) -> Style -> a -> a
forall a b. a -> b -> a
const a -> a
forall a. a -> a
id

colorizeIfNeeded :: (Pretty a, Given ColorMode) => Section -> Color -> a -> a
colorizeIfNeeded :: forall a. (Pretty a, Given ColorMode) => Section -> Color -> a -> a
colorizeIfNeeded Section
section = case ColorMode
forall a. Given a => a
given of
  ColorMode
WithColors -> Section -> Color -> a -> a
forall a. Pretty a => Section -> Color -> a -> a
colorize Section
section
  ColorMode
WithoutColors -> (a -> a) -> Color -> a -> a
forall a b. a -> b -> a
const a -> a
forall a. a -> a
id