{-# LANGUAGE CPP #-}

{- |
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, _nameFrom)
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 Id Inspection
insId Text
name InspectionAnalysis
inspectionAnalysis = Inspection
    { inspectionId :: Id Inspection
inspectionId = Id Inspection
insId
    , inspectionName :: Text
inspectionName = Text
"Anti-pattern: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name
    , inspectionDescription :: Text
inspectionDescription = Text
""
    , 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
    , InspectionAnalysis
inspectionAnalysis :: InspectionAnalysis
inspectionAnalysis :: InspectionAnalysis
..
    }

-- | '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 Text
"STAN-0201") Text
"[0 .. length xs]" (PatternAst -> InspectionAnalysis
FindAst PatternAst
lenPatAst)
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& (Text -> f Text) -> Inspection -> f Inspection
Lens' Inspection Text
descriptionL Lens' Inspection Text -> Text -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~ Text
"Creating a list with wrong number of indices"
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& ([Text] -> f [Text]) -> Inspection -> f Inspection
Lens' Inspection [Text]
solutionL Lens' Inspection [Text] -> [Text] -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~
        [ Text
"Replace '[0 .. length xs]' with '[0 .. length xs - 1]'"
        , Text
"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 Int
0)
        (PatternAst -> PatternAst -> PatternAst
app
            (NameMeta -> PatternType -> PatternAst
PatternAstName (Text -> NameMeta
mkBaseFoldableMeta Text
"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 Text
"STAN-0202") Text
"foldl"
    (PatternAst -> InspectionAnalysis
FindAst (PatternAst -> InspectionAnalysis)
-> PatternAst -> InspectionAnalysis
forall a b. (a -> b) -> a -> b
$ NameMeta -> PatternType -> PatternAst
PatternAstName (Text -> NameMeta
mkBaseFoldableMeta Text
"foldl") PatternType
forall a. PatternBool a => a
(?))
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& (Text -> f Text) -> Inspection -> f Inspection
Lens' Inspection Text
descriptionL Lens' Inspection Text -> Text -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~ Text
"Usage of space-leaking function 'foldl'"
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& ([Text] -> f [Text]) -> Inspection -> f Inspection
Lens' Inspection [Text]
solutionL Lens' Inspection [Text] -> [Text] -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~
        [ Text
"Replace 'foldl' with 'foldl''"
        , Text
"Use 'foldr (flip . f)` instead of 'foldl f'"
        ]
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& (Severity -> f Severity) -> Inspection -> f Inspection
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
& (NonEmpty Category -> f (NonEmpty Category))
-> Inspection -> f Inspection
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 Text
"STAN-0203") Text
"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
& (Text -> f Text) -> Inspection -> f Inspection
Lens' Inspection Text
descriptionL Lens' Inspection Text -> Text -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~ Text
"Usage of 'pack' function that doesn't handle Unicode characters"
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& ([Text] -> f [Text]) -> Inspection -> f Inspection
Lens' Inspection [Text]
solutionL Lens' Inspection [Text] -> [Text] -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~
        [ Text
"Convert to 'Text' and use 'encodeUtf8' from 'Data.Text.Encoding'"
        , Text
"{Extra dependency} Use 'encodeUtf8' from 'relude'"
        , Text
"{Extra dependency} Use the 'utf8-string' package"
        ]
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& (Severity -> f Severity) -> Inspection -> f Inspection
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 = NameMeta
        { nameMetaPackage :: Text
nameMetaPackage    = Text
"bytestring"
        , nameMetaModuleName :: ModuleName
nameMetaModuleName = ModuleName
"Data.ByteString.Char8"
        , nameMetaName :: Text
nameMetaName       = Text
"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 Text
"STAN-0204") Text
"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
& (Text -> f Text) -> Inspection -> f Inspection
Lens' Inspection Text
descriptionL Lens' Inspection Text -> Text -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~ Text
"Usage of 'size' or 'length' for 'HashMap' that runs in linear time"
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& ([Text] -> f [Text]) -> Inspection -> f Inspection
Lens' Inspection [Text]
solutionL Lens' Inspection [Text] -> [Text] -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~
        [ Text
"{Extra dependency} Switch to 'Map' from 'containers'"
        ]
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& (Severity -> f Severity) -> Inspection -> f Inspection
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 Text
"length", PatternType
hmPat)]

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

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

    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.HashSet.size' @STAN-0205@.
stan0205 :: Inspection
stan0205 :: Inspection
stan0205 = Id Inspection -> Text -> InspectionAnalysis -> Inspection
mkAntiPatternInspection (Text -> Id Inspection
forall a. Text -> Id a
Id Text
"STAN-0205") Text
"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
& (Text -> f Text) -> Inspection -> f Inspection
Lens' Inspection Text
descriptionL Lens' Inspection Text -> Text -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~ Text
"Usage of 'size' or 'length' for 'HashSet' that runs in linear time"
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& ([Text] -> f [Text]) -> Inspection -> f Inspection
Lens' Inspection [Text]
solutionL Lens' Inspection [Text] -> [Text] -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~
        [ Text
"{Extra dependency} Switch to 'Set' from 'containers'"
        ]
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& (Severity -> f Severity) -> Inspection -> f Inspection
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 Text
"length", PatternType
hsPat)]

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

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

    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 = Inspection
    { inspectionId :: Id Inspection
inspectionId = Text -> Id Inspection
forall a. Text -> Id a
Id Text
"STAN-0206"
    , inspectionName :: Text
inspectionName = Text
"Data types with non-strict fields"
    , inspectionDescription :: Text
inspectionDescription =
        Text
"Defining lazy fields in data types can lead to unexpected space leaks"
    , inspectionSolution :: [Text]
inspectionSolution =
        [ Text
"Add '!' before the type, e.g. !Int or !(Maybe Bool)"
        , Text
"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 Text
"STAN-0207")
    Text
"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
& (Text -> f Text) -> Inspection -> f Inspection
Lens' Inspection Text
descriptionL Lens' Inspection Text -> Text -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~ Text
"Usage of Foldable methods on (,), Maybe, Either"
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& ([Text] -> f [Text]) -> Inspection -> f Inspection
Lens' Inspection [Text]
solutionL Lens' Inspection [Text] -> [Text] -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~
        [ Text
"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
        (NameMeta
method, PatternType -> PatternType
mkType) <- NonEmpty (NameMeta, PatternType -> PatternType)
foldableMethodsPatterns
        (NameMeta, PatternType) -> NonEmpty (NameMeta, PatternType)
forall a. a -> NonEmpty a
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 Text
"STAN-0208") Text
"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
& (Text -> f Text) -> Inspection -> f Inspection
Lens' Inspection Text
descriptionL Lens' Inspection Text -> Text -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~ Text
"Usage of 'length' for 'Text' that runs in linear time"
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& ([Text] -> f [Text]) -> Inspection -> f Inspection
Lens' Inspection [Text]
solutionL Lens' Inspection [Text] -> [Text] -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~
        [ Text
"{Extra dependency} Switch to 'ByteString' from 'bytestring'"
        ]
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& (Severity -> f Severity) -> Inspection -> f Inspection
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 = Text
"length" Text -> ModuleName -> NameMeta
`textNameFrom` ModuleName
"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 Text
"STAN-0209") Text
"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 Text
"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
& (Text -> f Text) -> Inspection -> f Inspection
Lens' Inspection Text
descriptionL Lens' Inspection Text -> Text -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~ Text
"Usage of 'nub' on lists that runs in quadratic time"
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& ([Text] -> f [Text]) -> Inspection -> f Inspection
Lens' Inspection [Text]
solutionL Lens' Inspection [Text] -> [Text] -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~
        [ Text
"{Extra dependency} Switch list to 'Set' from 'containers'"
        , Text
"{Extra dependency} Use 'ordNub/hashNub/sortNub/unstableNub' from 'relude'"
        , Text
"{Extra dependency} Use 'nubOrd' from 'containers'"
        , Text
"{Extra dependency} Use 'nubOrd' from 'extra'"
        ]
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& (Severity -> f Severity) -> Inspection -> f Inspection
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 Text
"STAN-0210") Text
"Slow 'for_' on ranges" (PatternAst -> InspectionAnalysis
FindAst PatternAst
pat)
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& (Text -> f Text) -> Inspection -> f Inspection
Lens' Inspection Text
descriptionL Lens' Inspection Text -> Text -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~ Text
"Usage of 'for_' or 'forM_' on numerical ranges is slow"
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& ([Text] -> f [Text]) -> Inspection -> f Inspection
Lens' Inspection [Text]
solutionL Lens' Inspection [Text] -> [Text] -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~
        [ Text
"{Extra dependency} Use 'loop' library for fast monadic looping"
        ]
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& (Severity -> f Severity) -> Inspection -> f Inspection
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 Text
"for_") PatternType
forType)
        (NameMeta -> PatternType -> PatternAst
PatternAstName (Text -> NameMeta
mkBaseFoldableMeta Text
"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 Text
"STAN-0211") Text
"'</>' for URLs" (PatternAst -> InspectionAnalysis
FindAst PatternAst
pat)
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& (Text -> f Text) -> Inspection -> f Inspection
Lens' Inspection Text
descriptionL Lens' Inspection Text -> Text -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~ Text
"Usage of '</>' for URLs results in the errors on Windows"
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& ([Text] -> f [Text]) -> Inspection -> f Inspection
Lens' Inspection [Text]
solutionL Lens' Inspection [Text] -> [Text] -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~
        [ Text
"{Extra dependency} Use type-safe library for URLs"
        , Text
"Concatenate URLs with slashes '/'"
        ]
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& (Severity -> f Severity) -> Inspection -> f Inspection
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 ByteString
"\"http:"
        PatternAst -> PatternAst -> PatternAst
forall a. PatternBool a => a -> a -> a
||| ByteString -> PatternAst
startWith ByteString
"\"https:"
        PatternAst -> PatternAst -> PatternAst
forall a. PatternBool a => a -> a -> a
||| ByteString -> PatternAst
startWith ByteString
"\"ftp:"
        PatternAst -> PatternAst -> PatternAst
forall a. PatternBool a => a -> a -> a
||| ByteString -> PatternAst
startWith ByteString
"\"mailto:"
        PatternAst -> PatternAst -> PatternAst
forall a. PatternBool a => a -> a -> a
||| ByteString -> PatternAst
startWith ByteString
"\"file:"
        PatternAst -> PatternAst -> PatternAst
forall a. PatternBool a => a -> a -> a
||| ByteString -> PatternAst
startWith ByteString
"\"data:"
        PatternAst -> PatternAst -> PatternAst
forall a. PatternBool a => a -> a -> a
||| ByteString -> PatternAst
startWith ByteString
"\"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 String
"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 =  NameMeta
        { nameMetaName :: Text
nameMetaName       = Text
"</>"
        , nameMetaModuleName :: ModuleName
nameMetaModuleName = ModuleName
"System.FilePath.Posix"
        , nameMetaPackage :: Text
nameMetaPackage    = Text
"filepath"
        }

    operatorWindows :: NameMeta
    operatorWindows :: NameMeta
operatorWindows =  NameMeta
        { nameMetaName :: Text
nameMetaName       = Text
"</>"
        , nameMetaModuleName :: ModuleName
nameMetaModuleName = ModuleName
"System.FilePath.Windows"
        , nameMetaPackage :: Text
nameMetaPackage    = Text
"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 =
#if __GLASGOW_HASKELL__ < 910
        Text
"FilePath" Text -> ModuleName -> NameMeta
`_nameFrom` ModuleName
"GHC.IO"
#else
        "FilePath" `_nameFrom` "GHC.Internal.IO"
#endif
        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 Text
"[]" 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 Text
"STAN-0212") Text
"unsafe functions" (PatternAst -> InspectionAnalysis
FindAst PatternAst
pat)
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& (Text -> f Text) -> Inspection -> f Inspection
Lens' Inspection Text
descriptionL Lens' Inspection Text -> Text -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~ Text
"Usage of unsafe functions breaks referential transparency"
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& ([Text] -> f [Text]) -> Inspection -> f Inspection
Lens' Inspection [Text]
solutionL Lens' Inspection [Text] -> [Text] -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~
        [ Text
"Remove 'undefined' or at least replace with 'error' to give better error messages"
        , Text
"Replace 'unsafeCoerce' with 'coerce'"
        , Text
"Rewrite the code to avoid using 'unsafePerformIO' and other unsafe IO functions"
        ]
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& (Severity -> f Severity) -> Inspection -> f Inspection
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
& (NonEmpty Category -> f (NonEmpty Category))
-> Inspection -> f Inspection
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
#if __GLASGOW_HASKELL__ < 910
        (NonEmpty NameMeta -> PatternAst)
-> NonEmpty NameMeta -> PatternAst
forall a b. (a -> b) -> a -> b
$ Text
"undefined" Text -> ModuleName -> NameMeta
`_nameFrom` ModuleName
"GHC.Err" NameMeta -> [NameMeta] -> NonEmpty NameMeta
forall a. a -> [a] -> NonEmpty a
:|
        [ Text
"unsafeCoerce" Text -> ModuleName -> NameMeta
`_nameFrom` ModuleName
"Unsafe.Coerce"
        , Text
"unsafePerformIO" Text -> ModuleName -> NameMeta
`_nameFrom` ModuleName
"GHC.IO.Unsafe"
        , Text
"unsafeInterleaveIO" Text -> ModuleName -> NameMeta
`_nameFrom` ModuleName
"GHC.IO.Unsafe"
        , Text
"unsafeDupablePerformIO" Text -> ModuleName -> NameMeta
`_nameFrom` ModuleName
"GHC.IO.Unsafe"
#else
        $ "undefined" `_nameFrom` "GHC.Internal.Err" :|
        [ "unsafeCoerce" `_nameFrom` "GHC.Internal.Unsafe.Coerce"
        , "unsafePerformIO" `_nameFrom` "GHC.Internal.IO.Unsafe"
        , "unsafeInterleaveIO" `_nameFrom` "GHC.Internal.IO.Unsafe"
        , "unsafeDupablePerformIO" `_nameFrom` "GHC.Internal.IO.Unsafe"
#endif
        , Text
"unsafeFixIO" Text -> ModuleName -> NameMeta
`baseNameFrom` ModuleName
"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 Text
"STAN-0213") Text
"Pattern matching on '_'" InspectionAnalysis
PatternMatchOn_
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& (Text -> f Text) -> Inspection -> f Inspection
Lens' Inspection Text
descriptionL Lens' Inspection Text -> Text -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~ Text
"Pattern matching on '_' for sum types can create maintainability issues"
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& ([Text] -> f [Text]) -> Inspection -> f Inspection
Lens' Inspection [Text]
solutionL Lens' Inspection [Text] -> [Text] -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~
        [ Text
"Pattern match on each constructor explicitly"
        , Text
"Add meaningful names to holes, e.g. '_anyOtherFailure'"
        ]
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& (Severity -> f Severity) -> Inspection -> f Inspection
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 Text
"STAN-0214") Text
"use 'compare'" InspectionAnalysis
UseCompare
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& (Text -> f Text) -> Inspection -> f Inspection
Lens' Inspection Text
descriptionL Lens' Inspection Text -> Text -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~ Text
"Usage of multiple comparison operators instead of single 'compare'"
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& ([Text] -> f [Text]) -> Inspection -> f Inspection
Lens' Inspection [Text]
solutionL Lens' Inspection [Text] -> [Text] -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~
        [ Text
"Rewrite code to use single 'compare' instead of many comparison operators"
        ]
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& (Severity -> f Severity) -> Inspection -> f Inspection
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 Text
"STAN-0215") Text
"Slashes in paths" (PatternAst -> InspectionAnalysis
FindAst PatternAst
pat)
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& (Text -> f Text) -> Inspection -> f Inspection
Lens' Inspection Text
descriptionL Lens' Inspection Text -> Text -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~ Text
"Usage of '/' or '\\' in paths results in the errors on different operation systems"
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& ([Text] -> f [Text]) -> Inspection -> f Inspection
Lens' Inspection [Text]
solutionL Lens' Inspection [Text] -> [Text] -> Inspection -> Inspection
forall s a. Lens' s a -> a -> s -> s
.~
        [ Text
"{Extra dependency} Use '</>' operator from 'filepath'"
        ]
    Inspection -> (Inspection -> Inspection) -> Inspection
forall a b. a -> (a -> b) -> b
& (Severity -> f Severity) -> Inspection -> f Inspection
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 ByteString
"/")
        PatternAst -> PatternAst -> PatternAst
forall a. PatternBool a => a -> a -> a
||| Literal -> PatternAst
PatternAstConstant (ByteString -> Literal
ContainStr ByteString
"\\\\")