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

HTML to be generated in the report.
-}

module Stan.Report.Html
    ( stanHtml
    ) where

import Prelude hiding (div, head, span)

import Clay (compact, renderWith)
import Text.Blaze.Html
import Text.Blaze.Html5 hiding (ins, map, summary)

import Stan.Analysis (Analysis (..))
import Stan.Analysis.Pretty (AnalysisNumbers (..), ProjectHealth (..), analysisToNumbers,
                             prettyHealth, toProjectHealth)
import Stan.Analysis.Summary (Summary (..), createSummary)
import Stan.Category (Category (..))
import Stan.Config (Config, ConfigP (..))
import Stan.Config.Pretty (ConfigAction, configActionClass, configToTriples, prettyConfigAction)
import Stan.Core.Id (Id (..))
import Stan.Core.ModuleName (ModuleName (..))
import Stan.FileInfo (FileInfo (..), extensionsToText)
import Stan.Info (ProjectInfo (..), StanEnv (..), StanSystem (..), StanVersion (..), stanSystem,
                  stanVersion)
import Stan.Inspection (Inspection (..))
import Stan.Inspection.All (getInspectionById, inspectionsMap)
import Stan.Observation (Observation (..), ignoredObservations, prettyObservationSource)
import Stan.Report.Css (stanCss)
import Stan.Severity (Severity (..), severityDescription)

import qualified Data.HashMap.Strict as HM
import qualified Data.List as List
import qualified Data.Map.Strict as Map
import qualified Data.Text as T
import qualified Slist as S
import qualified Text.Blaze.Html5.Attributes as A


stanHtml :: Analysis -> Config -> [Text] -> StanEnv -> ProjectInfo -> Html
stanHtml :: Analysis -> Config -> [Text] -> StanEnv -> ProjectInfo -> Html
stanHtml Analysis
an Config
config [Text]
warnings StanEnv
env ProjectInfo
project =
    Html -> Html
docTypeHtml (Html
stanHead Html -> Html -> Html
forall a b. MarkupM a -> MarkupM b -> MarkupM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html
stanBody)
  where
    stanBody :: Html
    stanBody :: Html
stanBody = Html -> Html
body (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
        Html
stanHeader
        Analysis -> Config -> [Text] -> StanEnv -> ProjectInfo -> Html
stanMain Analysis
an Config
config [Text]
warnings StanEnv
env ProjectInfo
project
        Html
stanFooter
        Html
stanJs

stanHeader :: Html
stanHeader :: Html
stanHeader = Html -> Html
header (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"centre" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
    Text -> Html -> Html
divClass Text
"row" (Html -> Html
h1 Html
"Stan Report")
    Html -> Html
nav (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"row" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
      Text -> Html
navItem Text
"General Info"
      Text -> Html
navItem Text
"Observations"
      Text -> Html
navItem Text
"Configurations"
      Text -> Html
navItem Text
"Report Explained"
  where
    navItem :: Text -> Html
    navItem :: Text -> Html
navItem Text
h = Text -> Html -> Html
divClass Text
"col-3 nav-item"
        (Html -> Html
a (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href (Text -> AttributeValue
forall s. IsString s => Text -> s
fromText (Text -> AttributeValue) -> Text -> AttributeValue
forall a b. (a -> b) -> a -> b
$ Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
hToId Text
h) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
toHtml Text
h)

stanMain :: Analysis -> Config -> [Text] -> StanEnv -> ProjectInfo -> Html
stanMain :: Analysis -> Config -> [Text] -> StanEnv -> ProjectInfo -> Html
stanMain Analysis
an Config
config [Text]
warnings StanEnv
env ProjectInfo
project = Html -> Html
main (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"container" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
    Text -> Html -> Html
divClass Text
"row" Html
stanIntro
    Text -> Text -> Html -> Html
divIdClassH Text
"Stan Info" Text
"row" (StanEnv -> Html
stanInfo StanEnv
env)
    Text -> Text -> Html -> Html
divIdClass Text
"general-info" Text
"row" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
        Text -> Text -> Html -> Html
divIdClassH Text
"Project Info" Text
"col-6" (ProjectInfo -> Html
stanProject ProjectInfo
project)
        Text -> Text -> Html -> Html
divIdClassH Text
"Analysis Info" Text
"col-6" (AnalysisNumbers -> Html
stanAnalysis AnalysisNumbers
analysisNumbers)
    Text -> Text -> Html -> Html
divIdClassH Text
"Static Analysis Summary" Text
"row" (Analysis -> AnalysisNumbers -> Html
stanSummary Analysis
an AnalysisNumbers
analysisNumbers)
    -- divIdClassH "Graphs" "row" (p_ "Maybe later")
    Text -> Text -> Html -> Html
divIdClassH Text
"Observations" Text
"row" (Analysis -> Html
stanObservations Analysis
an)
    Text -> Text -> Html -> Html
divIdClassH Text
"Configurations" Text
"row" (Analysis -> Config -> [Text] -> Html
stanConfig Analysis
an Config
config [Text]
warnings)
    -- divIdClassH "Summary" "row" (p_ "Later")
    Text -> Text -> Html -> Html
divIdClassH Text
"Report Explained" Text
"" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
        Text -> Text -> Html -> Html
divIdClassH Text
"Inspections" Text
"row" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ HashSet (Id Inspection) -> Html
stanInspections (Analysis -> HashSet (Id Inspection)
analysisInspections Analysis
an)
        Text -> Text -> Html -> Html
divIdClassH Text
"Severity" Text
"row" Html
stanSeverityExplained
  where
    analysisNumbers :: AnalysisNumbers
    analysisNumbers :: AnalysisNumbers
analysisNumbers = Analysis -> AnalysisNumbers
analysisToNumbers Analysis
an

stanIntro :: Html
stanIntro :: Html
stanIntro = Html -> Html
p (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
    forall a. ToMarkup a => a -> Html
toHtml @Text Text
"This is the Haskell Static Analysis report generated by "
    Html -> Html
a (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href AttributeValue
"https://kowainik.github.io/projects/stan" (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"ins-link" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
        forall a. ToMarkup a => a -> Html
toHtml @Text Text
"Stan"

stanInfo :: StanEnv -> Html
stanInfo :: StanEnv -> Html
stanInfo StanEnv{[String]
Text
seEnvVars :: Text
seTomlFiles :: [String]
seCliArgs :: [String]
seEnvVars :: StanEnv -> Text
seTomlFiles :: StanEnv -> [String]
seCliArgs :: StanEnv -> [String]
..} = do
    let StanVersion{String
svVersion :: String
svGitRevision :: String
svCommitDate :: String
svVersion :: StanVersion -> String
svGitRevision :: StanVersion -> String
svCommitDate :: StanVersion -> String
..} = StanVersion
stanVersion
    let StanSystem{String
ssOs :: String
ssArch :: String
ssCompiler :: String
ssCompilerVersion :: String
ssOs :: StanSystem -> String
ssArch :: StanSystem -> String
ssCompiler :: StanSystem -> String
ssCompilerVersion :: StanSystem -> String
..} = StanSystem
stanSystem
    Text -> Html -> Html
divClass Text
"row" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
blockP (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
       [ Text
"In this section, you can find the general information about the used "
       , Text
"Stan tool, compile-time and run-time environment "
       , Text
"variables and settings, including build information, system data and "
       , Text
"execution configurations."
       ]
    Text -> Html -> Html
divClass Text
"col-10" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
        Html -> Html
table (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! (AttributeValue -> Attribute
A.class_ AttributeValue
"border-shadow" Attribute -> Attribute -> Attribute
forall a. Semigroup a => a -> a -> a
<> AttributeValue -> Attribute
A.style AttributeValue
"table-layout:fixed") (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
            Html -> Html
colgroup (Html
col Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.style AttributeValue
"width:25%" Html -> Html -> Html
forall a b. MarkupM a -> MarkupM b -> MarkupM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html
col)
            Html -> Html
tr2 Html
"Stan Version"
            Text -> String -> Html
forall a. ToMarkup a => Text -> a -> Html
tableRow Text
"Version"       String
svVersion
            Text -> String -> Html
forall a. ToMarkup a => Text -> a -> Html
tableRow Text
"Git Revision"  String
svGitRevision
            Text -> String -> Html
forall a. ToMarkup a => Text -> a -> Html
tableRow Text
"Release Date"  String
svCommitDate
            Html -> Html
tr2 Html
"System Info"
            Text -> String -> Html
forall a. ToMarkup a => Text -> a -> Html
tableRow Text
"Operating System" String
ssOs
            Text -> String -> Html
forall a. ToMarkup a => Text -> a -> Html
tableRow Text
"Architecture"     String
ssArch
            Text -> String -> Html
forall a. ToMarkup a => Text -> a -> Html
tableRow Text
"Compiler"         String
ssCompiler
            Text -> String -> Html
forall a. ToMarkup a => Text -> a -> Html
tableRow Text
"Compiler Version" String
ssCompilerVersion
            Html -> Html
tr2 Html
"Environment"
            Text -> Text -> Html
forall a. ToMarkup a => Text -> a -> Html
tableRow Text
"Environment Variables"    Text
seEnvVars
            Text -> Html -> Html
forall a. ToMarkup a => Text -> a -> Html
tableRow Text
"TOML configuration files" ((String -> Html) -> [String] -> Html
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ String -> Html
forall a. ToMarkup a => a -> Html
toHtml [String]
seTomlFiles)
            Text -> String -> Html
forall a. ToMarkup a => Text -> a -> Html
tableRow Text
"CLI arguments"            ([String] -> String
List.unwords [String]
seCliArgs)
  where
    tr2 :: Html -> Html
tr2 Html
x = Html -> Html
tr (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
td (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! (AttributeValue -> Attribute
A.colspan AttributeValue
"2" Attribute -> Attribute -> Attribute
forall a. Semigroup a => a -> a -> a
<> AttributeValue -> Attribute
A.class_ AttributeValue
"centre grey-bg") (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
strong Html
x

stanProject :: ProjectInfo -> Html
stanProject :: ProjectInfo -> Html
stanProject ProjectInfo{Int
String
[String]
piName :: String
piCabalFiles :: [String]
piHieDir :: String
piFileNumber :: Int
piName :: ProjectInfo -> String
piCabalFiles :: ProjectInfo -> [String]
piHieDir :: ProjectInfo -> String
piFileNumber :: ProjectInfo -> Int
..} = do
    Text -> Html -> Html
divClass Text
"row" (Text -> Html
blockP Text
"Information about the analysed project")
    Text -> Html -> Html
tableWithShadow Text
"" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
        Html -> Html
colgroup (Html
col Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"info-name" Html -> Html -> Html
forall a b. MarkupM a -> MarkupM b -> MarkupM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html
col Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"info-data")
        Text -> String -> Html
forall a. ToMarkup a => Text -> a -> Html
tableRow Text
"Project name"  String
piName
        Text -> String -> Html
forall a. ToMarkup a => Text -> a -> Html
tableRow Text
"Cabal Files"   ([String] -> String
List.unwords [String]
piCabalFiles)
        Text -> String -> Html
forall a. ToMarkup a => Text -> a -> Html
tableRow Text
"HIE Files Directory" String
piHieDir
        Text -> Int -> Html
forall a. ToMarkup a => Text -> a -> Html
tableRow Text
"Files Number" Int
piFileNumber

stanAnalysis :: AnalysisNumbers -> Html
stanAnalysis :: AnalysisNumbers -> Html
stanAnalysis AnalysisNumbers{Double
Int
anModules :: Int
anLoc :: Int
anExts :: Int
anSafeExts :: Int
anIns :: Int
anFoundObs :: Int
anIgnoredObs :: Int
anHealth :: Double
anModules :: AnalysisNumbers -> Int
anLoc :: AnalysisNumbers -> Int
anExts :: AnalysisNumbers -> Int
anSafeExts :: AnalysisNumbers -> Int
anIns :: AnalysisNumbers -> Int
anFoundObs :: AnalysisNumbers -> Int
anIgnoredObs :: AnalysisNumbers -> Int
anHealth :: AnalysisNumbers -> Double
..} = do
    Text -> Html -> Html
divClass Text
"row" (Text -> Html
blockP Text
"Summary stats from the static analysis")
    Text -> Html -> Html
tableWithShadow Text
"" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
        Text -> Int -> Html
forall a. ToMarkup a => Text -> a -> Html
tableRow Text
"Modules"               Int
anModules
        Text -> Int -> Html
forall a. ToMarkup a => Text -> a -> Html
tableRow Text
"LoC"                   Int
anLoc
        Text -> Int -> Html
forall a. ToMarkup a => Text -> a -> Html
tableRow Text
"Extensions"            Int
anExts
        Text -> Int -> Html
forall a. ToMarkup a => Text -> a -> Html
tableRow Text
"SafeHaskell Extensions" Int
anSafeExts
        Text -> Int -> Html
forall a. ToMarkup a => Text -> a -> Html
tableRow Text
"Available inspections" (HashMap (Id Inspection) Inspection -> Int
forall k v. HashMap k v -> Int
HM.size HashMap (Id Inspection) Inspection
inspectionsMap)
        Text -> Int -> Html
forall a. ToMarkup a => Text -> a -> Html
tableRow Text
"Checked inspections"   Int
anIns
        Text -> Int -> Html
forall a. ToMarkup a => Text -> a -> Html
tableRow Text
"Found Observations"    Int
anFoundObs
        Text -> Int -> Html
forall a. ToMarkup a => Text -> a -> Html
tableRow Text
"Ignored Observations"  Int
anIgnoredObs

stanSummary :: Analysis -> AnalysisNumbers -> Html
stanSummary :: Analysis -> AnalysisNumbers -> Html
stanSummary Analysis
analysis AnalysisNumbers{Double
Int
anModules :: AnalysisNumbers -> Int
anLoc :: AnalysisNumbers -> Int
anExts :: AnalysisNumbers -> Int
anSafeExts :: AnalysisNumbers -> Int
anIns :: AnalysisNumbers -> Int
anFoundObs :: AnalysisNumbers -> Int
anIgnoredObs :: AnalysisNumbers -> Int
anHealth :: AnalysisNumbers -> Double
anModules :: Int
anLoc :: Int
anExts :: Int
anSafeExts :: Int
anIns :: Int
anFoundObs :: Int
anIgnoredObs :: Int
anHealth :: Double
..} = do
    Text -> Html -> Html
divClass Text
"row" (Text -> Html
blockP Text
"Here you can find the overall conclusion based on the various metadata and gathered information during the work of Stan on this project.")
    Html -> Html
ul (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"col-10" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
        Html -> Html
liSum (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
            Html -> Html
h4 (Text -> Html
forall a. ToMarkup a => a -> Html
toHtml (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$ Text
"Project health: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Text
prettyHealth Double
anHealth)
            Html -> Html
span (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ forall a. ToMarkup a => a -> Html
toHtml @Text (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
                [ Text
"This number was calculated based on the total number of used inspections "
                , Text
"and the number of triggered inspections in the project. The calculated number "
                , Text
"also defines the overall project health status."
                ]
        Html -> Html
liSum (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
            Html -> Html
h4 (Text -> Html
forall a. ToMarkup a => a -> Html
toHtml (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$ Text
"The project " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ProjectHealth -> Text
showProjectHealth ProjectHealth
projectHealth)
            Html -> Html
span (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
toHtml (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$ ProjectHealth -> Text
showHealthConclusions ProjectHealth
projectHealth
        Html
summary
  where
    projectHealth :: ProjectHealth
    projectHealth :: ProjectHealth
projectHealth = Double -> ProjectHealth
toProjectHealth Double
anHealth

    showProjectHealth :: ProjectHealth -> Text
    showProjectHealth :: ProjectHealth -> Text
showProjectHealth = \case
        ProjectHealth
Unhealthy    -> Text
"is unhealthy"
        ProjectHealth
LowHealth    -> Text
"has low health"
        ProjectHealth
MediumHealth -> Text
"has medium health"
        ProjectHealth
Healthy      -> Text
"is healthy"

    showHealthConclusions :: ProjectHealth -> Text
    showHealthConclusions :: ProjectHealth -> Text
showHealthConclusions = [Text] -> Text
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold ([Text] -> Text)
-> (ProjectHealth -> [Text]) -> ProjectHealth -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
        ProjectHealth
Unhealthy ->
            [ Text
"After analyzing your code, Stan has many suggestions for you on how to improve it."
            , Text
"But this also means that there is a room for improving code quality! "
            , Text
"Don't give up and continue doing great work!"
            ]
        ProjectHealth
LowHealth ->
            [ Text
"According to the Stan analysis, the project has issues of a different variety. But you can improve that! "
            , Text
"Stan provides solutions to the observed problems to help you improve the code quality."
            ]
        ProjectHealth
MediumHealth ->
            [ Text
"Stan discovered several potential issues in the project. "
            , Text
"Nice job, the overall project quality is good. And you can easily make it even better!"
            ]
        ProjectHealth
Healthy ->
            [ Text
"Excellent work! Stan does not have any suggestions for your code."
            ]

    summary :: Html
    summary :: Html
summary = case Analysis -> Maybe Summary
createSummary Analysis
analysis of
        Maybe Summary
Nothing -> Html -> Html
liSum (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
            Html -> Html
h4 Html
"Congratulations! Your project has zero suggestions!"
            Html -> Html
span Html
"Stan carefully ran all configured inspection and found 0 observations for the project."
        Just Summary{Category
Id Inspection
ModuleName
Severity
summaryInspectionId :: Id Inspection
summaryCategory :: Category
summaryModule :: ModuleName
summarySeverity :: Severity
summaryInspectionId :: Summary -> Id Inspection
summaryCategory :: Summary -> Category
summaryModule :: Summary -> ModuleName
summarySeverity :: Summary -> Severity
..} -> do
            Html -> Html
liSum (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
                Html -> Html
h4 (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
toHtml (Text
"Watch out for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Id Inspection -> Text
forall a. Id a -> Text
unId Id Inspection
summaryInspectionId)
                Html -> Html
span (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
                    forall a. ToMarkup a => a -> Html
toHtml @Text Text
"By the result of Stan analysis, the most common inspection for this project is "
                    Id Inspection -> Html
inspectionLink Id Inspection
summaryInspectionId
            Html -> Html
liSum (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
                Html -> Html
h4 (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
toHtml (Text
"Vulnerable module: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ModuleName -> Text
unModuleName ModuleName
summaryModule)
                Html -> Html
span (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
                    forall a. ToMarkup a => a -> Html
toHtml @Text Text
"The "
                    Html -> Html
code (Text -> Html
forall a. ToMarkup a => a -> Html
toHtml (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$ ModuleName -> Text
unModuleName ModuleName
summaryModule)
                    forall a. ToMarkup a => a -> Html
toHtml @Text Text
" module is the most vulnerable one in the project, as it got the most number of observations"
            Html -> Html
liSum (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
                Html -> Html
h4 (Text -> Html
forall a. ToMarkup a => a -> Html
toHtml (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$ Text
"Popular category: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Category -> Text
unCategory Category
summaryCategory)
                Text -> NonEmpty Category -> Html
categories Text
"inline" (NonEmpty Category -> Html) -> NonEmpty Category -> Html
forall a b. (a -> b) -> a -> b
$ OneItem (NonEmpty Category) -> NonEmpty Category
forall x. One x => OneItem x -> x
one OneItem (NonEmpty Category)
Category
summaryCategory
                forall a. ToMarkup a => a -> Html
toHtml @Text Text
"The project has the most problems with inspections from this category"
            Html -> Html
liSum (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
                Html -> Html
h4 (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
toHtml (Text
"Severity: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show @Text Severity
summarySeverity)
                forall a. ToMarkup a => a -> Html
toHtml @Text Text
"The highest severity of found observations is "
                Text -> Html
severity (forall b a. (Show a, IsString b) => a -> b
show @Text Severity
summarySeverity)

    liSum :: Html -> Html
    liSum :: Html -> Html
liSum = Html -> Html
li (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"sum"

stanObservations :: Analysis -> Html
stanObservations :: Analysis -> Html
stanObservations Analysis{Int
(Set OnOffExtension, Set SafeHaskellExtension)
FileMap
HashSet (Id Inspection)
Observations
analysisInspections :: Analysis -> HashSet (Id Inspection)
analysisModulesNum :: Int
analysisLinesOfCode :: Int
analysisUsedExtensions :: (Set OnOffExtension, Set SafeHaskellExtension)
analysisInspections :: HashSet (Id Inspection)
analysisObservations :: Observations
analysisIgnoredObservations :: Observations
analysisFileMap :: FileMap
analysisModulesNum :: Analysis -> Int
analysisLinesOfCode :: Analysis -> Int
analysisUsedExtensions :: Analysis -> (Set OnOffExtension, Set SafeHaskellExtension)
analysisObservations :: Analysis -> Observations
analysisIgnoredObservations :: Analysis -> Observations
analysisFileMap :: Analysis -> FileMap
..} = do
    let toRender :: [FileInfo]
toRender = (FileInfo -> Bool) -> [FileInfo] -> [FileInfo]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (FileInfo -> Bool) -> FileInfo -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Observations -> Bool
forall a. Slist a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Observations -> Bool)
-> (FileInfo -> Observations) -> FileInfo -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileInfo -> Observations
fileInfoObservations) ([FileInfo] -> [FileInfo]) -> [FileInfo] -> [FileInfo]
forall a b. (a -> b) -> a -> b
$ FileMap -> [FileInfo]
forall k a. Map k a -> [a]
Map.elems FileMap
analysisFileMap
    Text -> Html -> Html
divClass Text
"row" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
blockP (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
        [ Text
"Based on the analysis results, Stan found several areas for improvement "
        , Text
"in the analysed files. In Stan terminology, we call these findings "
        , Text
"Observations. Below you can see the more detailed "
        , Text
"information about each observation, and find the possible ways to fix "
        , Text
"them for your project."
        ]
    Html -> Html
ul (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ (FileInfo -> Html) -> [FileInfo] -> Html
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ FileInfo -> Html
tocPerFile [FileInfo]
toRender
    (FileInfo -> Html) -> [FileInfo] -> Html
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ FileInfo -> Html
stanPerFile [FileInfo]
toRender

tocPerFile :: FileInfo -> Html
tocPerFile :: FileInfo -> Html
tocPerFile FileInfo{fileInfoModuleName :: FileInfo -> ModuleName
fileInfoModuleName = ModuleName Text
mName} =
    Html -> Html
li (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
span (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
a (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"ins-link" (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href (Text -> AttributeValue
forall s. IsString s => Text -> s
fromText (Text -> AttributeValue) -> Text -> AttributeValue
forall a b. (a -> b) -> a -> b
$ Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
mName) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
toHtml Text
mName

stanPerFile :: FileInfo -> Html
stanPerFile :: FileInfo -> Html
stanPerFile FileInfo{Int
String
Either ExtensionsError ParsedExtensions
ExtensionsResult
Observations
ModuleName
fileInfoObservations :: FileInfo -> Observations
fileInfoModuleName :: FileInfo -> ModuleName
fileInfoPath :: String
fileInfoModuleName :: ModuleName
fileInfoLoc :: Int
fileInfoCabalExtensions :: Either ExtensionsError ParsedExtensions
fileInfoExtensions :: Either ExtensionsError ParsedExtensions
fileInfoMergedExtensions :: ExtensionsResult
fileInfoObservations :: Observations
fileInfoPath :: FileInfo -> String
fileInfoLoc :: FileInfo -> Int
fileInfoCabalExtensions :: FileInfo -> Either ExtensionsError ParsedExtensions
fileInfoExtensions :: FileInfo -> Either ExtensionsError ParsedExtensions
fileInfoMergedExtensions :: FileInfo -> ExtensionsResult
..} = Text -> Text -> Html -> Html
divIdClass Text
"file" Text
"row" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
    Html -> Html
h3 (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"grey-bg" (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id (Text -> AttributeValue
forall s. IsString s => Text -> s
fromText (Text -> AttributeValue) -> Text -> AttributeValue
forall a b. (a -> b) -> a -> b
$ ModuleName -> Text
unModuleName ModuleName
fileInfoModuleName) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ String -> Html
forall a. ToMarkup a => a -> Html
toHtml (String -> Html) -> String -> Html
forall a b. (a -> b) -> a -> b
$ String
"📄 " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
fileInfoPath
    Html -> Html
ul (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
        Html -> Html
li (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html -> Html
tableWithShadow Text
"col-6" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
            Text -> Html -> Html
forall a. ToMarkup a => Text -> a -> Html
tableRow Text
"Module" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
code (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
toHtml (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$ ModuleName -> Text
unModuleName ModuleName
fileInfoModuleName
            Text -> Int -> Html
forall a. ToMarkup a => Text -> a -> Html
tableRow Text
"Lines of Code" Int
fileInfoLoc
        Html -> Html
li (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html -> Html
divClass Text
"extensions" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
            Text -> [Text] -> Html
stanExtensions Text
".cabal" (Either ExtensionsError ParsedExtensions -> [Text]
extensionsToText Either ExtensionsError ParsedExtensions
fileInfoCabalExtensions)
            Text -> [Text] -> Html
stanExtensions Text
"module" (Either ExtensionsError ParsedExtensions -> [Text]
extensionsToText Either ExtensionsError ParsedExtensions
fileInfoExtensions)
        Html -> Html
li (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"col-12 obs-li" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html -> Html
divClass Text
"observations col-12" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
            Html -> Html
h4 Html
"Observations"
            (Observation -> Html) -> Observations -> Html
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Observation -> Html
stanObservation (Observations -> Html) -> Observations -> Html
forall a b. (a -> b) -> a -> b
$ (Observation -> RealSrcSpan) -> Observations -> Observations
forall b a. Ord b => (a -> b) -> Slist a -> Slist a
S.sortOn Observation -> RealSrcSpan
observationSrcSpan Observations
fileInfoObservations

stanExtensions :: Text -> [Text] -> Html
stanExtensions :: Text -> [Text] -> Html
stanExtensions Text
from [Text]
exts = Text -> Html -> Html
divClass Text
"col-6" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
    Html -> Html
button (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"collapsible" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
toHtml (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$ Text
"Extensions from " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
from
    Html -> Html
ol (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"content" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ (Text -> Html) -> [Text] -> Html
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Html -> Html
li (Html -> Html) -> (Text -> Html) -> Text -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Html
forall a. ToMarkup a => a -> Html
toHtml) [Text]
exts

inspectionLink :: Id Inspection -> Html
inspectionLink :: Id Inspection -> Html
inspectionLink Id Inspection
ins = Html -> Html
a (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"ins-link" (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href (Text -> AttributeValue
forall s. IsString s => Text -> s
fromText (Text -> AttributeValue) -> Text -> AttributeValue
forall a b. (a -> b) -> a -> b
$ Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
insId) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
toHtml Text
insId
  where
    insId :: Text
    insId :: Text
insId = Id Inspection -> Text
forall a. Id a -> Text
unId Id Inspection
ins

stanObservation :: Observation -> Html
stanObservation :: Observation -> Html
stanObservation o :: Observation
o@Observation{String
ByteString
RealSrcSpan
Id Inspection
Id Observation
ModuleName
observationSrcSpan :: Observation -> RealSrcSpan
observationId :: Id Observation
observationInspectionId :: Id Inspection
observationSrcSpan :: RealSrcSpan
observationFile :: String
observationModuleName :: ModuleName
observationFileContent :: ByteString
observationId :: Observation -> Id Observation
observationInspectionId :: Observation -> Id Inspection
observationFile :: Observation -> String
observationModuleName :: Observation -> ModuleName
observationFileContent :: Observation -> ByteString
..} = Text -> Text -> Html -> Html
divIdClass (Id Observation -> Text
forall a. Id a -> Text
unId Id Observation
observationId) Text
"observation row" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
    Html
general
    Html -> Html
pre (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
toHtml ([Text] -> Text
forall t. IsText t "unlines" => [t] -> t
unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Bool -> Observation -> [Text]
prettyObservationSource Bool
False Observation
o)
    Inspection -> Html
solutionsDiv Inspection
inspection
  where
    general :: Html
general = Text -> Html -> Html
divClass Text
"observation-general" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html -> Html
tableWithShadow Text
"" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
        Text -> Text -> Html
forall a. ToMarkup a => Text -> a -> Html
tableR Text
"ID"            (Id Observation -> Text
forall a. Id a -> Text
unId Id Observation
observationId)
        Text -> Html -> Html
forall a. ToMarkup a => Text -> a -> Html
tableR Text
"Severity"      (Inspection -> Html
severityFromIns Inspection
inspection)
        Text -> Text -> Html
forall a. ToMarkup a => Text -> a -> Html
tableR Text
"Description"   (Inspection -> Text
inspectionDescription Inspection
inspection)
        Text -> Html -> Html
forall a. ToMarkup a => Text -> a -> Html
tableR Text
"Inspection ID" (Id Inspection -> Html
inspectionLink Id Inspection
observationInspectionId)
        Text -> Html -> Html
forall a. ToMarkup a => Text -> a -> Html
tableR Text
"Category"      (Text -> NonEmpty Category -> Html
categories Text
"inline" (NonEmpty Category -> Html) -> NonEmpty Category -> Html
forall a b. (a -> b) -> a -> b
$ Inspection -> NonEmpty Category
inspectionCategory Inspection
inspection)
        Text -> String -> Html
forall a. ToMarkup a => Text -> a -> Html
tableR Text
"File"          String
observationFile

    tableR :: ToMarkup a => Text -> a -> Html
    tableR :: forall a. ToMarkup a => Text -> a -> Html
tableR Text
name a
val = Html -> Html
tr (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
        Html -> Html
td (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"info-name very-light-bg" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
toHtml Text
name
        Html -> Html
td (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"info-data" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ a -> Html
forall a. ToMarkup a => a -> Html
toHtml a
val

    inspection :: Inspection
    inspection :: Inspection
inspection = Id Inspection -> Inspection
getInspectionById Id Inspection
observationInspectionId

severityFromIns :: Inspection -> Html
severityFromIns :: Inspection -> Html
severityFromIns Inspection
ins = Text -> Html
severity (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$ forall b a. (Show a, IsString b) => a -> b
show @Text (Severity -> Text) -> Severity -> Text
forall a b. (a -> b) -> a -> b
$ Inspection -> Severity
inspectionSeverity Inspection
ins

severity :: Text -> Html
severity :: Text -> Html
severity Text
severityTxt = Html -> Html
span (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"severity" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
    Html -> Html
span (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ (Text -> AttributeValue
forall s. IsString s => Text -> s
fromText (Text -> AttributeValue) -> Text -> AttributeValue
forall a b. (a -> b) -> a -> b
$ Text
"severity" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
severityTxt) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ forall a. ToMarkup a => a -> Html
toHtml @Text Text
""
    Html -> Html
span (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"severityText" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
toHtml Text
severityTxt

categories :: Text -> NonEmpty Category -> Html
categories :: Text -> NonEmpty Category -> Html
categories Text
cl NonEmpty Category
cats = Html -> Html
ul (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ (Text -> AttributeValue
forall s. IsString s => Text -> s
fromText (Text -> AttributeValue) -> Text -> AttributeValue
forall a b. (a -> b) -> a -> b
$ Text
"cats " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
cl)
    (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ (Category -> Html) -> [Category] -> Html
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ((Html -> Html
li (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"cat") (Html -> Html) -> (Category -> Html) -> Category -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Html
forall a. ToMarkup a => a -> Html
toHtml (Text -> Html) -> (Category -> Text) -> Category -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Category -> Text
unCategory)
    ([Category] -> Html) -> [Category] -> Html
forall a b. (a -> b) -> a -> b
$ NonEmpty Category -> [Category]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty Category
cats

solutionsDiv :: Inspection -> Html
solutionsDiv :: Inspection -> Html
solutionsDiv Inspection
ins = Bool -> Html -> Html
forall m. Monoid m => Bool -> m -> m
memptyIfTrue ([Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
solutions) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html -> Html
divClass Text
"solutions border-shadow" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
    Html -> Html
h4 Html
"Possible solutions"
    [Text] -> Html
forall a. ToMarkup a => [a] -> Html
uList [Text]
solutions
  where
    solutions :: [Text]
    solutions :: [Text]
solutions = Inspection -> [Text]
inspectionSolution Inspection
ins

stanInspections :: HashSet (Id Inspection) -> Html
stanInspections :: HashSet (Id Inspection) -> Html
stanInspections HashSet (Id Inspection)
ins = do
    Text -> Html -> Html
divClass Text
"row" (Text -> Html
blockP Text
"List of Inspections used for analysing the project")
    Html -> Html
div (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ (Id Inspection -> Html) -> [Id Inspection] -> Html
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Id Inspection -> Html
stanInspection ([Id Inspection] -> Html) -> [Id Inspection] -> Html
forall a b. (a -> b) -> a -> b
$ (Id Inspection -> Text) -> [Id Inspection] -> [Id Inspection]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortWith Id Inspection -> Text
forall a. Id a -> Text
unId ([Id Inspection] -> [Id Inspection])
-> [Id Inspection] -> [Id Inspection]
forall a b. (a -> b) -> a -> b
$ HashSet (Id Inspection) -> [Id Inspection]
forall a. HashSet a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList HashSet (Id Inspection)
ins

stanInspection :: Id Inspection -> Html
stanInspection :: Id Inspection -> Html
stanInspection (Id Inspection -> Inspection
getInspectionById -> ins :: Inspection
ins@Inspection{[Text]
NonEmpty Category
Text
Id Inspection
Severity
InspectionAnalysis
inspectionDescription :: Inspection -> Text
inspectionCategory :: Inspection -> NonEmpty Category
inspectionSeverity :: Inspection -> Severity
inspectionSolution :: Inspection -> [Text]
inspectionId :: Id Inspection
inspectionName :: Text
inspectionDescription :: Text
inspectionSolution :: [Text]
inspectionCategory :: NonEmpty Category
inspectionSeverity :: Severity
inspectionAnalysis :: InspectionAnalysis
inspectionId :: Inspection -> Id Inspection
inspectionName :: Inspection -> Text
inspectionAnalysis :: Inspection -> InspectionAnalysis
..}) = do
    Html -> Html
button (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"collapsible" (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id (Text -> AttributeValue
forall s. IsString s => Text -> s
fromText Text
insId) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
      Text -> Html
forall a. ToMarkup a => a -> Html
toHtml (Text
"Explore Inspection " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
insId)
    Text -> Html -> Html
divClass Text
"content row" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Html -> Html
divIdClass (Text
insId Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-content") Text
"inspection col-12" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
        Html -> Html
h3 (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
toHtml (Text
"Inspection " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
insId)
        Html -> Html
p (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
strong (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
toHtml Text
inspectionName
        Html -> Html
p (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
em (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
toHtml Text
inspectionDescription
        Html -> Html
div (Inspection -> Html
severityFromIns Inspection
ins)
        Html -> Html
div (Text -> NonEmpty Category -> Html
categories Text
"" NonEmpty Category
inspectionCategory)
        Inspection -> Html
solutionsDiv Inspection
ins
  where
    insId :: Text
    insId :: Text
insId = Id Inspection -> Text
forall a. Id a -> Text
unId Id Inspection
inspectionId

stanConfig :: Analysis -> Config -> [Text] -> Html
stanConfig :: Analysis -> Config -> [Text] -> Html
stanConfig Analysis{Int
(Set OnOffExtension, Set SafeHaskellExtension)
FileMap
HashSet (Id Inspection)
Observations
analysisInspections :: Analysis -> HashSet (Id Inspection)
analysisModulesNum :: Analysis -> Int
analysisLinesOfCode :: Analysis -> Int
analysisUsedExtensions :: Analysis -> (Set OnOffExtension, Set SafeHaskellExtension)
analysisObservations :: Analysis -> Observations
analysisIgnoredObservations :: Analysis -> Observations
analysisFileMap :: Analysis -> FileMap
analysisModulesNum :: Int
analysisLinesOfCode :: Int
analysisUsedExtensions :: (Set OnOffExtension, Set SafeHaskellExtension)
analysisInspections :: HashSet (Id Inspection)
analysisObservations :: Observations
analysisIgnoredObservations :: Observations
analysisFileMap :: FileMap
..} Config
config [Text]
warnings = Text -> Html -> Html
divClass Text
"col-12" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
    Text -> Html -> Html
divClass Text
"row" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
blockP (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
        [ Text
"This section describes the final Stan configuration that was used on "
        , Text
"the project and explains how this result was assembled. Stan runtime "
        , Text
"settings have many parts, and each of them can come from different "
        , Text
"configuration sources. Stan is using Environment variables, TOML "
        , Text
"configuration file and CLI arguments to get the final results. If some "
        , Text
"option is specified through the multiple sources, the most prioritized "
        , Text
"one is used. "
        ]
    Text -> Html -> Html
divClass Text
"row" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
table (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
        Html -> Html
tr (Html -> Html
th Html
"Action" Html -> Html -> Html
forall a b. MarkupM a -> MarkupM b -> MarkupM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html -> Html
th Html
"Filter" Html -> Html -> Html
forall a b. MarkupM a -> MarkupM b -> MarkupM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html -> Html
th Html
"Scope")
        ((ConfigAction, Text, Text) -> Html)
-> [(ConfigAction, Text, Text)] -> Html
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (ConfigAction, Text, Text) -> Html
toRows (Config -> [(ConfigAction, Text, Text)]
configToTriples Config
config)
    Text -> Html -> Html
divClass Text
"ignored-observations row" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
        [Id Observation] -> Text -> Text -> Html
forall a. [Id a] -> Text -> Text -> Html
toUl [Id Observation]
ignoredIds Text
"Ignored Observations"
            Text
"These observations are flagged as ignored through the configurations and are not considered in the final report"
        [Id Observation] -> Text -> Text -> Html
forall a. [Id a] -> Text -> Text -> Html
toUl [Id Observation]
unknownIds Text
"Unrecognised Observations"
            Text
"Some observation IDs specified in the configurations are not found"
    Text -> Html -> Html
divClass Text
"config-warnings row" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
        Html -> Html
h4 Html
"Configuration Process Information"
        Html -> Html
p (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
            Html
"Information and warnings that were gathered during the configuration assemble process. "
          Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
"This helps to understand how different parts of the configurations were retrieved."
        [Text] -> Html
forall a. ToMarkup a => [a] -> Html
uList [Text]
warnings
  where
    toRows :: (ConfigAction, Text, Text) -> Html
    toRows :: (ConfigAction, Text, Text) -> Html
toRows (ConfigAction
act, Text
fil, Text
sc) = Html -> Html
tr (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
!
      AttributeValue -> Attribute
A.class_ (Text -> AttributeValue
forall s. IsString s => Text -> s
fromText (Text -> AttributeValue) -> Text -> AttributeValue
forall a b. (a -> b) -> a -> b
$ ConfigAction -> Text
configActionClass ConfigAction
act) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
        Html -> Html
td (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"centre" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
span (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
strong (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
toHtml (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$ ConfigAction -> Text
prettyConfigAction ConfigAction
act
        Html -> Html
td (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
toHtml Text
fil
        Html -> Html
td (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
toHtml Text
sc

    toUl :: [Id a] -> Text -> Text -> Html
    toUl :: forall a. [Id a] -> Text -> Text -> Html
toUl [Id a]
ids Text
headerTxt Text
desc = Bool -> Html -> Html
forall m. Monoid m => Bool -> m -> m
memptyIfTrue ([Id a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Id a]
ids) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html -> Html
divClass Text
"ignored-obs" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
        Html -> Html
h4 (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
toHtml Text
headerTxt
        Html -> Html
p (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
toHtml Text
desc
        [Text] -> Html
forall a. ToMarkup a => [a] -> Html
uList ([Text] -> Html) -> [Text] -> Html
forall a b. (a -> b) -> a -> b
$ (Id a -> Text) -> [Id a] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Id a -> Text
forall a. Id a -> Text
unId [Id a]
ids

    ignoredIds, unknownIds :: [Id Observation]
    ([Id Observation]
ignoredIds, [Id Observation]
unknownIds) = [Id Observation]
-> Observations -> ([Id Observation], [Id Observation])
ignoredObservations
        (Config -> 'Final ::- [Id Observation]
forall (p :: Phase Text). ConfigP p -> p ::- [Id Observation]
configIgnored Config
config)
        Observations
analysisIgnoredObservations

stanSeverityExplained :: Html
stanSeverityExplained :: Html
stanSeverityExplained = do
    Text -> Html -> Html
divClass Text
"col-5" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
        Text -> Html
blockP Text
"We are using the following severity system to indicate the observation level"

    Text -> Html -> Html
tableWithShadow Text
"col-7" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
        Html -> Html
tr (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! Attribute
greyBg (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ (Html -> Html
th Html
"Severity" Html -> Html -> Html
forall a b. MarkupM a -> MarkupM b -> MarkupM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html -> Html
th Html
"Description")
        (Severity -> Html) -> [Severity] -> Html
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Severity -> Html
toSeverityRow (forall a. (Bounded a, Enum a) => [a]
universe @Severity)
  where
    toSeverityRow :: Severity -> Html
    toSeverityRow :: Severity -> Html
toSeverityRow Severity
s = Html -> Html
tr (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
        Html -> Html
td (Text -> Html
severity (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$ Severity -> Text
forall b a. (Show a, IsString b) => a -> b
show Severity
s)
        Html -> Html
td (Text -> Html
forall a. ToMarkup a => a -> Html
toHtml (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$ Severity -> Text
severityDescription Severity
s)

stanFooter :: Html
stanFooter :: Html
stanFooter = Html -> Html
footer (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
    Text -> Html -> Html
divClass Text
"container" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
        Text -> Html -> Html
divClass Text
"row footer-link" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
            Html -> Html
span Html
"This report was generated by "
            Html -> Html
a (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href AttributeValue
"https://github.com/kowainik/stan" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
                forall a. ToMarkup a => a -> Html
toHtml @Text Text
"Stan — Haskell Static Analysis Tool."
        Text -> Html -> Html
divClass Text
"row footer-link" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
            Html -> Html
span Html
"Stan is created and maintained by "
            Html -> Html
a (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href AttributeValue
"https://kowainik.github.io" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ forall a. ToMarkup a => a -> Html
toHtml @Text Text
"Kowainik"
    Html -> Html
nav (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"row centre" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
h3 (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
strong Html
"© Kowainik 2020"

stanHead :: Html
stanHead :: Html
stanHead = Html -> Html
head (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
    Html
meta Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! (AttributeValue -> Attribute
A.httpEquiv AttributeValue
"Content-Type" Attribute -> Attribute -> Attribute
forall a. Semigroup a => a -> a -> a
<> AttributeValue -> Attribute
A.content AttributeValue
"text/html; charset=UTF-8")
    Html
meta Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! (AttributeValue -> Attribute
A.httpEquiv AttributeValue
"X-UA-Compatible" Attribute -> Attribute -> Attribute
forall a. Semigroup a => a -> a -> a
<> AttributeValue -> Attribute
A.content AttributeValue
"IE=Edge")
    AttributeValue -> AttributeValue -> Html
nameContent AttributeValue
"viewport" AttributeValue
"width=device-width, initial-scale=1.0"
    AttributeValue -> AttributeValue -> Html
nameContent AttributeValue
"description" AttributeValue
"Stan Report"
    AttributeValue -> AttributeValue -> Html
nameContent AttributeValue
"keywords" AttributeValue
"Haskell, Static Analysis"
    AttributeValue -> AttributeValue -> Html
nameContent AttributeValue
"author" AttributeValue
"Kowainik"
    Html -> Html
title Html
"Stan Report"

    Html -> Html
style (Text -> Html
forall a. ToMarkup a => a -> Html
toHtml (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$ Config -> [App] -> Css -> Text
renderWith Config
compact [] Css
stanCss)
  where
    nameContent :: AttributeValue -> AttributeValue -> Html
nameContent AttributeValue
x AttributeValue
y = Html
meta Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! (AttributeValue -> Attribute
A.name AttributeValue
x Attribute -> Attribute -> Attribute
forall a. Semigroup a => a -> a -> a
<> AttributeValue -> Attribute
A.content AttributeValue
y)

stanJs :: Html
stanJs :: Html
stanJs = Html -> Html
script (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ String -> Html
forall a. ToMarkup a => a -> Html
toHtml (String -> Html) -> String -> Html
forall a b. (a -> b) -> a -> b
$ [String] -> String
List.unlines
    [ String
"var coll = document.getElementsByClassName(\"collapsible\");"
    , String
"var i;"
    , String
""
    , String
"for (i = 0; i < coll.length; i++) {"
    , String
"  coll[i].addEventListener(\"click\", function() {"
    , String
"    this.classList.toggle(\"active\");"
    , String
"    var content = this.nextElementSibling;"
    , String
"    if (content.style.maxHeight){"
    , String
"      content.style.maxHeight = null;"
    , String
"    } else {"
    , String
"      content.style.maxHeight = content.scrollHeight + \"px\";"
    , String
"    }"
    , String
"  });"
    , String
"}"
    ]

divClass :: Text -> Html -> Html
divClass :: Text -> Html -> Html
divClass Text
c = Html -> Html
div (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ (Text -> AttributeValue
forall s. IsString s => Text -> s
fromText Text
c)

divIdClass :: Text -> Text -> Html -> Html
divIdClass :: Text -> Text -> Html -> Html
divIdClass Text
aId Text
c = Html -> Html
div (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! (AttributeValue -> Attribute
A.id (Text -> AttributeValue
forall s. IsString s => Text -> s
fromText Text
aId) Attribute -> Attribute -> Attribute
forall a. Semigroup a => a -> a -> a
<> AttributeValue -> Attribute
A.class_ (Text -> AttributeValue
forall s. IsString s => Text -> s
fromText Text
c))

divIdClassH :: Text -> Text -> Html -> Html
divIdClassH :: Text -> Text -> Html -> Html
divIdClassH Text
h Text
c Html
rest = Text -> Text -> Html -> Html
divIdClass (Text -> Text
hToId Text
h) Text
c (Html -> Html
h2 (Text -> Html
forall a. ToMarkup a => a -> Html
toHtml Text
h) Html -> Html -> Html
forall a b. MarkupM a -> MarkupM b -> MarkupM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html
rest)

blockP :: Text -> Html
blockP :: Text -> Html
blockP = Html -> Html
blockquote (Html -> Html) -> (Text -> Html) -> Text -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> Html
p (Html -> Html) -> (Text -> Html) -> Text -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Html
forall a. ToMarkup a => a -> Html
toHtml

tableRow :: ToMarkup a => Text -> a -> Html
tableRow :: forall a. ToMarkup a => Text -> a -> Html
tableRow Text
name a
val = Html -> Html
tr (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
    Html -> Html
td (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"info-name" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
toHtml Text
name
    Html -> Html
td (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"info-data very-light-bg" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ a -> Html
forall a. ToMarkup a => a -> Html
toHtml a
val

tableWithShadow :: Text -> Html -> Html
tableWithShadow :: Text -> Html -> Html
tableWithShadow Text
cl = Html -> Html
table (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ (Text -> AttributeValue
forall s. IsString s => Text -> s
fromText (Text -> AttributeValue) -> Text -> AttributeValue
forall a b. (a -> b) -> a -> b
$ Text
"border-shadow " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
cl)

uList :: ToMarkup a => [a] -> Html
uList :: forall a. ToMarkup a => [a] -> Html
uList = Html -> Html
ul (Html -> Html) -> ([a] -> Html) -> [a] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Html) -> [a] -> Html
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Html -> Html
li (Html -> Html) -> (a -> Html) -> a -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Html
forall a. ToMarkup a => a -> Html
toHtml)

greyBg :: Attribute
greyBg :: Attribute
greyBg = AttributeValue -> Attribute
A.class_ AttributeValue
"grey-bg"

hToId :: Text -> Text
hToId :: Text -> Text
hToId = Text -> [Text] -> Text
T.intercalate Text
"-" ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
T.toLower ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
forall t. IsText t "words" => t -> [t]
words

fromText :: IsString s => Text -> s
fromText :: forall s. IsString s => Text -> s
fromText = String -> s
forall a. IsString a => String -> a
fromString (String -> s) -> (Text -> String) -> Text -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
forall a. ToString a => a -> String
toString