{-# LANGUAGE ApplicativeDo        #-}
{-# LANGUAGE DataKinds            #-}
{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE OverloadedLabels     #-}
{-# LANGUAGE TypeOperators        #-}
{-# LANGUAGE UndecidableInstances #-}

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

@stan@ runtime configuration that allows customizing the set of
inspections to check the code against.
-}

module Stan.Config
    ( -- * Data types
      ConfigP (..)
    , Config
    , PartialConfig
    , Check (..)
    , CheckType (..)
    , CheckFilter (..)
    , Scope (..)

      -- * Default
    , defaultConfig
    , mkDefaultChecks

      -- * Final stage
    , finaliseConfig

      -- * Printing
    , configToCliCommand

      -- * Apply config
      -- $applyConfig
    , applyConfig
    , applyChecks
    , applyChecksFor
    ) where

import Trial ((::-), Phase (..), Trial, withTag)

import Stan.Category (Category (..))
import Stan.Core.Id (Id (..))
import Stan.Inspection (Inspection (..))
import Stan.Inspection.All (inspections, inspectionsIds, lookupInspectionById)
import Stan.Observation (Observation (..))
import Stan.Severity (Severity (..))

import qualified Data.HashMap.Strict as HashMap
import qualified Data.HashSet as HashSet
import qualified Data.Text as T


{- | Main configuration type for the following purposes:

* Filtering inspections (including or ignoring) per scope (file,
  directory, all)
-}
data ConfigP (p :: Phase Text) = ConfigP
    { ConfigP p -> p ::- [Check]
configChecks  :: !(p ::- [Check])
    , ConfigP p -> p ::- [Scope]
configRemoved :: !(p ::- [Scope])
    , ConfigP p -> p ::- [Id Observation]
configIgnored :: !(p ::- [Id Observation])
    -- , configGroupBy :: !GroupBy
    }

deriving stock instance
    ( Show (p ::- [Check])
    , Show (p ::- [Scope])
    , Show (p ::- [Id Observation])
    ) => Show (ConfigP p)

deriving stock instance
    ( Eq (p ::- [Check])
    , Eq (p ::- [Scope])
    , Eq (p ::- [Id Observation])
    ) => Eq (ConfigP p)

type Config = ConfigP 'Final
type PartialConfig = ConfigP 'Partial

instance Semigroup PartialConfig where
    (<>) :: PartialConfig -> PartialConfig -> PartialConfig
    x :: PartialConfig
x <> :: PartialConfig -> PartialConfig -> PartialConfig
<> y :: PartialConfig
y = $WConfigP :: forall (p :: Phase Text).
(p ::- [Check])
-> (p ::- [Scope]) -> (p ::- [Id Observation]) -> ConfigP p
ConfigP
        { configChecks :: 'Partial ::- [Check]
configChecks  = PartialConfig -> 'Partial ::- [Check]
forall (p :: Phase Text). ConfigP p -> p ::- [Check]
configChecks PartialConfig
x TaggedTrial Text [Check]
-> TaggedTrial Text [Check] -> TaggedTrial Text [Check]
forall a. Semigroup a => a -> a -> a
<> PartialConfig -> 'Partial ::- [Check]
forall (p :: Phase Text). ConfigP p -> p ::- [Check]
configChecks PartialConfig
y
        , configRemoved :: 'Partial ::- [Scope]
configRemoved = PartialConfig -> 'Partial ::- [Scope]
forall (p :: Phase Text). ConfigP p -> p ::- [Scope]
configRemoved PartialConfig
x TaggedTrial Text [Scope]
-> TaggedTrial Text [Scope] -> TaggedTrial Text [Scope]
forall a. Semigroup a => a -> a -> a
<> PartialConfig -> 'Partial ::- [Scope]
forall (p :: Phase Text). ConfigP p -> p ::- [Scope]
configRemoved PartialConfig
y
        , configIgnored :: 'Partial ::- [Id Observation]
configIgnored = PartialConfig -> 'Partial ::- [Id Observation]
forall (p :: Phase Text). ConfigP p -> p ::- [Id Observation]
configIgnored PartialConfig
x TaggedTrial Text [Id Observation]
-> TaggedTrial Text [Id Observation]
-> TaggedTrial Text [Id Observation]
forall a. Semigroup a => a -> a -> a
<> PartialConfig -> 'Partial ::- [Id Observation]
forall (p :: Phase Text). ConfigP p -> p ::- [Id Observation]
configIgnored PartialConfig
y
        }

-- | Type of 'Check': 'Include' or 'Exclude' 'Inspection's.
data CheckType
    = Include
    | Exclude
    deriving stock (Int -> CheckType -> ShowS
[CheckType] -> ShowS
CheckType -> String
(Int -> CheckType -> ShowS)
-> (CheckType -> String)
-> ([CheckType] -> ShowS)
-> Show CheckType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CheckType] -> ShowS
$cshowList :: [CheckType] -> ShowS
show :: CheckType -> String
$cshow :: CheckType -> String
showsPrec :: Int -> CheckType -> ShowS
$cshowsPrec :: Int -> CheckType -> ShowS
Show, CheckType -> CheckType -> Bool
(CheckType -> CheckType -> Bool)
-> (CheckType -> CheckType -> Bool) -> Eq CheckType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CheckType -> CheckType -> Bool
$c/= :: CheckType -> CheckType -> Bool
== :: CheckType -> CheckType -> Bool
$c== :: CheckType -> CheckType -> Bool
Eq, Int -> CheckType
CheckType -> Int
CheckType -> [CheckType]
CheckType -> CheckType
CheckType -> CheckType -> [CheckType]
CheckType -> CheckType -> CheckType -> [CheckType]
(CheckType -> CheckType)
-> (CheckType -> CheckType)
-> (Int -> CheckType)
-> (CheckType -> Int)
-> (CheckType -> [CheckType])
-> (CheckType -> CheckType -> [CheckType])
-> (CheckType -> CheckType -> [CheckType])
-> (CheckType -> CheckType -> CheckType -> [CheckType])
-> Enum CheckType
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 :: CheckType -> CheckType -> CheckType -> [CheckType]
$cenumFromThenTo :: CheckType -> CheckType -> CheckType -> [CheckType]
enumFromTo :: CheckType -> CheckType -> [CheckType]
$cenumFromTo :: CheckType -> CheckType -> [CheckType]
enumFromThen :: CheckType -> CheckType -> [CheckType]
$cenumFromThen :: CheckType -> CheckType -> [CheckType]
enumFrom :: CheckType -> [CheckType]
$cenumFrom :: CheckType -> [CheckType]
fromEnum :: CheckType -> Int
$cfromEnum :: CheckType -> Int
toEnum :: Int -> CheckType
$ctoEnum :: Int -> CheckType
pred :: CheckType -> CheckType
$cpred :: CheckType -> CheckType
succ :: CheckType -> CheckType
$csucc :: CheckType -> CheckType
Enum, CheckType
CheckType -> CheckType -> Bounded CheckType
forall a. a -> a -> Bounded a
maxBound :: CheckType
$cmaxBound :: CheckType
minBound :: CheckType
$cminBound :: CheckType
Bounded)

-- | Rule to control the set of inspections per scope.
data Check = Check
    { Check -> CheckType
checkType   :: !CheckType
    , Check -> CheckFilter
checkFilter :: !CheckFilter
    , Check -> Scope
checkScope  :: !Scope
    } deriving stock (Int -> Check -> ShowS
[Check] -> ShowS
Check -> String
(Int -> Check -> ShowS)
-> (Check -> String) -> ([Check] -> ShowS) -> Show Check
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Check] -> ShowS
$cshowList :: [Check] -> ShowS
show :: Check -> String
$cshow :: Check -> String
showsPrec :: Int -> Check -> ShowS
$cshowsPrec :: Int -> Check -> ShowS
Show, Check -> Check -> Bool
(Check -> Check -> Bool) -> (Check -> Check -> Bool) -> Eq Check
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Check -> Check -> Bool
$c/= :: Check -> Check -> Bool
== :: Check -> Check -> Bool
$c== :: Check -> Check -> Bool
Eq)

-- | Criterion for inspections filtering.
data CheckFilter
    = CheckInspection !(Id Inspection)
    | CheckSeverity !Severity
    | CheckCategory !Category
    | CheckAll
    deriving stock (Int -> CheckFilter -> ShowS
[CheckFilter] -> ShowS
CheckFilter -> String
(Int -> CheckFilter -> ShowS)
-> (CheckFilter -> String)
-> ([CheckFilter] -> ShowS)
-> Show CheckFilter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CheckFilter] -> ShowS
$cshowList :: [CheckFilter] -> ShowS
show :: CheckFilter -> String
$cshow :: CheckFilter -> String
showsPrec :: Int -> CheckFilter -> ShowS
$cshowsPrec :: Int -> CheckFilter -> ShowS
Show, CheckFilter -> CheckFilter -> Bool
(CheckFilter -> CheckFilter -> Bool)
-> (CheckFilter -> CheckFilter -> Bool) -> Eq CheckFilter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CheckFilter -> CheckFilter -> Bool
$c/= :: CheckFilter -> CheckFilter -> Bool
== :: CheckFilter -> CheckFilter -> Bool
$c== :: CheckFilter -> CheckFilter -> Bool
Eq)

-- | Where to apply the rule for controlling inspection set.
data Scope
    = ScopeFile !FilePath
    | ScopeDirectory !FilePath
    | ScopeAll
    deriving stock (Int -> Scope -> ShowS
[Scope] -> ShowS
Scope -> String
(Int -> Scope -> ShowS)
-> (Scope -> String) -> ([Scope] -> ShowS) -> Show Scope
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Scope] -> ShowS
$cshowList :: [Scope] -> ShowS
show :: Scope -> String
$cshow :: Scope -> String
showsPrec :: Int -> Scope -> ShowS
$cshowsPrec :: Int -> Scope -> ShowS
Show, Scope -> Scope -> Bool
(Scope -> Scope -> Bool) -> (Scope -> Scope -> Bool) -> Eq Scope
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Scope -> Scope -> Bool
$c/= :: Scope -> Scope -> Bool
== :: Scope -> Scope -> Bool
$c== :: Scope -> Scope -> Bool
Eq)

defaultConfig :: PartialConfig
defaultConfig :: PartialConfig
defaultConfig = $WConfigP :: forall (p :: Phase Text).
(p ::- [Check])
-> (p ::- [Scope]) -> (p ::- [Id Observation]) -> ConfigP p
ConfigP
    { configChecks :: 'Partial ::- [Check]
configChecks  = Text -> Trial Text [Check] -> TaggedTrial Text [Check]
forall tag a. tag -> Trial tag a -> TaggedTrial tag a
withTag "Default" (Trial Text [Check] -> 'Partial ::- [Check])
-> Trial Text [Check] -> 'Partial ::- [Check]
forall a b. (a -> b) -> a -> b
$ [Check] -> Trial Text [Check]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    , configRemoved :: 'Partial ::- [Scope]
configRemoved = Text -> Trial Text [Scope] -> TaggedTrial Text [Scope]
forall tag a. tag -> Trial tag a -> TaggedTrial tag a
withTag "Default" (Trial Text [Scope] -> 'Partial ::- [Scope])
-> Trial Text [Scope] -> 'Partial ::- [Scope]
forall a b. (a -> b) -> a -> b
$ [Scope] -> Trial Text [Scope]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    , configIgnored :: 'Partial ::- [Id Observation]
configIgnored = Text
-> Trial Text [Id Observation] -> TaggedTrial Text [Id Observation]
forall tag a. tag -> Trial tag a -> TaggedTrial tag a
withTag "Default" (Trial Text [Id Observation] -> 'Partial ::- [Id Observation])
-> Trial Text [Id Observation] -> 'Partial ::- [Id Observation]
forall a b. (a -> b) -> a -> b
$ [Id Observation] -> Trial Text [Id Observation]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    }

finaliseConfig :: PartialConfig -> Trial Text Config
finaliseConfig :: PartialConfig -> Trial Text Config
finaliseConfig config :: PartialConfig
config = do
    [Check]
configChecks  <- IsLabel "configChecks" (PartialConfig -> Trial Text [Check])
PartialConfig -> Trial Text [Check]
#configChecks PartialConfig
config
    [Scope]
configRemoved <- IsLabel "configRemoved" (PartialConfig -> Trial Text [Scope])
PartialConfig -> Trial Text [Scope]
#configRemoved PartialConfig
config
    [Id Observation]
configIgnored <- IsLabel
  "configIgnored" (PartialConfig -> Trial Text [Id Observation])
PartialConfig -> Trial Text [Id Observation]
#configIgnored PartialConfig
config
    pure $WConfigP :: forall (p :: Phase Text).
(p ::- [Check])
-> (p ::- [Scope]) -> (p ::- [Id Observation]) -> ConfigP p
ConfigP {..}


{- | Convert TOML configuration to the equivalent CLI command that can
be copy-pasted to get the same results as using the TOML config.

@
  ⓘ Reading Configurations from \/home\/vrom911\/Kowainik\/stan\/.stan.toml ...
stan check --exclude --directory=test/ \\
     check --include \\
     check --exclude --inspectionId=STAN-0002 \\
     check --exclude --inspectionId=STAN-0001 --file=src/MyFile.hs
     remove --file=src/Secret.hs
     ignore --id="STAN0001-asdfgh42:42"
@
-}
configToCliCommand :: Config -> Text
configToCliCommand :: Config -> Text
configToCliCommand ConfigP{..} = "stan " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate " \\\n     "
    (  (Check -> Text) -> [Check] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Check -> Text
checkToCli [Check]
'Final ::- [Check]
configChecks
    [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> (Scope -> Text) -> [Scope] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Scope -> Text
removedToCli [Scope]
'Final ::- [Scope]
configRemoved
    [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> (Id Observation -> Text) -> [Id Observation] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Id Observation -> Text
ignoredToCli [Id Observation]
'Final ::- [Id Observation]
configIgnored
    )
  where
    checkToCli :: Check -> Text
    checkToCli :: Check -> Text
checkToCli Check{..} = "check"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> CheckType -> Text
checkTypeToCli CheckType
checkType
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> CheckFilter -> Text
checkFilterToCli CheckFilter
checkFilter
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Scope -> Text
scopeToCli Scope
checkScope

    removedToCli :: Scope -> Text
    removedToCli :: Scope -> Text
removedToCli scope :: Scope
scope = "remove"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Scope -> Text
scopeToCli Scope
scope

    ignoredToCli :: Id Observation -> Text
    ignoredToCli :: Id Observation -> Text
ignoredToCli obsId :: Id Observation
obsId = "ignore"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Id Observation -> Text
forall a. Id a -> Text
idToCli Id Observation
obsId

    idToCli :: Id a -> Text
    idToCli :: Id a -> Text
idToCli = Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
(<>) " --id=" (Text -> Text) -> (Id a -> Text) -> Id a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Id a -> Text
forall a. Id a -> Text
unId

    checkTypeToCli :: CheckType -> Text
    checkTypeToCli :: CheckType -> Text
checkTypeToCli = \case
        Include -> " --include"
        Exclude -> " --exclude"

    checkFilterToCli :: CheckFilter -> Text
    checkFilterToCli :: CheckFilter -> Text
checkFilterToCli = \case
        CheckInspection insId :: Id Inspection
insId -> Id Inspection -> Text
forall a. Id a -> Text
idToCli Id Inspection
insId
        CheckSeverity sev :: Severity
sev -> " --severity=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Severity -> Text
forall b a. (Show a, IsString b) => a -> b
show Severity
sev
        CheckCategory cat :: Category
cat -> " --category=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Category -> Text
unCategory Category
cat
        CheckAll -> " --filter-all"

    scopeToCli :: Scope -> Text
    scopeToCli :: Scope -> Text
scopeToCli = \case
        ScopeFile file :: String
file -> " --file=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. ToText a => a -> Text
toText String
file
        ScopeDirectory dir :: String
dir -> " --directory=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. ToText a => a -> Text
toText String
dir
        ScopeAll -> " --scope-all"

mkDefaultChecks :: [FilePath] -> HashMap FilePath (HashSet (Id Inspection))
mkDefaultChecks :: [String] -> HashMap String (HashSet (Id Inspection))
mkDefaultChecks = [(String, HashSet (Id Inspection))]
-> HashMap String (HashSet (Id Inspection))
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(String, HashSet (Id Inspection))]
 -> HashMap String (HashSet (Id Inspection)))
-> ([String] -> [(String, HashSet (Id Inspection))])
-> [String]
-> HashMap String (HashSet (Id Inspection))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> (String, HashSet (Id Inspection)))
-> [String] -> [(String, HashSet (Id Inspection))]
forall a b. (a -> b) -> [a] -> [b]
map (, HashSet (Id Inspection)
inspectionsIds)

{- | Apply configuration to the given list of files to get the set of
inspections for each file.

The algorithm:

1. Remove all files specified by the @remove@ option.
2. Run 'applyChecks' on the remaining files.
-}
applyConfig
    :: [FilePath]
    -- ^ Paths to project files
    -> Config
    -- ^ Stan runtime configuration
    -> HashMap FilePath (HashSet (Id Inspection))
    -- ^ Resulting set of inspections for each file
applyConfig :: [String] -> Config -> HashMap String (HashSet (Id Inspection))
applyConfig paths :: [String]
paths ConfigP{..} =
    [String] -> [Check] -> HashMap String (HashSet (Id Inspection))
applyChecks ((String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
notRemoved [String]
paths) [Check]
'Final ::- [Check]
configChecks
  where
    -- TODO: can be implemented efficiently, but the more efficient
    -- implementation is required only if the @configRemoved@ can have
    -- >= 1K entries
    notRemoved :: FilePath -> Bool
    notRemoved :: String -> Bool
notRemoved path :: String
path = (Scope -> Bool) -> [Scope] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (String -> Scope -> Bool
isNotInScope String
path) [Scope]
'Final ::- [Scope]
configRemoved

    isNotInScope :: FilePath -> Scope -> Bool
    isNotInScope :: String -> Scope -> Bool
isNotInScope path :: String
path = \case
        ScopeFile file :: String
file -> String
path String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
file
        ScopeDirectory dir :: String
dir -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ String -> String -> Bool
isInDir String
dir String
path
        ScopeAll -> Bool
False

{- | Convert the list of 'Check's from 'Config' to data structure that
allows filtering of 'Inspection's for given files.
-}
applyChecks
    :: [FilePath]
    -- ^ Paths to project files
    -> [Check]
    -- ^ List of rules
    -> HashMap FilePath (HashSet (Id Inspection))
    -- ^ Resulting set of inspections for each file
applyChecks :: [String] -> [Check] -> HashMap String (HashSet (Id Inspection))
applyChecks = HashMap String (HashSet (Id Inspection))
-> [Check] -> HashMap String (HashSet (Id Inspection))
applyChecksFor (HashMap String (HashSet (Id Inspection))
 -> [Check] -> HashMap String (HashSet (Id Inspection)))
-> ([String] -> HashMap String (HashSet (Id Inspection)))
-> [String]
-> [Check]
-> HashMap String (HashSet (Id Inspection))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> HashMap String (HashSet (Id Inspection))
mkDefaultChecks

{- | Modify existing 'Check's for each file using the given list of
'Check's.
-}
applyChecksFor
    :: HashMap FilePath (HashSet (Id Inspection))
    -- ^ Initial set of inspections for each file
    -> [Check]
    -- ^ List of rules
    -> HashMap FilePath (HashSet (Id Inspection))
    -- ^ Resulting set of inspections for each file
applyChecksFor :: HashMap String (HashSet (Id Inspection))
-> [Check] -> HashMap String (HashSet (Id Inspection))
applyChecksFor = (HashMap String (HashSet (Id Inspection))
 -> Check -> HashMap String (HashSet (Id Inspection)))
-> HashMap String (HashSet (Id Inspection))
-> [Check]
-> HashMap String (HashSet (Id Inspection))
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' HashMap String (HashSet (Id Inspection))
-> Check -> HashMap String (HashSet (Id Inspection))
useCheck
  where
    useCheck
        :: HashMap FilePath (HashSet (Id Inspection))
        -> Check
        -> HashMap FilePath (HashSet (Id Inspection))
    useCheck :: HashMap String (HashSet (Id Inspection))
-> Check -> HashMap String (HashSet (Id Inspection))
useCheck dict :: HashMap String (HashSet (Id Inspection))
dict Check{..} =
        (HashSet (Id Inspection) -> HashSet (Id Inspection))
-> Scope
-> HashMap String (HashSet (Id Inspection))
-> HashMap String (HashSet (Id Inspection))
applyForScope (CheckType
-> CheckFilter
-> HashSet (Id Inspection)
-> HashSet (Id Inspection)
applyFilter CheckType
checkType CheckFilter
checkFilter) Scope
checkScope HashMap String (HashSet (Id Inspection))
dict

    applyFilter
        :: CheckType
        -> CheckFilter
        -> HashSet (Id Inspection)
        -> HashSet (Id Inspection)
    applyFilter :: CheckType
-> CheckFilter
-> HashSet (Id Inspection)
-> HashSet (Id Inspection)
applyFilter = \case
        Include -> CheckFilter -> HashSet (Id Inspection) -> HashSet (Id Inspection)
includeFilter
        Exclude -> CheckFilter -> HashSet (Id Inspection) -> HashSet (Id Inspection)
excludeFilter

    excludeFilter :: CheckFilter -> HashSet (Id Inspection) -> HashSet (Id Inspection)
    excludeFilter :: CheckFilter -> HashSet (Id Inspection) -> HashSet (Id Inspection)
excludeFilter cFilter :: CheckFilter
cFilter = (Id Inspection -> Bool)
-> HashSet (Id Inspection) -> HashSet (Id Inspection)
forall a. (a -> Bool) -> HashSet a -> HashSet a
HashSet.filter (Bool -> Bool
not (Bool -> Bool) -> (Id Inspection -> Bool) -> Id Inspection -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CheckFilter -> Id Inspection -> Bool
satisfiesFilter CheckFilter
cFilter)

    includeFilter :: CheckFilter -> HashSet (Id Inspection) -> HashSet (Id Inspection)
    includeFilter :: CheckFilter -> HashSet (Id Inspection) -> HashSet (Id Inspection)
includeFilter cFilter :: CheckFilter
cFilter ins :: HashSet (Id Inspection)
ins = case CheckFilter
cFilter of
        CheckInspection iId :: Id Inspection
iId -> Id Inspection -> HashSet (Id Inspection) -> HashSet (Id Inspection)
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HashSet.insert Id Inspection
iId HashSet (Id Inspection)
ins
        CheckSeverity sev :: Severity
sev ->
            let sevInspections :: [Inspection]
sevInspections = (Inspection -> Bool) -> [Inspection] -> [Inspection]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Severity -> Severity -> Bool
forall a. Eq a => a -> a -> Bool
== Severity
sev) (Severity -> Bool)
-> (Inspection -> Severity) -> Inspection -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inspection -> Severity
inspectionSeverity) [Inspection]
inspections
            in [Id Inspection] -> HashSet (Id Inspection)
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList ((Inspection -> Id Inspection) -> [Inspection] -> [Id Inspection]
forall a b. (a -> b) -> [a] -> [b]
map Inspection -> Id Inspection
inspectionId [Inspection]
sevInspections) HashSet (Id Inspection)
-> HashSet (Id Inspection) -> HashSet (Id Inspection)
forall a. Semigroup a => a -> a -> a
<> HashSet (Id Inspection)
ins
        CheckCategory cat :: Category
cat ->
            let catInspections :: [Inspection]
catInspections = (Inspection -> Bool) -> [Inspection] -> [Inspection]
forall a. (a -> Bool) -> [a] -> [a]
filter (Category -> NonEmpty Category -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
elem Category
cat (NonEmpty Category -> Bool)
-> (Inspection -> NonEmpty Category) -> Inspection -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inspection -> NonEmpty Category
inspectionCategory) [Inspection]
inspections
            in [Id Inspection] -> HashSet (Id Inspection)
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList ((Inspection -> Id Inspection) -> [Inspection] -> [Id Inspection]
forall a b. (a -> b) -> [a] -> [b]
map Inspection -> Id Inspection
inspectionId [Inspection]
catInspections) HashSet (Id Inspection)
-> HashSet (Id Inspection) -> HashSet (Id Inspection)
forall a. Semigroup a => a -> a -> a
<> HashSet (Id Inspection)
ins
        CheckAll -> HashSet (Id Inspection)
inspectionsIds HashSet (Id Inspection)
-> HashSet (Id Inspection) -> HashSet (Id Inspection)
forall a. Semigroup a => a -> a -> a
<> HashSet (Id Inspection)
ins

    -- Returns 'True' if the given inspection satisfies 'CheckFilter'
    satisfiesFilter :: CheckFilter -> Id Inspection -> Bool
    satisfiesFilter :: CheckFilter -> Id Inspection -> Bool
satisfiesFilter cFilter :: CheckFilter
cFilter iId :: Id Inspection
iId = case Id Inspection -> Maybe Inspection
lookupInspectionById Id Inspection
iId of
        -- TODO: rewrite more efficiently after using GHC-8.10
        Nothing -> Bool
False  -- no such ID => doesn't satisfy
        Just Inspection{..} -> case CheckFilter
cFilter of
            CheckInspection checkId :: Id Inspection
checkId -> Id Inspection
iId Id Inspection -> Id Inspection -> Bool
forall a. Eq a => a -> a -> Bool
== Id Inspection
checkId
            CheckSeverity sev :: Severity
sev       -> Severity
sev Severity -> Severity -> Bool
forall a. Eq a => a -> a -> Bool
== Severity
inspectionSeverity
            CheckCategory cat :: Category
cat       -> Category
cat Category -> NonEmpty Category -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` NonEmpty Category
inspectionCategory
            CheckAll                -> Bool
True

    applyForScope
        :: (HashSet (Id Inspection) -> HashSet (Id Inspection))
        -> Scope
        -> HashMap FilePath (HashSet (Id Inspection))
        -> HashMap FilePath (HashSet (Id Inspection))
    applyForScope :: (HashSet (Id Inspection) -> HashSet (Id Inspection))
-> Scope
-> HashMap String (HashSet (Id Inspection))
-> HashMap String (HashSet (Id Inspection))
applyForScope f :: HashSet (Id Inspection) -> HashSet (Id Inspection)
f cScope :: Scope
cScope hm :: HashMap String (HashSet (Id Inspection))
hm = case Scope
cScope of
        ScopeFile path :: String
path -> (HashSet (Id Inspection) -> HashSet (Id Inspection))
-> String
-> HashMap String (HashSet (Id Inspection))
-> HashMap String (HashSet (Id Inspection))
forall k v.
(Eq k, Hashable k) =>
(v -> v) -> k -> HashMap k v -> HashMap k v
HashMap.adjust HashSet (Id Inspection) -> HashSet (Id Inspection)
f String
path HashMap String (HashSet (Id Inspection))
hm
        ScopeDirectory dir :: String
dir -> (String -> HashSet (Id Inspection) -> HashSet (Id Inspection))
-> HashMap String (HashSet (Id Inspection))
-> HashMap String (HashSet (Id Inspection))
forall k v1 v2. (k -> v1 -> v2) -> HashMap k v1 -> HashMap k v2
HashMap.mapWithKey
            (\path :: String
path -> if String -> String -> Bool
isInDir String
dir String
path then HashSet (Id Inspection) -> HashSet (Id Inspection)
f else HashSet (Id Inspection) -> HashSet (Id Inspection)
forall a. a -> a
id)
            HashMap String (HashSet (Id Inspection))
hm
        ScopeAll -> HashSet (Id Inspection) -> HashSet (Id Inspection)
f (HashSet (Id Inspection) -> HashSet (Id Inspection))
-> HashMap String (HashSet (Id Inspection))
-> HashMap String (HashSet (Id Inspection))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap String (HashSet (Id Inspection))
hm

isInDir :: FilePath -> FilePath -> Bool
isInDir :: String -> String -> Bool
isInDir dir :: String
dir path :: String
path = String
dir String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
path

{- $applyConfig

The 'applyConfig' function transforms the list of rules defined in the
'Config' (either via TOML or CLI) to get the list of 'Inspection's for
each module.

By default, @stan@ runs all 'Inspection's for all modules in the
Haskell project and outputs all 'Observation's it finds. Using
'Config', you can adjust the default setting using your preferences.

=== Algorithm

The algorithm for figuring out the resulting set of 'Inspection's per
module applies each 'Check' one-by-one in order of their appearance.

When introducing a new 'Check' in the config, you must always specify
three key-value pairs:

1. 'CheckType' — control inclusion and exclusion criteria

    * 'Include'

        @
        type = \"Include\"
        @

    * 'Exclude'

        @
        type = \"Exclude\"
        @

2. 'CheckFilter' — how to filter inspections

    * 'CheckInspection': by specific 'Inspection' 'Id'

        @
        id = "STAN-0001"
        @

    * 'CheckSeverity': by specific 'Severity'

        @
        severity = \"Warning\"
        @

    * 'CheckCategory': by specific 'Category'

        @
        category = \"Partial\"
        @

    * 'CheckAll': applied to all 'Inspection's

        @
        filter = "all"
        @

3. 'Scope' — where to apply check

    * 'ScopeFile': only to the specific file

        @
        file = "src\/MyModule.hs"
        @

    * 'ScopeDirectory': to all files in the specified directory

        @
        directory = "text\/"
        @

    * 'ScopeAll': to all files

        @
        scope = "all"
        @

The algorithm doesn't remove any files or inspections from the
consideration completely. So, for example, if you exclude all
inspections in a specific file, new inspections can be added for this
file later by the follow up rules.

However, if you want to completely remove some files or directory from
analysis, you can use the @remove@ key:

@
[[remove]]
file = "src\/Autogenerated.hs"
@

=== Common examples

This section contains examples of custom configuration (in TOML) for
common cases.

1. Exclude all 'Inspection's.

    @
    [[check]]
    type   = \"Exclude\"
    filter = "all"
    scope  = "all"
    @

2. Exclude all 'Inspection's only for specific file.

    @
    [[check]]
    type = \"Exclude\"
    filter = "all"
    file = "src/MyModule.hs"
    @

3. Exclude a specific 'Inspection' in all files:

    @
    [[check]]
    type = \"Exclude\"
    id = "STAN-0001"
    scope = "all"
    @

4. Exclude all 'Inspection's for specific file except 'Inspection's
that have a category @Partial@.

    @
    # exclude all inspections for a file
    [[check]]
    type = \"Exclude\"
    filter = "all"
    file = "src/MyModule.hs"

    # return back only required inspections
    [[check]]
    type = \"Include\"
    category = \"Partial\"
    file = "src/MyModule.hs"
    @

5. Keep 'Inspection's only with the category @Partial@ for all files
except a single one.

    @
    # exclude all inspections
    [[check]]
    type   = \"Exclude\"
    filter = "all"
    scope  = "all"

    # return back inspections with the category Partial
    [[check]]
    type = \"Include\"
    category = \"Partial\"
    scope = "all"

    # finally, disable all inspections for a specific file
    [[check]]
    type = \"Exclude\"
    filter = "all"
    file = "src/MyModule.hs"
    @
-}