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

__Category__ — a type of 'Stan.Inspection.Inspection'.
-}

module Stan.Category
    ( -- * Data type
      Category (..)

      -- * Pretty printing
    , prettyShowCategory

      -- * Stan categories
    , stanCategories
    , antiPattern
    , infinite
    , list
    , partial
    , spaceLeak
    , syntax
    , unsafe
    ) where

import Colourista (formatWith, magentaBg)
import Data.Aeson.Micro (ToJSON)


-- | A type of the inspection.
newtype Category = Category
    { Category -> Text
unCategory :: Text
    } deriving newtype (Int -> Category -> ShowS
[Category] -> ShowS
Category -> String
(Int -> Category -> ShowS)
-> (Category -> String) -> ([Category] -> ShowS) -> Show Category
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Category] -> ShowS
$cshowList :: [Category] -> ShowS
show :: Category -> String
$cshow :: Category -> String
showsPrec :: Int -> Category -> ShowS
$cshowsPrec :: Int -> Category -> ShowS
Show, Category -> Category -> Bool
(Category -> Category -> Bool)
-> (Category -> Category -> Bool) -> Eq Category
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Category -> Category -> Bool
$c/= :: Category -> Category -> Bool
== :: Category -> Category -> Bool
$c== :: Category -> Category -> Bool
Eq, Int -> Category -> Int
Category -> Int
(Int -> Category -> Int) -> (Category -> Int) -> Hashable Category
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Category -> Int
$chash :: Category -> Int
hashWithSalt :: Int -> Category -> Int
$chashWithSalt :: Int -> Category -> Int
Hashable, Category -> Value
(Category -> Value) -> ToJSON Category
forall a. (a -> Value) -> ToJSON a
toJSON :: Category -> Value
$ctoJSON :: Category -> Value
ToJSON)

-- | Show 'Category' in a human-friendly format.
prettyShowCategory :: Category -> Text
prettyShowCategory :: Category -> Text
prettyShowCategory cat :: Category
cat = [Text] -> Text -> Text
forall str. (IsString str, Semigroup str) => [str] -> str -> str
formatWith [Text
forall str. IsString str => str
magentaBg] (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ "#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Category -> Text
unCategory Category
cat

-- | @List@ category of Stan inspections.
list :: Category
list :: Category
list = Text -> Category
Category "List"

-- | @Partial@ category of Stan inspections.
partial :: Category
partial :: Category
partial = Text -> Category
Category "Partial"

-- | @Infinite@ category of Stan inspections.
infinite :: Category
infinite :: Category
infinite = Text -> Category
Category "Infinite"

-- | @AntiPattern@ category of Stan inspections.
antiPattern :: Category
antiPattern :: Category
antiPattern = Text -> Category
Category "AntiPattern"

-- | @SpaceLeak@ category of Stan inspections.
spaceLeak :: Category
spaceLeak :: Category
spaceLeak = Text -> Category
Category "SpaceLeak"

{- | @Syntax@ category of Stan inspections. Usually used in
'Stan.Severity.Style' inspections.
-}
syntax :: Category
syntax :: Category
syntax = Text -> Category
Category "Syntax"

-- | @Unsafe@ category of Stan inspections.
unsafe :: Category
unsafe :: Category
unsafe = Text -> Category
Category "Unsafe"

-- | The list of all available Stan 'Category's.
stanCategories :: [Category]
stanCategories :: [Category]
stanCategories =
    [ Category
antiPattern
    , Category
infinite
    , Category
list
    , Category
partial
    , Category
spaceLeak
    , Category
syntax
    , Category
unsafe
    ]