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

This module introduces 'Severity' data type for expressing how severe the
message is. Also, it contains useful functions to work with 'Severity'.
-}

module Stan.Severity
    ( Severity (..)

      -- * Pretty printing
    , severityDescription
    , severityColour
    , prettyShowSeverity
    ) where

import Colourista (blue, bold, cyan, formatWith, magenta, red, yellow)
import Data.Aeson.Micro (ToJSON (..))


{- | Severity level of the inspection.

 +---------------+-----------------------------------------------------+
 | Severity      | Example                                             |
 +===============+=====================================================+
 | 'Style'       | Missing @infix@, or type signature in @where@       |
 +---------------+-----------------------------------------------------+
 | 'Performance' | Usage of 'Data.Foldable.sum', 'Data.Foldable.foldl' |
 +---------------+-----------------------------------------------------+
 | 'PotentialBug'| Some common user errors: @[0 .. length xs]@         |
 +---------------+-----------------------------------------------------+
 | 'Warning'     | Partial functions, like 'GHC.List.head'             |
 +---------------+-----------------------------------------------------+
 | 'Error'       | Usage of 'undefined' in code                        |
 +---------------+-----------------------------------------------------+

-}
data Severity
    -- | Code style issues. Usually harmless.
    = Style
    -- | Serious defects that could cause slowness and space leaking.
    | Performance
    -- | Human errors in code.
    | PotentialBug
    -- | Potential runtime errors on some inputs.
    | Warning
    -- | Dangerous behaviour.
    | Error
    deriving stock (Int -> Severity -> ShowS
[Severity] -> ShowS
Severity -> String
(Int -> Severity -> ShowS)
-> (Severity -> String) -> ([Severity] -> ShowS) -> Show Severity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Severity] -> ShowS
$cshowList :: [Severity] -> ShowS
show :: Severity -> String
$cshow :: Severity -> String
showsPrec :: Int -> Severity -> ShowS
$cshowsPrec :: Int -> Severity -> ShowS
Show, ReadPrec [Severity]
ReadPrec Severity
Int -> ReadS Severity
ReadS [Severity]
(Int -> ReadS Severity)
-> ReadS [Severity]
-> ReadPrec Severity
-> ReadPrec [Severity]
-> Read Severity
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Severity]
$creadListPrec :: ReadPrec [Severity]
readPrec :: ReadPrec Severity
$creadPrec :: ReadPrec Severity
readList :: ReadS [Severity]
$creadList :: ReadS [Severity]
readsPrec :: Int -> ReadS Severity
$creadsPrec :: Int -> ReadS Severity
Read, Severity -> Severity -> Bool
(Severity -> Severity -> Bool)
-> (Severity -> Severity -> Bool) -> Eq Severity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Severity -> Severity -> Bool
$c/= :: Severity -> Severity -> Bool
== :: Severity -> Severity -> Bool
$c== :: Severity -> Severity -> Bool
Eq, Eq Severity
Eq Severity =>
(Severity -> Severity -> Ordering)
-> (Severity -> Severity -> Bool)
-> (Severity -> Severity -> Bool)
-> (Severity -> Severity -> Bool)
-> (Severity -> Severity -> Bool)
-> (Severity -> Severity -> Severity)
-> (Severity -> Severity -> Severity)
-> Ord Severity
Severity -> Severity -> Bool
Severity -> Severity -> Ordering
Severity -> Severity -> Severity
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 :: Severity -> Severity -> Severity
$cmin :: Severity -> Severity -> Severity
max :: Severity -> Severity -> Severity
$cmax :: Severity -> Severity -> Severity
>= :: Severity -> Severity -> Bool
$c>= :: Severity -> Severity -> Bool
> :: Severity -> Severity -> Bool
$c> :: Severity -> Severity -> Bool
<= :: Severity -> Severity -> Bool
$c<= :: Severity -> Severity -> Bool
< :: Severity -> Severity -> Bool
$c< :: Severity -> Severity -> Bool
compare :: Severity -> Severity -> Ordering
$ccompare :: Severity -> Severity -> Ordering
$cp1Ord :: Eq Severity
Ord, Int -> Severity
Severity -> Int
Severity -> [Severity]
Severity -> Severity
Severity -> Severity -> [Severity]
Severity -> Severity -> Severity -> [Severity]
(Severity -> Severity)
-> (Severity -> Severity)
-> (Int -> Severity)
-> (Severity -> Int)
-> (Severity -> [Severity])
-> (Severity -> Severity -> [Severity])
-> (Severity -> Severity -> [Severity])
-> (Severity -> Severity -> Severity -> [Severity])
-> Enum Severity
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 :: Severity -> Severity -> Severity -> [Severity]
$cenumFromThenTo :: Severity -> Severity -> Severity -> [Severity]
enumFromTo :: Severity -> Severity -> [Severity]
$cenumFromTo :: Severity -> Severity -> [Severity]
enumFromThen :: Severity -> Severity -> [Severity]
$cenumFromThen :: Severity -> Severity -> [Severity]
enumFrom :: Severity -> [Severity]
$cenumFrom :: Severity -> [Severity]
fromEnum :: Severity -> Int
$cfromEnum :: Severity -> Int
toEnum :: Int -> Severity
$ctoEnum :: Int -> Severity
pred :: Severity -> Severity
$cpred :: Severity -> Severity
succ :: Severity -> Severity
$csucc :: Severity -> Severity
Enum, Severity
Severity -> Severity -> Bounded Severity
forall a. a -> a -> Bounded a
maxBound :: Severity
$cmaxBound :: Severity
minBound :: Severity
$cminBound :: Severity
Bounded)

instance ToJSON Severity where
    toJSON :: Severity -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> (Severity -> Text) -> Severity -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Show a, IsString Text) => a -> Text
forall b a. (Show a, IsString b) => a -> b
show @Text

-- | Description of each 'Severity' level.
severityDescription :: Severity -> Text
severityDescription :: Severity -> Text
severityDescription = \case
    Style        -> "Code style issues. Usually harmless."
    Performance  -> "Serious defects that could cause slowness and space leaking."
    PotentialBug -> "Human errors in code."
    Warning      -> "Potential runtime errors on some inputs."
    Error        -> "Dangerous behaviour."

-- | Get the colour of the severity level.
severityColour :: Severity -> Text
severityColour :: Severity -> Text
severityColour = \case
    Style        -> Text
forall str. IsString str => str
cyan
    Performance  -> Text
forall str. IsString str => str
blue
    PotentialBug -> Text
forall str. IsString str => str
magenta
    Warning      -> Text
forall str. IsString str => str
yellow
    Error        -> Text
forall str. IsString str => str
red

-- | Show 'Severity' in a human-friendly format.
prettyShowSeverity :: Severity -> Text
prettyShowSeverity :: Severity -> Text
prettyShowSeverity s :: Severity
s = [Text] -> Text -> Text
forall str. (IsString str, Semigroup str) => [str] -> str -> str
formatWith [Severity -> Text
severityColour Severity
s, Text
forall str. IsString str => str
bold] (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Severity -> Text
forall b a. (Show a, IsString b) => a -> b
show Severity
s