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

Contains all 'Inspection's for known anti-patterns.

The __anti-pattern__ inspections are in ranges:

* @STAN-0201 .. STAN-0300@

-}

module Stan.Inspection.AntiPattern
    ( -- * Anti-pattern inspections
      -- *** Anti-pattern @[0 .. length xs]@
      stan0201
      -- *** Anti-pattern 'foldl'
    , stan0202
      -- *** Anti-pattern 'Data.ByteString.Char8.pack'
    , stan0203
      -- *** Anti-pattern slow 'size' for 'HashMap'
    , stan0204
      -- *** Anti-pattern slow 'size' for 'HashSet'
    , stan0205
      -- *** Anti-pattern: Lazy fields
    , stan0206
      -- *** Anti-pattern: Foldable methods on tuples, 'Maybe', 'Either'
    , stan0207
      -- *** Anti-pattern: slow 'length' for 'Text'
    , stan0208
      -- *** Anti-pattern: Slow 'nub' for lists
    , stan0209
      -- *** Anti-pattern: Slow 'for_' on ranges
    , stan0210
      -- *** Anti-pattern: '</>' for URLs
    , stan0211
      -- *** Anti-pattern: unsafe functions
    , stan0212
      -- *** Anti-pattern: Pattern-matching on @_@
    , stan0213
      -- *** Anti-pattern: use 'compare'
    , stan0214
      -- *** Anti-pattern: Slashes in paths
    , stan0215

      -- * All inspections
    , antiPatternInspectionsMap
    ) where

import Relude.Extra.Lens ((%~), (.~))
import Relude.Extra.Tuple (fmapToFst)

import Stan.Core.Id (Id (..))
import Stan.Inspection (Inspection (..), InspectionAnalysis (..), InspectionsMap, categoryL,
                        descriptionL, severityL, solutionL)
import Stan.NameMeta (NameMeta (..), baseNameFrom, mkBaseFoldableMeta, mkBaseOldListMeta,
                      primTypeMeta, textNameFrom, unorderedNameFrom)
import Stan.Pattern.Ast (Literal (..), PatternAst (..), anyNamesToPatternAst, app,
                         namesToPatternAst, opApp, range)
import Stan.Pattern.Edsl (PatternBool (..))
import Stan.Pattern.Type (PatternType, charPattern, foldableMethodsPatterns, foldableTypesPatterns,
                          listPattern, stringPattern, textPattern, (|->), (|::))
import Stan.Severity (Severity (..))

import qualified Data.List.NonEmpty as NE
import qualified Stan.Category as Category


-- | All anti-pattern 'Inspection's map from 'Id's.
antiPatternInspectionsMap :: InspectionsMap
antiPatternInspectionsMap :: InspectionsMap
antiPatternInspectionsMap = [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
stan0201
    , Inspection
stan0202
    , Inspection
stan0203
    , Inspection
stan0204
    , Inspection
stan0205
    , Inspection
stan0206
    , Inspection
stan0207
    , Inspection
stan0208
    , Inspection
stan0209
    , Inspection
stan0210
    , Inspection
stan0211
    , Inspection
stan0212
    , Inspection
stan0213
    , Inspection
stan0214
    , Inspection
stan0215
    ]

-- | Smart constructor to create anti-pattern 'Inspection'.
mkAntiPatternInspection :: Id Inspection -> Text -> InspectionAnalysis -> Inspection
mkAntiPatternInspection :: Id Inspection -> Text -> InspectionAnalysis -> Inspection
mkAntiPatternInspection insId :: Id Inspection
insId name :: Text
name inspectionAnalysis :: InspectionAnalysis
inspectionAnalysis = $WInspection :: Id Inspection
-> Text
-> Text
-> [Text]
-> NonEmpty Category
-> Severity
-> InspectionAnalysis
-> Inspection
Inspection
    { inspectionId :: Id Inspection
inspectionId = Id Inspection
insId
    , inspectionName :: Text
inspectionName = "Anti-pattern: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name
    , inspectionDescription :: Text
inspectionDescription = ""
    , inspectionSolution :: [Text]
inspectionSolution = []
    , inspectionCategory :: NonEmpty Category
inspectionCategory = Category
Category.antiPattern Category -> [Category] -> NonEmpty Category
forall a. a -> [a] -> NonEmpty a
:| []
    , inspectionSeverity :: Severity
inspectionSeverity = Severity
PotentialBug
    , ..
    }

-- | 'Inspection' — @[0 .. length xs]@ @STAN-0201@.
stan0201 :: Inspection
stan0201 :: Inspection
stan0201 = Id Inspection -> Text -> InspectionAnalysis -> Inspection
mkAntiPatternInspection (Text -> Id Inspection
forall a. Text -> Id a
Id "STAN-0201") "[0 .. length xs]" (PatternAst -> InspectionAnalysis
FindAst PatternAst
lenPatAst)
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& Lens' Inspection Text
descriptionL Lens' Inspection Text -> Text -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~ "Creating a list with wrong number of indices"
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& Lens' Inspection [Text]
solutionL Lens' Inspection [Text] -> [Text] -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~
        [ "Replace '[0 .. length xs]' with '[0 .. length xs - 1]'"
        , "Use 'zip [0 ..] xs` to work with list of pairs: index and element"
        ]
  where
    lenPatAst :: PatternAst
    lenPatAst :: PatternAst
lenPatAst = PatternAst -> PatternAst -> PatternAst
range
        (Literal -> PatternAst
PatternAstConstant (Literal -> PatternAst) -> Literal -> PatternAst
forall a b. (a -> b) -> a -> b
$ Int -> Literal
ExactNum 0)
        (PatternAst -> PatternAst -> PatternAst
app
            (NameMeta -> PatternType -> PatternAst
PatternAstName (Text -> NameMeta
mkBaseFoldableMeta "length") PatternType
forall a. PatternBool a => a
(?))
            PatternAst
forall a. PatternBool a => a
(?)
        )

-- | 'Inspection' — 'foldl' @STAN-0202@.
stan0202 :: Inspection
stan0202 :: Inspection
stan0202 = Id Inspection -> Text -> InspectionAnalysis -> Inspection
mkAntiPatternInspection (Text -> Id Inspection
forall a. Text -> Id a
Id "STAN-0202") "foldl"
    (PatternAst -> InspectionAnalysis
FindAst (PatternAst -> InspectionAnalysis)
-> PatternAst -> InspectionAnalysis
forall a b. (a -> b) -> a -> b
$ NameMeta -> PatternType -> PatternAst
PatternAstName (Text -> NameMeta
mkBaseFoldableMeta "foldl") PatternType
forall a. PatternBool a => a
(?))
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& Lens' Inspection Text
descriptionL Lens' Inspection Text -> Text -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~ "Usage of space-leaking function 'foldl'"
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& Lens' Inspection [Text]
solutionL Lens' Inspection [Text] -> [Text] -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~
        [ "Replace 'foldl' with 'foldl''"
        , "Use 'foldr (flip . f)` instead of 'foldl f'"
        ]
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& Lens' Inspection Severity
severityL Lens' Inspection Severity -> Severity -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~ Severity
Error
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& Lens' Inspection (NonEmpty Category)
categoryL Lens' Inspection (NonEmpty Category)
-> (NonEmpty Category -> NonEmpty Category)
-> Inspection
-> Inspection
forall s a. Lens' s a -> (a -> a) -> s -> s
%~ (Category
Category.spaceLeak Category -> NonEmpty Category -> NonEmpty Category
forall a. a -> NonEmpty a -> NonEmpty a
`NE.cons`)

-- | 'Inspection' — 'Data.ByteString.Char8.pack' @STAN-0203@.
stan0203 :: Inspection
stan0203 :: Inspection
stan0203 = Id Inspection -> Text -> InspectionAnalysis -> Inspection
mkAntiPatternInspection (Text -> Id Inspection
forall a. Text -> Id a
Id "STAN-0203") "Data.ByteString.Char8.pack"
    (PatternAst -> InspectionAnalysis
FindAst (PatternAst -> InspectionAnalysis)
-> PatternAst -> InspectionAnalysis
forall a b. (a -> b) -> a -> b
$ NameMeta -> PatternType -> PatternAst
PatternAstName NameMeta
packNameMeta PatternType
forall a. PatternBool a => a
(?))
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& Lens' Inspection Text
descriptionL Lens' Inspection Text -> Text -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~ "Usage of 'pack' function that doesn't handle Unicode characters"
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& Lens' Inspection [Text]
solutionL Lens' Inspection [Text] -> [Text] -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~
        [ "Convert to 'Text' and use 'encodeUtf8' from 'Data.Text.Encoding'"
        , "{Extra dependency} Use 'encodeUtf8' from 'relude'"
        , "{Extra dependency} Use the 'utf8-string' package"
        ]
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& Lens' Inspection Severity
severityL Lens' Inspection Severity -> Severity -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~ Severity
Error
  where
    packNameMeta :: NameMeta
    packNameMeta :: NameMeta
packNameMeta = $WNameMeta :: Text -> ModuleName -> Text -> NameMeta
NameMeta
        { nameMetaPackage :: Text
nameMetaPackage    = "bytestring"
        , nameMetaModuleName :: ModuleName
nameMetaModuleName = "Data.ByteString.Char8"
        , nameMetaName :: Text
nameMetaName       = "pack"
        }

-- | 'Inspection' — slow 'Data.HashMap.Strict.size' and 'length' @STAN-0204@.
stan0204 :: Inspection
stan0204 :: Inspection
stan0204 = Id Inspection -> Text -> InspectionAnalysis -> Inspection
mkAntiPatternInspection (Text -> Id Inspection
forall a. Text -> Id a
Id "STAN-0204") "HashMap size"
    (PatternAst -> InspectionAnalysis
FindAst (PatternAst -> InspectionAnalysis)
-> PatternAst -> InspectionAnalysis
forall a b. (a -> b) -> a -> b
$ NonEmpty (NameMeta, PatternType) -> PatternAst
namesToPatternAst NonEmpty (NameMeta, PatternType)
pats)
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& Lens' Inspection Text
descriptionL Lens' Inspection Text -> Text -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~ "Usage of 'size' or 'length' for 'HashMap' that runs in linear time"
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& Lens' Inspection [Text]
solutionL Lens' Inspection [Text] -> [Text] -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~
        [ "{Extra dependency} Switch to 'Map' from 'containers'"
        ]
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& Lens' Inspection Severity
severityL Lens' Inspection Severity -> Severity -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~ Severity
Performance
  where
    pats :: NonEmpty (NameMeta, PatternType)
    pats :: NonEmpty (NameMeta, PatternType)
pats = (NameMeta
sizeNameMeta, PatternType
forall a. PatternBool a => a
(?))
        (NameMeta, PatternType)
-> [(NameMeta, PatternType)] -> NonEmpty (NameMeta, PatternType)
forall a. a -> [a] -> NonEmpty a
:| [(Text -> NameMeta
mkBaseFoldableMeta "length", PatternType
hmPat)]

    sizeNameMeta :: NameMeta
    sizeNameMeta :: NameMeta
sizeNameMeta = "size" Text -> ModuleName -> NameMeta
`unorderedNameFrom` "Data.HashMap.Base"

    hm :: NameMeta
    hm :: NameMeta
hm = "HashMap" Text -> ModuleName -> NameMeta
`unorderedNameFrom` "Data.HashMap.Base"

    hmPat :: PatternType
    hmPat :: PatternType
hmPat = (NameMeta
hm NameMeta -> [PatternType] -> PatternType
|:: [PatternType
forall a. PatternBool a => a
(?), PatternType
forall a. PatternBool a => a
(?)]) PatternType -> PatternType -> PatternType
|-> PatternType
forall a. PatternBool a => a
(?)

-- | 'Inspection' — slow 'Data.HashMap.Strict.size' @STAN-0205@.
stan0205 :: Inspection
stan0205 :: Inspection
stan0205 = Id Inspection -> Text -> InspectionAnalysis -> Inspection
mkAntiPatternInspection (Text -> Id Inspection
forall a. Text -> Id a
Id "STAN-0205") "HashSet size"
           (PatternAst -> InspectionAnalysis
FindAst (PatternAst -> InspectionAnalysis)
-> PatternAst -> InspectionAnalysis
forall a b. (a -> b) -> a -> b
$ NonEmpty (NameMeta, PatternType) -> PatternAst
namesToPatternAst NonEmpty (NameMeta, PatternType)
pats)
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& Lens' Inspection Text
descriptionL Lens' Inspection Text -> Text -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~ "Usage of 'size' or 'length' for 'HashSet' that runs in linear time"
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& Lens' Inspection [Text]
solutionL Lens' Inspection [Text] -> [Text] -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~
        [ "{Extra dependency} Switch to 'Set' from 'containers'"
        ]
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& Lens' Inspection Severity
severityL Lens' Inspection Severity -> Severity -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~ Severity
Performance
  where
    pats :: NonEmpty (NameMeta, PatternType)
    pats :: NonEmpty (NameMeta, PatternType)
pats = (NameMeta
sizeNameMeta, PatternType
forall a. PatternBool a => a
(?))
        (NameMeta, PatternType)
-> [(NameMeta, PatternType)] -> NonEmpty (NameMeta, PatternType)
forall a. a -> [a] -> NonEmpty a
:| [(Text -> NameMeta
mkBaseFoldableMeta "length", PatternType
hsPat)]

    sizeNameMeta :: NameMeta
    sizeNameMeta :: NameMeta
sizeNameMeta = "size" Text -> ModuleName -> NameMeta
`unorderedNameFrom` "Data.HashSet.Base"

    hs :: NameMeta
    hs :: NameMeta
hs = "HashSet" Text -> ModuleName -> NameMeta
`unorderedNameFrom` "Data.HashSet.Base"

    hsPat :: PatternType
    hsPat :: PatternType
hsPat = (NameMeta
hs NameMeta -> [PatternType] -> PatternType
|:: [PatternType
forall a. PatternBool a => a
(?)]) PatternType -> PatternType -> PatternType
|-> PatternType
forall a. PatternBool a => a
(?)

-- | 'Inspection' — missing strictness declaration @STAN-0206@.
stan0206 :: Inspection
stan0206 :: Inspection
stan0206 = $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-0206"
    , inspectionName :: Text
inspectionName = "Data types with non-strict fields"
    , inspectionDescription :: Text
inspectionDescription =
        "Defining lazy fields in data types can lead to unexpected space leaks"
    , inspectionSolution :: [Text]
inspectionSolution =
        [ "Add '!' before the type, e.g. !Int or !(Maybe Bool)"
        , "Enable the 'StrictData' extension: {-# LANGUAGE StrictData #-}"
        ]
    , inspectionCategory :: NonEmpty Category
inspectionCategory = Category
Category.spaceLeak Category -> [Category] -> NonEmpty Category
forall a. a -> [a] -> NonEmpty a
:| [Category
Category.syntax]
    , inspectionSeverity :: Severity
inspectionSeverity = Severity
Performance
    , inspectionAnalysis :: InspectionAnalysis
inspectionAnalysis = InspectionAnalysis
LazyField
    }

-- | 'Inspection' — 'Foldable' methods on possibly error-prone structures @STAN-0207@.
stan0207 :: Inspection
stan0207 :: Inspection
stan0207 = Id Inspection -> Text -> InspectionAnalysis -> Inspection
mkAntiPatternInspection
    (Text -> Id Inspection
forall a. Text -> Id a
Id "STAN-0207")
    "Foldable methods on possibly error-prone structures"
    (PatternAst -> InspectionAnalysis
FindAst (PatternAst -> InspectionAnalysis)
-> PatternAst -> InspectionAnalysis
forall a b. (a -> b) -> a -> b
$ NonEmpty (NameMeta, PatternType) -> PatternAst
namesToPatternAst NonEmpty (NameMeta, PatternType)
allPatterns)
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& Lens' Inspection Text
descriptionL Lens' Inspection Text -> Text -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~ "Usage of Foldable methods on (,), Maybe, Either"
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& Lens' Inspection [Text]
solutionL Lens' Inspection [Text] -> [Text] -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~
        [ "Use more explicit functions with specific monomorphic types"
        ]
  where
    allPatterns :: NonEmpty (NameMeta, PatternType)
    allPatterns :: NonEmpty (NameMeta, PatternType)
allPatterns = do  -- Monad for NonEmpty
        PatternType
t <- NonEmpty PatternType
foldableTypesPatterns
        (method :: NameMeta
method, mkType :: PatternType -> PatternType
mkType) <- NonEmpty (NameMeta, PatternType -> PatternType)
foldableMethodsPatterns
        (NameMeta, PatternType) -> NonEmpty (NameMeta, PatternType)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NameMeta
method, PatternType -> PatternType
mkType PatternType
t)

-- | 'Inspection' — slow 'length' for 'Data.Text' @STAN-0208@.
stan0208 :: Inspection
stan0208 :: Inspection
stan0208 = Id Inspection -> Text -> InspectionAnalysis -> Inspection
mkAntiPatternInspection (Text -> Id Inspection
forall a. Text -> Id a
Id "STAN-0208") "Slow 'length' for Text"
           (PatternAst -> InspectionAnalysis
FindAst (PatternAst -> InspectionAnalysis)
-> PatternAst -> InspectionAnalysis
forall a b. (a -> b) -> a -> b
$ NameMeta -> PatternType -> PatternAst
PatternAstName NameMeta
lenNameMeta (PatternType
textPattern PatternType -> PatternType -> PatternType
|-> PatternType
forall a. PatternBool a => a
(?)))
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& Lens' Inspection Text
descriptionL Lens' Inspection Text -> Text -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~ "Usage of 'length' for 'Text' that runs in linear time"
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& Lens' Inspection [Text]
solutionL Lens' Inspection [Text] -> [Text] -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~
        [ "{Extra dependency} Switch to 'ByteString' from 'bytestring'"
        ]
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& Lens' Inspection Severity
severityL Lens' Inspection Severity -> Severity -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~ Severity
Performance
  where
    lenNameMeta :: NameMeta
    lenNameMeta :: NameMeta
lenNameMeta = "length" Text -> ModuleName -> NameMeta
`textNameFrom` "Data.Text"

-- | 'Inspection' — slow 'nub' for lists @STAN-0209@.
stan0209 :: Inspection
stan0209 :: Inspection
stan0209 = Id Inspection -> Text -> InspectionAnalysis -> Inspection
mkAntiPatternInspection (Text -> Id Inspection
forall a. Text -> Id a
Id "STAN-0209") "Slow 'nub' for lists"
           (PatternAst -> InspectionAnalysis
FindAst (PatternAst -> InspectionAnalysis)
-> PatternAst -> InspectionAnalysis
forall a b. (a -> b) -> a -> b
$ NameMeta -> PatternType -> PatternAst
PatternAstName (Text -> NameMeta
mkBaseOldListMeta "nub") (PatternType -> PatternAst) -> PatternType -> PatternAst
forall a b. (a -> b) -> a -> b
$ PatternType
listPattern PatternType -> PatternType -> PatternType
|-> PatternType
listPattern)
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& Lens' Inspection Text
descriptionL Lens' Inspection Text -> Text -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~ "Usage of 'nub' on lists that runs in quadratic time"
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& Lens' Inspection [Text]
solutionL Lens' Inspection [Text] -> [Text] -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~
        [ "{Extra dependency} Switch list to 'Set' from 'containers'"
        , "{Extra dependency} Use 'ordNub/hashNub/sortNub/unstableNub' from 'relude'"
        , "{Extra dependency} Use 'nubOrd' from 'containers'"
        , "{Extra dependency} Use 'nubOrd' from 'extra'"
        ]
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& Lens' Inspection Severity
severityL Lens' Inspection Severity -> Severity -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~ Severity
Performance

-- | 'Inspection' — slow 'for_' and 'forM_' for ranges @STAN-0210@.
stan0210 :: Inspection
stan0210 :: Inspection
stan0210 = Id Inspection -> Text -> InspectionAnalysis -> Inspection
mkAntiPatternInspection (Text -> Id Inspection
forall a. Text -> Id a
Id "STAN-0210") "Slow 'for_' on ranges" (PatternAst -> InspectionAnalysis
FindAst PatternAst
pat)
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& Lens' Inspection Text
descriptionL Lens' Inspection Text -> Text -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~ "Usage of 'for_' or 'forM_' on numerical ranges is slow"
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& Lens' Inspection [Text]
solutionL Lens' Inspection [Text] -> [Text] -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~
        [ "{Extra dependency} Use 'loop' library for fast monadic looping"
        ]
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& Lens' Inspection Severity
severityL Lens' Inspection Severity -> Severity -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~ Severity
Performance
  where
    pat :: PatternAst
    pat :: PatternAst
pat = PatternAst -> PatternAst -> PatternAst
app PatternAst
forPattern (PatternAst -> PatternAst -> PatternAst
range PatternAst
forall a. PatternBool a => a
(?) PatternAst
forall a. PatternBool a => a
(?))

    forPattern :: PatternAst
    forPattern :: PatternAst
forPattern = PatternAst -> PatternAst -> PatternAst
PatternAstOr
        (NameMeta -> PatternType -> PatternAst
PatternAstName (Text -> NameMeta
mkBaseFoldableMeta "for_") PatternType
forType)
        (NameMeta -> PatternType -> PatternAst
PatternAstName (Text -> NameMeta
mkBaseFoldableMeta "forM_") PatternType
forType)

    forType :: PatternType
    forType :: PatternType
forType = PatternType
listPattern PatternType -> PatternType -> PatternType
|-> (PatternType
forall a. PatternBool a => a
(?) PatternType -> PatternType -> PatternType
|-> PatternType
forall a. PatternBool a => a
(?)) PatternType -> PatternType -> PatternType
|-> PatternType
forall a. PatternBool a => a
(?)

-- | 'Inspection' — @</>@ on URLs @STAN-0211@.
stan0211 :: Inspection
stan0211 :: Inspection
stan0211 = Id Inspection -> Text -> InspectionAnalysis -> Inspection
mkAntiPatternInspection (Text -> Id Inspection
forall a. Text -> Id a
Id "STAN-0211") "'</>' for URLs" (PatternAst -> InspectionAnalysis
FindAst PatternAst
pat)
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& Lens' Inspection Text
descriptionL Lens' Inspection Text -> Text -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~ "Usage of '</>' for URLs results in the errors on Windows"
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& Lens' Inspection [Text]
solutionL Lens' Inspection [Text] -> [Text] -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~
        [ "{Extra dependency} Use type-safe library for URLs"
        , "Concatenate URLs with slashes '/'"
        ]
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& Lens' Inspection Severity
severityL Lens' Inspection Severity -> Severity -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~ Severity
Error
  where
    pat :: PatternAst
    pat :: PatternAst
pat =   PatternAst -> PatternAst -> PatternAst -> PatternAst
opApp (PatternAst
httpLit PatternAst -> PatternAst -> PatternAst
forall a. PatternBool a => a -> a -> a
||| PatternAst
urlName) PatternAst
filepathOperator PatternAst
forall a. PatternBool a => a
(?)
        PatternAst -> PatternAst -> PatternAst
forall a. PatternBool a => a -> a -> a
||| PatternAst -> PatternAst -> PatternAst -> PatternAst
opApp PatternAst
forall a. PatternBool a => a
(?) PatternAst
filepathOperator PatternAst
urlName

    httpLit :: PatternAst
    httpLit :: PatternAst
httpLit = ByteString -> PatternAst
startWith "\"http:"
        PatternAst -> PatternAst -> PatternAst
forall a. PatternBool a => a -> a -> a
||| ByteString -> PatternAst
startWith "\"https:"
        PatternAst -> PatternAst -> PatternAst
forall a. PatternBool a => a -> a -> a
||| ByteString -> PatternAst
startWith "\"ftp:"
        PatternAst -> PatternAst -> PatternAst
forall a. PatternBool a => a -> a -> a
||| ByteString -> PatternAst
startWith "\"mailto:"
        PatternAst -> PatternAst -> PatternAst
forall a. PatternBool a => a -> a -> a
||| ByteString -> PatternAst
startWith "\"file:"
        PatternAst -> PatternAst -> PatternAst
forall a. PatternBool a => a -> a -> a
||| ByteString -> PatternAst
startWith "\"data:"
        PatternAst -> PatternAst -> PatternAst
forall a. PatternBool a => a -> a -> a
||| ByteString -> PatternAst
startWith "\"irc:"
      where
        startWith :: ByteString -> PatternAst
        startWith :: ByteString -> PatternAst
startWith = Literal -> PatternAst
PatternAstConstant (Literal -> PatternAst)
-> (ByteString -> Literal) -> ByteString -> PatternAst
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Literal
PrefixStr

    urlName :: PatternAst
    urlName :: PatternAst
urlName = String -> PatternAst
PatternAstVarName "url"

filepathOperator :: PatternAst
filepathOperator :: PatternAst
filepathOperator = NameMeta -> PatternType -> PatternAst
PatternAstName NameMeta
operatorPosix PatternType
fun
    PatternAst -> PatternAst -> PatternAst
forall a. PatternBool a => a -> a -> a
||| NameMeta -> PatternType -> PatternAst
PatternAstName NameMeta
operatorWindows PatternType
fun
  where
    operatorPosix :: NameMeta
    operatorPosix :: NameMeta
operatorPosix =  $WNameMeta :: Text -> ModuleName -> Text -> NameMeta
NameMeta
        { nameMetaName :: Text
nameMetaName       = "</>"
        , nameMetaModuleName :: ModuleName
nameMetaModuleName = "System.FilePath.Posix"
        , nameMetaPackage :: Text
nameMetaPackage    = "filepath"
        }

    operatorWindows :: NameMeta
    operatorWindows :: NameMeta
operatorWindows =  $WNameMeta :: Text -> ModuleName -> Text -> NameMeta
NameMeta
        { nameMetaName :: Text
nameMetaName       = "</>"
        , nameMetaModuleName :: ModuleName
nameMetaModuleName = "System.FilePath.Windows"
        , nameMetaPackage :: Text
nameMetaPackage    = "filepath"
        }

    fun :: PatternType
    fun :: PatternType
fun = PatternType
forall a. PatternBool a => a
(?) PatternType -> PatternType -> PatternType
|-> PatternType
filePathType PatternType -> PatternType -> PatternType
|-> PatternType
forall a. PatternBool a => a
(?)

    {- TODO: Note, that at the moment hie somehow thinks that '</>' works with
    'String's even when I specify type of vars to 'FilePath' explicitly.
    This is odd and needs more investigation.
    -}
    filePathType :: PatternType
    filePathType :: PatternType
filePathType = "FilePath" Text -> ModuleName -> NameMeta
`baseNameFrom` "GHC.IO" NameMeta -> [PatternType] -> PatternType
|:: []
        PatternType -> PatternType -> PatternType
forall a. PatternBool a => a -> a -> a
||| PatternType
stringPattern
        PatternType -> PatternType -> PatternType
forall a. PatternBool a => a -> a -> a
||| Text -> NameMeta
primTypeMeta "[]" NameMeta -> [PatternType] -> PatternType
|:: [ PatternType
charPattern ]

-- | 'Inspection' — usage of @unsafe*@ functions @STAN-0212@.
stan0212 :: Inspection
stan0212 :: Inspection
stan0212 = Id Inspection -> Text -> InspectionAnalysis -> Inspection
mkAntiPatternInspection (Text -> Id Inspection
forall a. Text -> Id a
Id "STAN-0212") "unsafe functions" (PatternAst -> InspectionAnalysis
FindAst PatternAst
pat)
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& Lens' Inspection Text
descriptionL Lens' Inspection Text -> Text -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~ "Usage of unsafe functions breaks referential transparency"
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& Lens' Inspection [Text]
solutionL Lens' Inspection [Text] -> [Text] -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~
        [ "Remove 'undefined' or at least replace with 'error' to give better error messages"
        , "Replace 'unsafeCoerce' with 'coerce'"
        , "Rewrite the code to avoid using 'unsafePerformIO' and other unsafe IO functions"
        ]
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& Lens' Inspection Severity
severityL Lens' Inspection Severity -> Severity -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~ Severity
Error
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& Lens' Inspection (NonEmpty Category)
categoryL Lens' Inspection (NonEmpty Category)
-> (NonEmpty Category -> NonEmpty Category)
-> Inspection
-> Inspection
forall s a. Lens' s a -> (a -> a) -> s -> s
%~ (Category
Category.unsafe Category -> NonEmpty Category -> NonEmpty Category
forall a. a -> NonEmpty a -> NonEmpty a
`NE.cons`)
  where
    pat :: PatternAst
    pat :: PatternAst
pat = NonEmpty NameMeta -> PatternAst
anyNamesToPatternAst
        (NonEmpty NameMeta -> PatternAst)
-> NonEmpty NameMeta -> PatternAst
forall a b. (a -> b) -> a -> b
$ "undefined" Text -> ModuleName -> NameMeta
`baseNameFrom` "GHC.Err" NameMeta -> [NameMeta] -> NonEmpty NameMeta
forall a. a -> [a] -> NonEmpty a
:|
        [ "unsafeCoerce" Text -> ModuleName -> NameMeta
`baseNameFrom` "Unsafe.Coerce"
        , "unsafePerformIO" Text -> ModuleName -> NameMeta
`baseNameFrom` "GHC.IO.Unsafe"
        , "unsafeInterleaveIO" Text -> ModuleName -> NameMeta
`baseNameFrom` "GHC.IO.Unsafe"
        , "unsafeDupablePerformIO" Text -> ModuleName -> NameMeta
`baseNameFrom` "GHC.IO.Unsafe"
        , "unsafeFixIO" Text -> ModuleName -> NameMeta
`baseNameFrom` "System.IO.Unsafe"
        ]

-- | 'Inspection' — Pattent matching on @_@ for sum types — @STAN-0213@.
stan0213 :: Inspection
stan0213 :: Inspection
stan0213 = Id Inspection -> Text -> InspectionAnalysis -> Inspection
mkAntiPatternInspection (Text -> Id Inspection
forall a. Text -> Id a
Id "STAN-0213") "Pattern matching on '_'" InspectionAnalysis
PatternMatchOn_
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& Lens' Inspection Text
descriptionL Lens' Inspection Text -> Text -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~ "Pattern matching on '_' for sum types can create maintainability issues"
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& Lens' Inspection [Text]
solutionL Lens' Inspection [Text] -> [Text] -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~
        [ "Pattern match on each constructor explicitly"
        , "Add meaningful names to holes, e.g. '_anyOtherFailure'"
        ]
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& Lens' Inspection Severity
severityL Lens' Inspection Severity -> Severity -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~ Severity
Warning

-- | 'Inspection' — use 'compare' @STAN-0214@.
stan0214 :: Inspection
stan0214 :: Inspection
stan0214 = Id Inspection -> Text -> InspectionAnalysis -> Inspection
mkAntiPatternInspection (Text -> Id Inspection
forall a. Text -> Id a
Id "STAN-0214") "use 'compare'" InspectionAnalysis
UseCompare
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& Lens' Inspection Text
descriptionL Lens' Inspection Text -> Text -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~ "Usage of multiple comparison operators instead of single 'compare'"
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& Lens' Inspection [Text]
solutionL Lens' Inspection [Text] -> [Text] -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~
        [ "Rewrite code to use single 'compare' instead of many comparison operators"
        ]
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& Lens' Inspection Severity
severityL Lens' Inspection Severity -> Severity -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~ Severity
Performance

-- | 'Inspection' — Slashes in paths @STAN-0215@.
stan0215 :: Inspection
stan0215 :: Inspection
stan0215 = Id Inspection -> Text -> InspectionAnalysis -> Inspection
mkAntiPatternInspection (Text -> Id Inspection
forall a. Text -> Id a
Id "STAN-0215") "Slashes in paths" (PatternAst -> InspectionAnalysis
FindAst PatternAst
pat)
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& Lens' Inspection Text
descriptionL Lens' Inspection Text -> Text -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~ "Usage of '/' or '\\' in paths results in the errors on different operation systems"
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& Lens' Inspection [Text]
solutionL Lens' Inspection [Text] -> [Text] -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~
        [ "{Extra dependency} Use '</>' operator from 'filepath'"
        ]
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& Lens' Inspection Severity
severityL Lens' Inspection Severity -> Severity -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~ Severity
Error
  where
    pat :: PatternAst
    pat :: PatternAst
pat =   PatternAst -> PatternAst -> PatternAst -> PatternAst
opApp PatternAst
pathLit PatternAst
filepathOperator PatternAst
forall a. PatternBool a => a
(?)
        PatternAst -> PatternAst -> PatternAst
forall a. PatternBool a => a -> a -> a
||| PatternAst -> PatternAst -> PatternAst -> PatternAst
opApp PatternAst
forall a. PatternBool a => a
(?) PatternAst
filepathOperator PatternAst
pathLit

    pathLit :: PatternAst
    pathLit :: PatternAst
pathLit = Literal -> PatternAst
PatternAstConstant (ByteString -> Literal
ContainStr "/")
        PatternAst -> PatternAst -> PatternAst
forall a. PatternBool a => a -> a -> a
||| Literal -> PatternAst
PatternAstConstant (ByteString -> Literal
ContainStr "\\\\")