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

__Inspection__ — check or test provided by Stan.
-}

module Stan.Inspection
    ( -- * Stan inspection type
      Inspection (..)
    , categoryL
    , descriptionL
    , solutionL
    , severityL
    , analysisL

      -- * Inspection info
    , InspectionAnalysis (..)
    , InspectionsMap

      -- * Sorting
    , sortById
      -- * Pretty print
    , prettyShowInspection
    , prettyShowInspectionShort
      -- ** Markdown
    , inspectionsMd
    ) where

import Relude.Extra.Lens (Lens', lens)

import Colourista (blue, bold, formatWith, green)
import Colourista.Short (b, i)

import Stan.Category (Category (..), prettyShowCategory)
import Stan.Core.Id (Id (..))
import Stan.Pattern.Ast (PatternAst)
import Stan.Severity (Severity, prettyShowSeverity)

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


{- | Data type that represents a check/test, or how we call it
__inspection__ that is provided by the Stan tool.
-}
data Inspection = Inspection
    { Inspection -> Id Inspection
inspectionId          :: !(Id Inspection)
    , Inspection -> Text
inspectionName        :: !Text
    , Inspection -> Text
inspectionDescription :: !Text
    , Inspection -> [Text]
inspectionSolution    :: ![Text]
    , Inspection -> NonEmpty Category
inspectionCategory    :: !(NonEmpty Category)
    , Inspection -> Severity
inspectionSeverity    :: !Severity
    , Inspection -> InspectionAnalysis
inspectionAnalysis    :: !InspectionAnalysis
    } deriving stock (Int -> Inspection -> ShowS
[Inspection] -> ShowS
Inspection -> String
(Int -> Inspection -> ShowS)
-> (Inspection -> String)
-> ([Inspection] -> ShowS)
-> Show Inspection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Inspection] -> ShowS
$cshowList :: [Inspection] -> ShowS
show :: Inspection -> String
$cshow :: Inspection -> String
showsPrec :: Int -> Inspection -> ShowS
$cshowsPrec :: Int -> Inspection -> ShowS
Show, Inspection -> Inspection -> Bool
(Inspection -> Inspection -> Bool)
-> (Inspection -> Inspection -> Bool) -> Eq Inspection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Inspection -> Inspection -> Bool
$c/= :: Inspection -> Inspection -> Bool
== :: Inspection -> Inspection -> Bool
$c== :: Inspection -> Inspection -> Bool
Eq)

descriptionL :: Lens' Inspection Text
descriptionL :: (Text -> f Text) -> Inspection -> f Inspection
descriptionL = (Inspection -> Text)
-> (Inspection -> Text -> Inspection) -> Lens' Inspection Text
forall s a. (s -> a) -> (s -> a -> s) -> Lens' s a
lens
    Inspection -> Text
inspectionDescription
    (\inspection :: Inspection
inspection new :: Text
new -> Inspection
inspection { inspectionDescription :: Text
inspectionDescription = Text
new })

solutionL :: Lens' Inspection [Text]
solutionL :: ([Text] -> f [Text]) -> Inspection -> f Inspection
solutionL = (Inspection -> [Text])
-> (Inspection -> [Text] -> Inspection) -> Lens' Inspection [Text]
forall s a. (s -> a) -> (s -> a -> s) -> Lens' s a
lens
    Inspection -> [Text]
inspectionSolution
    (\inspection :: Inspection
inspection new :: [Text]
new -> Inspection
inspection { inspectionSolution :: [Text]
inspectionSolution = [Text]
new })

categoryL :: Lens' Inspection (NonEmpty Category)
categoryL :: (NonEmpty Category -> f (NonEmpty Category))
-> Inspection -> f Inspection
categoryL = (Inspection -> NonEmpty Category)
-> (Inspection -> NonEmpty Category -> Inspection)
-> Lens' Inspection (NonEmpty Category)
forall s a. (s -> a) -> (s -> a -> s) -> Lens' s a
lens
    Inspection -> NonEmpty Category
inspectionCategory
    (\inspection :: Inspection
inspection new :: NonEmpty Category
new -> Inspection
inspection { inspectionCategory :: NonEmpty Category
inspectionCategory = NonEmpty Category
new })

severityL :: Lens' Inspection Severity
severityL :: (Severity -> f Severity) -> Inspection -> f Inspection
severityL = (Inspection -> Severity)
-> (Inspection -> Severity -> Inspection)
-> Lens' Inspection Severity
forall s a. (s -> a) -> (s -> a -> s) -> Lens' s a
lens
    Inspection -> Severity
inspectionSeverity
    (\inspection :: Inspection
inspection new :: Severity
new -> Inspection
inspection { inspectionSeverity :: Severity
inspectionSeverity = Severity
new })

analysisL :: Lens' Inspection InspectionAnalysis
analysisL :: (InspectionAnalysis -> f InspectionAnalysis)
-> Inspection -> f Inspection
analysisL = (Inspection -> InspectionAnalysis)
-> (Inspection -> InspectionAnalysis -> Inspection)
-> Lens' Inspection InspectionAnalysis
forall s a. (s -> a) -> (s -> a -> s) -> Lens' s a
lens
    Inspection -> InspectionAnalysis
inspectionAnalysis
    (\inspection :: Inspection
inspection new :: InspectionAnalysis
new -> Inspection
inspection { inspectionAnalysis :: InspectionAnalysis
inspectionAnalysis = InspectionAnalysis
new })

{- | Type alias for the 'HashMap' that contains pairs of inspections 'Id's and
corresponding 'Inspection's.
-}
type InspectionsMap = HashMap (Id Inspection) Inspection

-- | Sort 'Inspection' by 'Id'
sortById :: InspectionsMap -> [Inspection]
sortById :: InspectionsMap -> [Inspection]
sortById = (Inspection -> Id Inspection) -> [Inspection] -> [Inspection]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortWith Inspection -> Id Inspection
inspectionId ([Inspection] -> [Inspection])
-> (InspectionsMap -> [Inspection])
-> InspectionsMap
-> [Inspection]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InspectionsMap -> [Inspection]
forall k v. HashMap k v -> [v]
HM.elems

{- | Data type that represents all possible types of @stan@
inspections in a uniformed way.
-}
data InspectionAnalysis
    -- | Find the specific part of the Haskell AST (including specific functions).
    = FindAst !PatternAst
    -- | Find all operators without matching @infix[r|l]@
    | Infix
    -- | Check if the data type has lazy fields
    | LazyField
    -- | Usage of tuples with size >= 4
    | BigTuples
    -- | Pattern matching on @_@ for sum types.
    | PatternMatchOn_
    -- | Replace multiple comparison operations with 'compare'
    | UseCompare
    deriving stock (Int -> InspectionAnalysis -> ShowS
[InspectionAnalysis] -> ShowS
InspectionAnalysis -> String
(Int -> InspectionAnalysis -> ShowS)
-> (InspectionAnalysis -> String)
-> ([InspectionAnalysis] -> ShowS)
-> Show InspectionAnalysis
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InspectionAnalysis] -> ShowS
$cshowList :: [InspectionAnalysis] -> ShowS
show :: InspectionAnalysis -> String
$cshow :: InspectionAnalysis -> String
showsPrec :: Int -> InspectionAnalysis -> ShowS
$cshowsPrec :: Int -> InspectionAnalysis -> ShowS
Show, InspectionAnalysis -> InspectionAnalysis -> Bool
(InspectionAnalysis -> InspectionAnalysis -> Bool)
-> (InspectionAnalysis -> InspectionAnalysis -> Bool)
-> Eq InspectionAnalysis
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InspectionAnalysis -> InspectionAnalysis -> Bool
$c/= :: InspectionAnalysis -> InspectionAnalysis -> Bool
== :: InspectionAnalysis -> InspectionAnalysis -> Bool
$c== :: InspectionAnalysis -> InspectionAnalysis -> Bool
Eq)

-- | Show 'Inspection' in a human-friendly format.
prettyShowInspection :: Inspection -> Text
prettyShowInspection :: Inspection -> Text
prettyShowInspection Inspection{..} = [Text] -> Text
forall t. IsText t "unlines" => [t] -> t
unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
    [ Text -> Text
forall str. (IsString str, Semigroup str) => str -> str
b "~~~STAN INSPECTION~~~"
    , ""
    , Text -> Text
forall str. (IsString str, Semigroup str) => str -> str
i " ✲ ID:          " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall str. (IsString str, Semigroup str) => str -> str
b (Id Inspection -> Text
forall a. Id a -> Text
unId Id Inspection
inspectionId)
    , Text -> Text
forall str. (IsString str, Semigroup str) => str -> str
i " ✲ Name:        " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
inspectionName
    , Text -> Text
forall str. (IsString str, Semigroup str) => str -> str
i " ✲ Description: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
inspectionDescription
    , Text -> Text
forall str. (IsString str, Semigroup str) => str -> str
i " ✲ Severity:    " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Severity -> Text
prettyShowSeverity Severity
inspectionSeverity
    , Text -> Text
forall str. (IsString str, Semigroup str) => str -> str
i " ✲ Category:    " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate " " ((Category -> Text) -> [Category] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Category -> Text
prettyShowCategory ([Category] -> [Text]) -> [Category] -> [Text]
forall a b. (a -> b) -> a -> b
$ NonEmpty Category -> [Category]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty Category
inspectionCategory)
    , ""
    ,  [Text] -> Text -> Text
forall str. (IsString str, Semigroup str) => [str] -> str -> str
formatWith [Text
forall str. IsString str => str
green] "Possible solutions:"
    ] [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ("  - " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) [Text]
inspectionSolution

-- | Show the short view of a given 'Inspection'.
prettyShowInspectionShort :: Inspection -> Text
prettyShowInspectionShort :: Inspection -> Text
prettyShowInspectionShort Inspection{..} =
    " ❋ "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text -> Text
forall str. (IsString str, Semigroup str) => [str] -> str -> str
formatWith [Text
forall str. IsString str => str
bold, Text
forall str. IsString str => str
blue] ("[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Id Inspection -> Text
forall a. Id a -> Text
unId Id Inspection
inspectionId Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "] ")
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall str. (IsString str, Semigroup str) => str -> str
i Text
inspectionName

{- | Create the MarkDown text for all inspections.
The generated MD has a ToC and separate sections for each inspection.

This is used to keep the Wiki page of the project up to date.
-}
inspectionsMd :: [Inspection] -> Text
inspectionsMd :: [Inspection] -> Text
inspectionsMd inss :: [Inspection]
inss = Text
intro Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
toc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
forall t. IsText t "unlines" => [t] -> t
unlines ((Inspection -> Text) -> [Inspection] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Inspection -> Text
inspectionToMd [Inspection]
inss)
  where
    intro :: Text
    intro :: Text
intro = "This document contains information about all inspections used in Stan to find observations in your projects. Below you can see more details about each inspection individually\n\n"

    toc :: Text
    toc :: Text
toc = "## Table of all Inspections\n\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
forall t. IsText t "unlines" => [t] -> t
unlines ((Inspection -> Text) -> [Inspection] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Inspection -> Text
insLink [Inspection]
inss) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\n"

    insLink :: Inspection -> Text
    insLink :: Inspection -> Text
insLink (Id Inspection -> Text
forall a. Id a -> Text
unId (Id Inspection -> Text)
-> (Inspection -> Id Inspection) -> Inspection -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inspection -> Id Inspection
inspectionId -> Text
ins)= " * [" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ins Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "](#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ins Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ")"

inspectionToMd :: Inspection -> Text
inspectionToMd :: Inspection -> Text
inspectionToMd Inspection{..} = [Text] -> Text
forall t. IsText t "unlines" => [t] -> t
unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
    [ "## " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Id Inspection -> Text
forall a. Id a -> Text
unId Id Inspection
inspectionId
    , ""
    , "[[Back to the Table of all Inspections] ↑](#table-of-all-inspections)"
    , ""
    , "| Property | Value |"
    , "|--|--|"
    , "| ID          | " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Id Inspection -> Text
forall a. Id a -> Text
unId Id Inspection
inspectionId Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " |"
    , "| Name        | " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
inspectionName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " |"
    , "| Description | " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
inspectionDescription Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " |"
    , "| Severity    | " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Severity -> Text
forall b a. (Show a, IsString b) => a -> b
show Severity
inspectionSeverity Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " |"
    , "| Category    | " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate " #" ((Category -> Text) -> [Category] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Category -> Text
unCategory ([Category] -> [Text]) -> [Category] -> [Text]
forall a b. (a -> b) -> a -> b
$ NonEmpty Category -> [Category]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty Category
inspectionCategory) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " |"
    , ""
    , "#### Possible solutions for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Id Inspection -> Text
forall a. Id a -> Text
unId Id Inspection
inspectionId
    ] [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ("  - " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) [Text]
inspectionSolution