stan-0.0.0.0: src/Stan/Report/Html.hs
{- |
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)
import Relude.Extra.Enum (universe)
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 an config warnings env project =
docTypeHtml (stanHead >> stanBody)
where
stanBody :: Html
stanBody = body $ do
stanHeader
stanMain an config warnings env project
stanFooter
stanJs
stanHeader :: Html
stanHeader = header ! A.class_ "centre" $ do
divClass "row" (h1 "Stan Report")
nav ! A.class_ "row" $ do
navItem "General Info"
navItem "Observations"
navItem "Configurations"
navItem "Report Explained"
where
navItem :: Text -> Html
navItem h = divClass "col-3 nav-item"
(a ! A.href (fromText $ "#" <> hToId h) $ toHtml h)
stanMain :: Analysis -> Config -> [Text] -> StanEnv -> ProjectInfo -> Html
stanMain an config warnings env project = main ! A.class_ "container" $ do
divClass "row" stanIntro
divIdClassH "Stan Info" "row" (stanInfo env)
divIdClass "general-info" "row" $ do
divIdClassH "Project Info" "col-6" (stanProject project)
divIdClassH "Analysis Info" "col-6" (stanAnalysis analysisNumbers)
divIdClassH "Static Analysis Summary" "row" (stanSummary an analysisNumbers)
-- divIdClassH "Graphs" "row" (p_ "Maybe later")
divIdClassH "Observations" "row" (stanObservations an)
divIdClassH "Configurations" "row" (stanConfig an config warnings)
-- divIdClassH "Summary" "row" (p_ "Later")
divIdClassH "Report Explained" "" $ do
divIdClassH "Inspections" "row" $ stanInspections (analysisInspections an)
divIdClassH "Severity" "row" stanSeverityExplained
where
analysisNumbers :: AnalysisNumbers
analysisNumbers = analysisToNumbers an
stanIntro :: Html
stanIntro = p $ do
toHtml @Text "This is the Haskell Static Analysis report generated by "
a ! A.href "https://kowainik.github.io/projects/stan" ! A.class_ "ins-link" $
toHtml @Text "Stan"
stanInfo :: StanEnv -> Html
stanInfo StanEnv{..} = do
let StanVersion{..} = stanVersion
let StanSystem{..} = stanSystem
divClass "row" $ blockP $ fold
[ "In this section, you can find the general information about the used "
, "Stan tool, compile-time and run-time environment "
, "variables and settings, including build information, system data and "
, "execution configurations."
]
divClass "col-10" $
table ! (A.class_ "border-shadow" <> A.style "table-layout:fixed") $ do
colgroup (col ! A.style "width:25%" >> col)
tr2 "Stan Version"
tableRow "Version" svVersion
tableRow "Git Revision" svGitRevision
tableRow "Release Date" svCommitDate
tr2 "System Info"
tableRow "Operating System" ssOs
tableRow "Architecture" ssArch
tableRow "Compiler" ssCompiler
tableRow "Compiler Version" ssCompilerVersion
tr2 "Environment"
tableRow "Environment Variables" seEnvVars
tableRow "TOML configuration files" (traverse_ toHtml seTomlFiles)
tableRow "CLI arguments" (List.unwords seCliArgs)
where
tr2 x = tr $ td ! (A.colspan "2" <> A.class_ "centre grey-bg") $ strong x
stanProject :: ProjectInfo -> Html
stanProject ProjectInfo{..} = do
divClass "row" (blockP "Information about the analysed project")
tableWithShadow "" $ do
colgroup (col ! A.class_ "info-name" >> col ! A.class_ "info-data")
tableRow "Project name" piName
tableRow "Cabal Files" (List.unwords piCabalFiles)
tableRow "HIE Files Directory" piHieDir
tableRow "Files Number" piFileNumber
stanAnalysis :: AnalysisNumbers -> Html
stanAnalysis AnalysisNumbers{..} = do
divClass "row" (blockP "Summary stats from the static analysis")
tableWithShadow "" $ do
tableRow "Modules" anModules
tableRow "LoC" anLoc
tableRow "Extensions" anExts
tableRow "SafeHaskel Extensions" anSafeExts
tableRow "Available inspections" (HM.size inspectionsMap)
tableRow "Checked inspections" anIns
tableRow "Found Observations" anFoundObs
tableRow "Ignored Observations" anIgnoredObs
stanSummary :: Analysis -> AnalysisNumbers -> Html
stanSummary analysis AnalysisNumbers{..} = do
divClass "row" (blockP "Here you can find the overall conclusion based on the various metadata and gathered information during the work of Stan on this project.")
ul ! A.class_ "col-10" $ do
liSum $ do
h4 (toHtml $ "Project health: " <> prettyHealth anHealth)
span $ toHtml @Text $ fold
[ "This number was calculated based on the total number of used inspections "
, "and the number of triggered inspections in the project. The calculated number "
, "also defines the overall project health status."
]
liSum $ do
h4 (toHtml $ "The project " <> showProjectHealth projectHealth)
span $ toHtml $ showHealthConclusions projectHealth
summary
where
projectHealth :: ProjectHealth
projectHealth = toProjectHealth anHealth
showProjectHealth :: ProjectHealth -> Text
showProjectHealth = \case
Unhealthy -> "is unhealthy"
LowHealth -> "has low health"
MediumHealth -> "has medium health"
Healthy -> "is healthy"
showHealthConclusions :: ProjectHealth -> Text
showHealthConclusions = fold . \case
Unhealthy ->
[ "According to the Stan analysis, the project has a lot of vulnerabilities. "
, "But this also means that there is a room for improving code quality! "
, "Don't give up and continue doing great work!"
]
LowHealth ->
[ "According to the Stan analysis, the project has issues of a different variety. But you can improve that! "
, "Stan provides solutions to the observed problems to help you improve the code quality."
]
MediumHealth ->
[ "Stan discovered several potential issues in the project. "
, "Nice job, the overall project quality is good. And you can easily make it even better!"
]
Healthy ->
[ "Excellent work! Stan haven't found any vulnerabilities in the code."
]
summary :: Html
summary = case createSummary analysis of
Nothing -> liSum $ do
h4 "Congratulations! Your project has zero vulnerabilities!"
span "Stan carefully run all configured inspection and found 0 observations and vulnerabilities to the project."
Just Summary{..} -> do
liSum $ do
h4 $ toHtml ("Watch out for " <> unId summaryInspectionId)
span $ do
toHtml @Text "By the result of Stan analysis, the most common inspection for this project is "
inspectionLink summaryInspectionId
liSum $ do
h4 $ toHtml ("Vulnerable module: " <> unModuleName summaryModule)
span $ do
toHtml @Text "The "
code (toHtml $ unModuleName summaryModule)
toHtml @Text " module is the most vulnerable one in the project, as it got the most number of observations"
liSum $ do
h4 (toHtml $ "Popular category: " <> unCategory summaryCategory)
categories "inline" $ one summaryCategory
toHtml @Text "The project has the most problems with inspections from this category"
liSum $ do
h4 $ toHtml ("Severity: " <> show @Text summarySeverity)
toHtml @Text "The highest severity of found vulnerabilities is "
severity (show @Text summarySeverity)
liSum :: Html -> Html
liSum = li ! A.class_ "sum"
stanObservations :: Analysis -> Html
stanObservations Analysis{..} = do
divClass "row" $ blockP $ fold
[ "Based on the analysis results, Stan found different vulnerabilities "
, "distributed among the analysed files. In Stan terminology, we call such "
, "vulnerability as Observation. Below you can see the more detailed "
, "information about each observation, and find the possible ways to fix "
, "them for your project."
]
traverse_ stanPerFile $
filter (not . null . fileInfoObservations) $ Map.elems analysisFileMap
stanPerFile :: FileInfo -> Html
stanPerFile FileInfo{..} = divIdClass "file" "row" $ do
h3 ! A.class_ "grey-bg" $ toHtml $ "📄 " <> fileInfoPath
ul $ do
li $ tableWithShadow "col-6" $ do
tableRow "Module" $ code $ toHtml $ unModuleName fileInfoModuleName
tableRow "Lines of Code" fileInfoLoc
li $ divClass "extensions" $ do
stanExtensions ".cabal" (extensionsToText fileInfoCabalExtensions)
stanExtensions "module" (extensionsToText fileInfoExtensions)
li ! A.class_ "col-12 obs-li" $ divClass "observations col-12" $ do
h4 "Observations"
traverse_ stanObservation $ S.sortOn observationLoc fileInfoObservations
stanExtensions :: Text -> [Text] -> Html
stanExtensions from exts = divClass "col-6" $ do
button ! A.class_ "collapsible" $ toHtml $ "Extensions from " <> from
ol ! A.class_ "content" $ traverse_ (li . toHtml) exts
inspectionLink :: Id Inspection -> Html
inspectionLink ins = a ! A.class_ "ins-link" ! A.href (fromText $ "#" <> insId) $ toHtml insId
where
insId :: Text
insId = unId ins
stanObservation :: Observation -> Html
stanObservation o@Observation{..} = divIdClass (unId observationId) "observation row" $ do
general
pre $ toHtml (unlines $ prettyObservationSource False o)
solutionsDiv inspection
where
general = divClass "observation-general" $ tableWithShadow "" $ do
tableR "ID" (unId observationId)
tableR "Severity" (severityFromIns inspection)
tableR "Description" (inspectionDescription inspection)
tableR "Inspection ID" (inspectionLink observationInspectionId)
tableR "Category" (categories "inline" $ inspectionCategory inspection)
tableR "File" observationFile
tableR :: ToMarkup a => Text -> a -> Html
tableR name val = tr $ do
td ! A.class_ "info-name very-light-bg" $ toHtml name
td ! A.class_ "info-data" $ toHtml val
inspection :: Inspection
inspection = getInspectionById observationInspectionId
severityFromIns :: Inspection -> Html
severityFromIns ins = severity $ show @Text $ inspectionSeverity ins
severity :: Text -> Html
severity severityTxt = span ! A.class_ "severity" $ do
span ! A.class_ (fromText $ "severity" <> severityTxt) $ toHtml @Text ""
span ! A.class_ "severityText" $ toHtml severityTxt
categories :: Text -> NonEmpty Category -> Html
categories cl cats = ul ! A.class_ (fromText $ "cats " <> cl)
$ traverse_ ((li ! A.class_ "cat") . toHtml . unCategory)
$ toList cats
solutionsDiv :: Inspection -> Html
solutionsDiv ins = memptyIfTrue (null solutions) $ divClass "solutions border-shadow" $ do
h4 "Possible solutions"
uList solutions
where
solutions :: [Text]
solutions = inspectionSolution ins
stanInspections :: HashSet (Id Inspection) -> Html
stanInspections ins = do
divClass "row" (blockP "List of Inspections used for analysing the project")
div $ traverse_ stanInspection $ sortWith unId $ toList ins
stanInspection :: Id Inspection -> Html
stanInspection (getInspectionById -> ins@Inspection{..}) = do
button ! A.class_ "collapsible" ! A.id (fromText insId) $
toHtml ("Explore Inspection " <> insId)
divClass "content row" $ divIdClass (insId <> "-content") "inspection col-12" $ do
h3 $ toHtml ("Inspection " <> insId)
p $ strong $ toHtml inspectionName
p $ em $ toHtml inspectionDescription
div (severityFromIns ins)
div (categories "" inspectionCategory)
solutionsDiv ins
where
insId :: Text
insId = unId inspectionId
stanConfig :: Analysis -> Config -> [Text] -> Html
stanConfig Analysis{..} config warnings = divClass "col-12" $ do
divClass "row" $ blockP $ fold
[ "This section describes the final Stan configuration that was used on "
, "the project and explains how this result was assembled. Stan runtime "
, "settings have many parts, and each of them can come from different "
, "configuration sources. Stan is using Environment variables, TOML "
, "configuration file and CLI arguments to get the final results. If some "
, "option is specified through the multiple sources, the most prioritized "
, "one is used. "
]
divClass "row" $ table $ do
tr (th "Action" >> th "Filter" >> th "Scope")
traverse_ toRows (configToTriples config)
divClass "ignored-observations row" $ do
toUl ignoredIds "Ignored Observations"
"These observations are flagged as ignored through the configurations and are not considered in the final report"
toUl unknownIds "Unrecognised Observations"
"Some observation IDs specified in the configurations are not found"
divClass "config-warnings row" $ do
h4 "Configuration Process Information"
p $
"Information and warnings that were gathered during the configuration assemble process. "
<> "This helps to understand how different parts of the configurations were retrieved."
uList warnings
where
toRows :: (ConfigAction, Text, Text) -> Html
toRows (act, fil, sc) = tr !
A.class_ (fromText $ configActionClass act) $ do
td ! A.class_ "centre" $ span $ strong $ toHtml $ prettyConfigAction act
td $ toHtml fil
td $ toHtml sc
toUl :: [Id a] -> Text -> Text -> Html
toUl ids headerTxt desc = memptyIfTrue (null ids) $ divClass "ignored-obs" $ do
h4 $ toHtml headerTxt
p $ toHtml desc
uList $ map unId ids
ignoredIds, unknownIds :: [Id Observation]
(ignoredIds, unknownIds) = ignoredObservations
(configIgnored config)
analysisIgnoredObservations
stanSeverityExplained :: Html
stanSeverityExplained = do
divClass "col-5" $
blockP "We are using the following severity system to indicate the observation level"
tableWithShadow "col-7" $ do
tr ! greyBg $ (th "Severity" >> th "Description")
traverse_ toSeverityRow (universe @Severity)
where
toSeverityRow :: Severity -> Html
toSeverityRow s = tr $ do
td (severity $ show s)
td (toHtml $ severityDescription s)
stanFooter :: Html
stanFooter = footer $ do
divClass "container" $ do
divClass "row footer-link" $ do
span "This report was generated by "
a ! A.href "https://github.com/kowainik/stan" $
toHtml @Text "Stan — Haskell Static Analysis Tool."
divClass "row footer-link" $ do
span "Stan is created and maintained by "
a ! A.href "https://kowainik.github.io" $ toHtml @Text "Kowainik"
nav ! A.class_ "row centre" $ h3 $ strong "© Kowainik 2020"
stanHead :: Html
stanHead = head $ do
meta ! (A.httpEquiv "Content-Type" <> A.content "text/html; charset=UTF-8")
meta ! (A.httpEquiv "X-UA-Compatible" <> A.content "IE=Edge")
nameContent "viewport" "width=device-width, initial-scale=1.0"
nameContent "description" "Stan Report"
nameContent "keywords" "Haskell, Static Analysis"
nameContent "author" "Kowainik"
title "Stan Report"
style (toHtml $ renderWith compact [] stanCss)
where
nameContent x y = meta ! (A.name x <> A.content y)
stanJs :: Html
stanJs = script $ toHtml $ List.unlines
[ "var coll = document.getElementsByClassName(\"collapsible\");"
, "var i;"
, ""
, "for (i = 0; i < coll.length; i++) {"
, " coll[i].addEventListener(\"click\", function() {"
, " this.classList.toggle(\"active\");"
, " var content = this.nextElementSibling;"
, " if (content.style.maxHeight){"
, " content.style.maxHeight = null;"
, " } else {"
, " content.style.maxHeight = content.scrollHeight + \"px\";"
, " }"
, " });"
, "}"
]
divClass :: Text -> Html -> Html
divClass c = div ! A.class_ (fromText c)
divIdClass :: Text -> Text -> Html -> Html
divIdClass aId c = div ! (A.id (fromText aId) <> A.class_ (fromText c))
divIdClassH :: Text -> Text -> Html -> Html
divIdClassH h c rest = divIdClass (hToId h) c (h2 (toHtml h) >> rest)
blockP :: Text -> Html
blockP = blockquote . p . toHtml
tableRow :: ToMarkup a => Text -> a -> Html
tableRow name val = tr $ do
td ! A.class_ "info-name" $ toHtml name
td ! A.class_ "info-data very-light-bg" $ toHtml val
tableWithShadow :: Text -> Html -> Html
tableWithShadow cl = table ! A.class_ (fromText $ "border-shadow " <> cl)
uList :: ToMarkup a => [a] -> Html
uList = ul . traverse_ (li . toHtml)
greyBg :: Attribute
greyBg = A.class_ "grey-bg"
hToId :: Text -> Text
hToId = T.intercalate "-" . map T.toLower . words
fromText :: IsString s => Text -> s
fromText = fromString . toString