    module GHC.Utils.Ppr.Colour where
    import GHC.Prelude.Basic

    import Data.Maybe (fromMaybe)
    import GHC.Data.Bool
    import Data.Semigroup as Semi

    -- | A colour\/style for use with 'coloured'.
    newtype PprColour = PprColour { PprColour -> String
    renderColour :: String }

    instance Semi.Semigroup PprColour where
      PprColour String
    s1 <> :: PprColour -> PprColour -> PprColour
    <> PprColour String
    s2 = String -> PprColour
    PprColour (String
    s1 String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    s2)

    -- | Allow colours to be combined (e.g. bold + red);
    --   In case of conflict, right side takes precedence.
    instance Monoid PprColour where
      mempty :: PprColour
    mempty = String -> PprColour
    PprColour String
    forall a. Monoid a => a
    mempty
      mappend :: PprColour -> PprColour -> PprColour
    mappend = PprColour -> PprColour -> PprColour
    forall a. Semigroup a => a -> a -> a
    (<>)

    renderColourAfresh :: PprColour -> String
    renderColourAfresh :: PprColour -> String
    renderColourAfresh PprColour
    c = PprColour -> String
    renderColour (PprColour
    colReset PprColour -> PprColour -> PprColour
    forall a. Monoid a => a -> a -> a
    `mappend` PprColour
    c)

    colCustom :: String -> PprColour
    colCustom :: String -> PprColour
    colCustom String
    "" = PprColour
    forall a. Monoid a => a
    mempty
    colCustom String
    s  = String -> PprColour
    PprColour (String
    "\27[" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    s String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "m")

    colReset :: PprColour
    colReset :: PprColour
    colReset = String -> PprColour
    colCustom String
    "0"

    colBold :: PprColour
    colBold :: PprColour
    colBold = String -> PprColour
    colCustom String
    ";1"

    colBlackFg :: PprColour
    colBlackFg :: PprColour
    colBlackFg = String -> PprColour
    colCustom String
    "30"

    colRedFg :: PprColour
    colRedFg :: PprColour
    colRedFg = String -> PprColour
    colCustom String
    "31"

    colGreenFg :: PprColour
    colGreenFg :: PprColour
    colGreenFg = String -> PprColour
    colCustom String
    "32"

    colYellowFg :: PprColour
    colYellowFg :: PprColour
    colYellowFg = String -> PprColour
    colCustom String
    "33"

    colBlueFg :: PprColour
    colBlueFg :: PprColour
    colBlueFg = String -> PprColour
    colCustom String
    "34"

    colMagentaFg :: PprColour
    colMagentaFg :: PprColour
    colMagentaFg = String -> PprColour
    colCustom String
    "35"

    colCyanFg :: PprColour
    colCyanFg :: PprColour
    colCyanFg = String -> PprColour
    colCustom String
    "36"

    colWhiteFg :: PprColour
    colWhiteFg :: PprColour
    colWhiteFg = String -> PprColour
    colCustom String
    "37"

    data Scheme =
      Scheme
      { Scheme -> PprColour
    sHeader  :: PprColour
      , Scheme -> PprColour
    sMessage :: PprColour
      , Scheme -> PprColour
    sWarning :: PprColour
      , Scheme -> PprColour
    sError   :: PprColour
      , Scheme -> PprColour
    sFatal   :: PprColour
      , Scheme -> PprColour
    sMargin  :: PprColour
      }

    defaultScheme :: Scheme
    defaultScheme :: Scheme
    defaultScheme =
      Scheme
      { sHeader :: PprColour
    sHeader  = PprColour
    forall a. Monoid a => a
    mempty
      , sMessage :: PprColour
    sMessage = PprColour
    colBold
      , sWarning :: PprColour
    sWarning = PprColour
    colBold PprColour -> PprColour -> PprColour
    forall a. Monoid a => a -> a -> a
    `mappend` PprColour
    colMagentaFg
      , sError :: PprColour
    sError   = PprColour
    colBold PprColour -> PprColour -> PprColour
    forall a. Monoid a => a -> a -> a
    `mappend` PprColour
    colRedFg
      , sFatal :: PprColour
    sFatal   = PprColour
    colBold PprColour -> PprColour -> PprColour
    forall a. Monoid a => a -> a -> a
    `mappend` PprColour
    colRedFg
      , sMargin :: PprColour
    sMargin  = PprColour
    colBold PprColour -> PprColour -> PprColour
    forall a. Monoid a => a -> a -> a
    `mappend` PprColour
    colBlueFg
      }

    -- | Parse the colour scheme from a string (presumably from the @GHC_COLORS@
    -- environment variable).
    parseScheme :: String -> (OverridingBool, Scheme) -> (OverridingBool, Scheme)
    parseScheme :: String -> (OverridingBool, Scheme) -> (OverridingBool, Scheme)
    parseScheme String
    "always" (OverridingBool
    _, Scheme
    cs) = (OverridingBool
    Always, Scheme
    cs)
    parseScheme String
    "auto"   (OverridingBool
    _, Scheme
    cs) = (OverridingBool
    Auto,   Scheme
    cs)
    parseScheme String
    "never"  (OverridingBool
    _, Scheme
    cs) = (OverridingBool
    Never,  Scheme
    cs)
    parseScheme String
    input    (OverridingBool
    b, Scheme
    cs) =
      ( OverridingBool
    b
      , Scheme
        { sHeader :: PprColour
    sHeader  = PprColour -> Maybe PprColour -> PprColour
    forall a. a -> Maybe a -> a
    fromMaybe (Scheme -> PprColour
    sHeader Scheme
    cs)  (String -> [(String, PprColour)] -> Maybe PprColour
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup String
    "header" [(String, PprColour)]
    table)
        , sMessage :: PprColour
    sMessage = PprColour -> Maybe PprColour -> PprColour
    forall a. a -> Maybe a -> a
    fromMaybe (Scheme -> PprColour
    sMessage Scheme
    cs) (String -> [(String, PprColour)] -> Maybe PprColour
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup String
    "message" [(String, PprColour)]
    table)
        , sWarning :: PprColour
    sWarning = PprColour -> Maybe PprColour -> PprColour
    forall a. a -> Maybe a -> a
    fromMaybe (Scheme -> PprColour
    sWarning Scheme
    cs) (String -> [(String, PprColour)] -> Maybe PprColour
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup String
    "warning" [(String, PprColour)]
    table)
        , sError :: PprColour
    sError   = PprColour -> Maybe PprColour -> PprColour
    forall a. a -> Maybe a -> a
    fromMaybe (Scheme -> PprColour
    sError Scheme
    cs)   (String -> [(String, PprColour)] -> Maybe PprColour
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup String
    "error"   [(String, PprColour)]
    table)
        , sFatal :: PprColour
    sFatal   = PprColour -> Maybe PprColour -> PprColour
    forall a. a -> Maybe a -> a
    fromMaybe (Scheme -> PprColour
    sFatal Scheme
    cs)   (String -> [(String, PprColour)] -> Maybe PprColour
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup String
    "fatal"   [(String, PprColour)]
    table)
        , sMargin :: PprColour
    sMargin  = PprColour -> Maybe PprColour -> PprColour
    forall a. a -> Maybe a -> a
    fromMaybe (Scheme -> PprColour
    sMargin Scheme
    cs)  (String -> [(String, PprColour)] -> Maybe PprColour
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup String
    "margin"  [(String, PprColour)]
    table)
        }
      )
      where
        split :: Char -> String -> [String]
        split :: Char -> String -> [String]
    split Char
    c String
    s = case (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Char
    c) String
    s of
            (String
    chunk,[])     -> [String
    chunk]
            (String
    chunk,Char
    _:String
    rest) -> String
    chunk String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : Char -> String -> [String]
    split Char
    c String
    rest

        table :: [(String, PprColour)]
    table = do
          w <- Char -> String -> [String]
    split Char
    ':' String
    input
          let (k, v') = break (== '=') w
          case v' of
            Char
    '=' : String
    v -> (String, PprColour) -> [(String, PprColour)]
    forall a. a -> [a]
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String
    k, String -> PprColour
    colCustom String
    v)
            String
    _ -> []