{-# LANGUAGE NoImplicitPrelude #-}
{-|
For the most part, the data constructors of 'Style' do not clash with other
names. When they do, import the module qualified. For example:

> import qualified RIO.PrettyPrint.Types.PrettyPrint as PP
-}
module RIO.PrettyPrint.Types
  (
    Style (..)
  , Styles
  , StyleSpec
  ) where

import Data.Array.IArray (Array)
import Data.Ix (Ix)
import Data.Text (Text)
import RIO
import System.Console.ANSI.Types (SGR)

-- |A style of rio-prettyprint's output.
data Style
  = Error     -- Should be used sparingly, not to style entire long messages.
              -- For example, it's used to style the "Error:" or "[error]" label
              -- for an error message, not the entire message.
  | Warning   -- Should be used sparingly, not to style entire long messages.
              -- For example, it's used to style the "Warning:" or "[warn]"
              -- label for a warning message, not the entire message.
  | Info      -- Should be used sparingly, not to style entire long messages.
              -- For example, it's used to style the "[info]" label for an info
              -- message, not the entire message.
  | Debug     -- Should be used sparingly, not to style entire long messages.
              -- For example, it's used to style the "[debug]" label for a debug
              -- message, not the entire message.
  | OtherLevel      -- Should be used sparingly, not to style entire long
                    -- messages. For example, it's used to style the "[...]"
                    -- label for an other log level message, not the entire
                    -- message.
  | Good      -- Style in a way to emphasize that it is a particularly good
              -- thing.
  | Shell     -- Style as a shell command, i.e. when suggesting something to the
              -- user that should be typed in directly as written.
  | File      -- Style as a filename. See 'Dir' for directories.
  | Url       -- Style as a URL.
  | Dir       -- Style as a directory name. See 'File' for files.
  | Recommendation  -- Style used to highlight part of a recommended course of
                    -- action.
  | Current   -- Style in a way that emphasizes that it is related to a current
              -- thing. For example, could be used when talking about the current
              -- package we're processing when outputting the name of it.
  | Target    -- TODO: figure out how to describe this
  | Module    -- Style as a module name.
  | PkgComponent    -- Style used to highlight the named component of a package.
  | Secondary -- Style for secondary content. For example, it's used to style
              -- timestamps.
  | Highlight -- Should be used sparingly, not to style entire long messages.
              -- For example, it's used to style the duration in a "Finished
              -- process in ... ms" message.
  deriving (Style
forall a. a -> a -> Bounded a
maxBound :: Style
$cmaxBound :: Style
minBound :: Style
$cminBound :: Style
Bounded, Int -> Style
Style -> Int
Style -> [Style]
Style -> Style
Style -> Style -> [Style]
Style -> Style -> Style -> [Style]
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 :: Style -> Style -> Style -> [Style]
$cenumFromThenTo :: Style -> Style -> Style -> [Style]
enumFromTo :: Style -> Style -> [Style]
$cenumFromTo :: Style -> Style -> [Style]
enumFromThen :: Style -> Style -> [Style]
$cenumFromThen :: Style -> Style -> [Style]
enumFrom :: Style -> [Style]
$cenumFrom :: Style -> [Style]
fromEnum :: Style -> Int
$cfromEnum :: Style -> Int
toEnum :: Int -> Style
$ctoEnum :: Int -> Style
pred :: Style -> Style
$cpred :: Style -> Style
succ :: Style -> Style
$csucc :: Style -> Style
Enum, Style -> Style -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Style -> Style -> Bool
$c/= :: Style -> Style -> Bool
== :: Style -> Style -> Bool
$c== :: Style -> Style -> Bool
Eq, Ord Style
(Style, Style) -> Int
(Style, Style) -> [Style]
(Style, Style) -> Style -> Bool
(Style, Style) -> Style -> Int
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
unsafeRangeSize :: (Style, Style) -> Int
$cunsafeRangeSize :: (Style, Style) -> Int
rangeSize :: (Style, Style) -> Int
$crangeSize :: (Style, Style) -> Int
inRange :: (Style, Style) -> Style -> Bool
$cinRange :: (Style, Style) -> Style -> Bool
unsafeIndex :: (Style, Style) -> Style -> Int
$cunsafeIndex :: (Style, Style) -> Style -> Int
index :: (Style, Style) -> Style -> Int
$cindex :: (Style, Style) -> Style -> Int
range :: (Style, Style) -> [Style]
$crange :: (Style, Style) -> [Style]
Ix, Eq Style
Style -> Style -> Bool
Style -> Style -> Ordering
Style -> Style -> Style
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 :: Style -> Style -> Style
$cmin :: Style -> Style -> Style
max :: Style -> Style -> Style
$cmax :: Style -> Style -> Style
>= :: Style -> Style -> Bool
$c>= :: Style -> Style -> Bool
> :: Style -> Style -> Bool
$c> :: Style -> Style -> Bool
<= :: Style -> Style -> Bool
$c<= :: Style -> Style -> Bool
< :: Style -> Style -> Bool
$c< :: Style -> Style -> Bool
compare :: Style -> Style -> Ordering
$ccompare :: Style -> Style -> Ordering
Ord, Int -> Style -> ShowS
[Style] -> ShowS
Style -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Style] -> ShowS
$cshowList :: [Style] -> ShowS
show :: Style -> String
$cshow :: Style -> String
showsPrec :: Int -> Style -> ShowS
$cshowsPrec :: Int -> Style -> ShowS
Show)

-- |The first style overrides the second.
instance Semigroup Style where
  Style
s <> :: Style -> Style -> Style
<> Style
_ = Style
s

-- |A style specification, pairing its \'key\' with the corresponding list of
-- 'SGR' codes.
type StyleSpec = (Text, [SGR])

-- |Style specifications indexed by the style.
type Styles = Array Style StyleSpec