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

Contains all 'Inspection's for style improvements.

The __style__ inspections are in ranges:

* @STAN-0301 .. STAN-0400@
-}

module Stan.Inspection.Style
    ( -- * Style inspections
      -- *** Missing fixity
      stan0301
      -- *** Too big tuples
    , stan0302

      -- * All inspections
    , styleInspectionsMap
    ) where

import Relude.Extra.Tuple (fmapToFst)

import Stan.Core.Id (Id (..))
import Stan.Inspection (Inspection (..), InspectionAnalysis (..), InspectionsMap)
import Stan.Severity (Severity (Style))

import qualified Stan.Category as Category


-- | All anti-pattern 'Inspection's map from 'Id's.
styleInspectionsMap :: InspectionsMap
styleInspectionsMap :: InspectionsMap
styleInspectionsMap = [Item InspectionsMap] -> InspectionsMap
forall l. IsList l => [Item l] -> l
fromList ([Item InspectionsMap] -> InspectionsMap)
-> [Item InspectionsMap] -> InspectionsMap
forall a b. (a -> b) -> a -> b
$ (Inspection -> Id Inspection)
-> [Inspection] -> [(Id Inspection, Inspection)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f (b, a)
fmapToFst Inspection -> Id Inspection
inspectionId
    [ Inspection
stan0301
    , Inspection
stan0302
    ]

-- | 'Inspection' — missing fixity declaration @STAN-0301@.
stan0301 :: Inspection
stan0301 :: Inspection
stan0301 = $WInspection :: Id Inspection
-> Text
-> Text
-> [Text]
-> NonEmpty Category
-> Severity
-> InspectionAnalysis
-> Inspection
Inspection
    { inspectionId :: Id Inspection
inspectionId = Text -> Id Inspection
forall a. Text -> Id a
Id "STAN-0301"
    , inspectionName :: Text
inspectionName = "Missing fixity declaration for operator"
    , inspectionDescription :: Text
inspectionDescription = "Using the implicit default fixity for operator: infixl 9"
    , inspectionSolution :: [Text]
inspectionSolution =
        [ "Add 'infix[l|r]' declaration to the operator with explicit precedence"
        ]
    , inspectionCategory :: NonEmpty Category
inspectionCategory = Category
Category.syntax Category -> [Category] -> NonEmpty Category
forall a. a -> [a] -> NonEmpty a
:| []
    , inspectionSeverity :: Severity
inspectionSeverity = Severity
Style
    , inspectionAnalysis :: InspectionAnalysis
inspectionAnalysis = InspectionAnalysis
Infix
    }

-- | 'Inspection' — to big tuples @STAN-0302@.
stan0302 :: Inspection
stan0302 :: Inspection
stan0302 = $WInspection :: Id Inspection
-> Text
-> Text
-> [Text]
-> NonEmpty Category
-> Severity
-> InspectionAnalysis
-> Inspection
Inspection
    { inspectionId :: Id Inspection
inspectionId = Text -> Id Inspection
forall a. Text -> Id a
Id "STAN-0302"
    , inspectionName :: Text
inspectionName = "Big tuples"
    , inspectionDescription :: Text
inspectionDescription =
        "Using tuples of big size (>= 4) can decrease code readability"
    , inspectionSolution :: [Text]
inspectionSolution =
        [ "Consider defining and using a custom data type to improve code comprehension"
        ]
    , inspectionCategory :: NonEmpty Category
inspectionCategory = Category
Category.antiPattern Category -> [Category] -> NonEmpty Category
forall a. a -> [a] -> NonEmpty a
:| [Category
Category.syntax]
    , inspectionSeverity :: Severity
inspectionSeverity = Severity
Style
    , inspectionAnalysis :: InspectionAnalysis
inspectionAnalysis = InspectionAnalysis
BigTuples
    }