{- |
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 :: Analysis -> Config -> [Text] -> StanEnv -> ProjectInfo -> Html
stanHtml an :: Analysis
an config :: Config
config warnings :: [Text]
warnings env :: StanEnv
env project :: ProjectInfo
project =
    Html -> Html
docTypeHtml (Html
stanHead Html -> Html -> Html
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_ "centre" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
    Text -> Html -> Html
divClass "row" (Html -> Html
h1 "Stan Report")
    Html -> Html
nav (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ "row" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
      Text -> Html
navItem "General Info"
      Text -> Html
navItem "Observations"
      Text -> Html
navItem "Configurations"
      Text -> Html
navItem "Report Explained"
  where
    navItem :: Text -> Html
    navItem :: Text -> Html
navItem h :: Text
h = Text -> Html -> Html
divClass "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
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 an :: Analysis
an config :: Config
config warnings :: [Text]
warnings env :: StanEnv
env project :: ProjectInfo
project = Html -> Html
main (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ "container" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
    Text -> Html -> Html
divClass "row" Html
stanIntro
    Text -> Text -> Html -> Html
divIdClassH "Stan Info" "row" (StanEnv -> Html
stanInfo StanEnv
env)
    Text -> Text -> Html -> Html
divIdClass "general-info" "row" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
        Text -> Text -> Html -> Html
divIdClassH "Project Info" "col-6" (ProjectInfo -> Html
stanProject ProjectInfo
project)
        Text -> Text -> Html -> Html
divIdClassH "Analysis Info" "col-6" (AnalysisNumbers -> Html
stanAnalysis AnalysisNumbers
analysisNumbers)
    Text -> Text -> Html -> Html
divIdClassH "Static Analysis Summary" "row" (Analysis -> AnalysisNumbers -> Html
stanSummary Analysis
an AnalysisNumbers
analysisNumbers)
    -- divIdClassH "Graphs" "row" (p_ "Maybe later")
    Text -> Text -> Html -> Html
divIdClassH "Observations" "row" (Analysis -> Html
stanObservations Analysis
an)
    Text -> Text -> Html -> Html
divIdClassH "Configurations" "row" (Analysis -> Config -> [Text] -> Html
stanConfig Analysis
an Config
config [Text]
warnings)
    -- divIdClassH "Summary" "row" (p_ "Later")
    Text -> Text -> Html -> Html
divIdClassH "Report Explained" "" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
        Text -> Text -> Html -> Html
divIdClassH "Inspections" "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 "Severity" "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
    Text -> Html
forall a. ToMarkup a => a -> Html
toHtml @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 "https://kowainik.github.io/projects/stan" (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ "ins-link" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
        Text -> Html
forall a. ToMarkup a => a -> Html
toHtml @Text "Stan"

stanInfo :: StanEnv -> Html
stanInfo :: StanEnv -> Html
stanInfo StanEnv{..} = do
    let StanVersion{..} = StanVersion
stanVersion
    let StanSystem{..} = StanSystem
stanSystem
    Text -> Html -> Html
divClass "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 (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
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."
       ]
    Text -> Html -> Html
divClass "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_ "border-shadow" Attribute -> Attribute -> Attribute
forall a. Semigroup a => a -> a -> a
<> AttributeValue -> Attribute
A.style "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 "width:25%" Html -> Html -> Html
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html
col)
            Html -> Html
tr2 "Stan Version"
            Text -> String -> Html
forall a. ToMarkup a => Text -> a -> Html
tableRow "Version"       String
svVersion
            Text -> String -> Html
forall a. ToMarkup a => Text -> a -> Html
tableRow "Git Revision"  String
svGitRevision
            Text -> String -> Html
forall a. ToMarkup a => Text -> a -> Html
tableRow "Release Date"  String
svCommitDate
            Html -> Html
tr2 "System Info"
            Text -> String -> Html
forall a. ToMarkup a => Text -> a -> Html
tableRow "Operating System" String
ssOs
            Text -> String -> Html
forall a. ToMarkup a => Text -> a -> Html
tableRow "Architecture"     String
ssArch
            Text -> String -> Html
forall a. ToMarkup a => Text -> a -> Html
tableRow "Compiler"         String
ssCompiler
            Text -> String -> Html
forall a. ToMarkup a => Text -> a -> Html
tableRow "Compiler Version" String
ssCompilerVersion
            Html -> Html
tr2 "Environment"
            Text -> Text -> Html
forall a. ToMarkup a => Text -> a -> Html
tableRow "Environment Variables"    Text
seEnvVars
            Text -> Html -> Html
forall a. ToMarkup a => Text -> a -> Html
tableRow "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 "CLI arguments"            ([String] -> String
List.unwords [String]
seCliArgs)
  where
    tr2 :: Html -> Html
tr2 x :: 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 "2" Attribute -> Attribute -> Attribute
forall a. Semigroup a => a -> a -> a
<> AttributeValue -> Attribute
A.class_ "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{..} = do
    Text -> Html -> Html
divClass "row" (Text -> Html
blockP "Information about the analysed project")
    Text -> Html -> Html
tableWithShadow "" (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_ "info-name" Html -> Html -> Html
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_ "info-data")
        Text -> String -> Html
forall a. ToMarkup a => Text -> a -> Html
tableRow "Project name"  String
piName
        Text -> String -> Html
forall a. ToMarkup a => Text -> a -> Html
tableRow "Cabal Files"   ([String] -> String
List.unwords [String]
piCabalFiles)
        Text -> String -> Html
forall a. ToMarkup a => Text -> a -> Html
tableRow "HIE Files Directory" String
piHieDir
        Text -> Int -> Html
forall a. ToMarkup a => Text -> a -> Html
tableRow "Files Number" Int
piFileNumber

stanAnalysis :: AnalysisNumbers -> Html
stanAnalysis :: AnalysisNumbers -> Html
stanAnalysis AnalysisNumbers{..} = do
    Text -> Html -> Html
divClass "row" (Text -> Html
blockP "Summary stats from the static analysis")
    Text -> Html -> Html
tableWithShadow "" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
        Text -> Int -> Html
forall a. ToMarkup a => Text -> a -> Html
tableRow "Modules"               Int
anModules
        Text -> Int -> Html
forall a. ToMarkup a => Text -> a -> Html
tableRow "LoC"                   Int
anLoc
        Text -> Int -> Html
forall a. ToMarkup a => Text -> a -> Html
tableRow "Extensions"            Int
anExts
        Text -> Int -> Html
forall a. ToMarkup a => Text -> a -> Html
tableRow "SafeHaskel Extensions" Int
anSafeExts
        Text -> Int -> Html
forall a. ToMarkup a => Text -> a -> Html
tableRow "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 "Checked inspections"   Int
anIns
        Text -> Int -> Html
forall a. ToMarkup a => Text -> a -> Html
tableRow "Found Observations"    Int
anFoundObs
        Text -> Int -> Html
forall a. ToMarkup a => Text -> a -> Html
tableRow "Ignored Observations"  Int
anIgnoredObs

stanSummary :: Analysis -> AnalysisNumbers -> Html
stanSummary :: Analysis -> AnalysisNumbers -> Html
stanSummary analysis :: Analysis
analysis AnalysisNumbers{..} = do
    Text -> Html -> Html
divClass "row" (Text -> Html
blockP "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_ "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
$ "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
$ ToMarkup Text => Text -> Html
forall a. ToMarkup a => a -> Html
toHtml @Text (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
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."
                ]
        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
$ "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
        Unhealthy    -> "is unhealthy"
        LowHealth    -> "has low health"
        MediumHealth -> "has medium health"
        Healthy      -> "is healthy"

    showHealthConclusions :: ProjectHealth -> Text
    showHealthConclusions :: ProjectHealth -> Text
showHealthConclusions = [Text] -> Text
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
        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 :: Html
summary = case Analysis -> Maybe Summary
createSummary Analysis
analysis of
        Nothing -> Html -> Html
liSum (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
            Html -> Html
h4 "Congratulations! Your project has zero vulnerabilities!"
            Html -> Html
span "Stan carefully run all configured inspection and found 0 observations and vulnerabilities to the project."
        Just Summary{..} -> 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 ("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
                    Text -> Html
forall a. ToMarkup a => a -> Html
toHtml @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 ("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
                    Text -> Html
forall a. ToMarkup a => a -> Html
toHtml @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)
                    Text -> Html
forall a. ToMarkup a => a -> Html
toHtml @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
$ "Popular category: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Category -> Text
unCategory Category
summaryCategory)
                Text -> NonEmpty Category -> Html
categories "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
                Text -> Html
forall a. ToMarkup a => a -> Html
toHtml @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 ("Severity: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Severity -> Text
forall b a. (Show a, IsString b) => a -> b
show @Text Severity
summarySeverity)
                Text -> Html
forall a. ToMarkup a => a -> Html
toHtml @Text "The highest severity of found vulnerabilities is "
                Text -> Html
severity (Severity -> Text
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_ "sum"

stanObservations :: Analysis -> Html
stanObservations :: Analysis -> Html
stanObservations Analysis{..} = do
    Text -> Html -> Html
divClass "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 (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
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."
        ]
    (FileInfo -> Html) -> [FileInfo] -> Html
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ FileInfo -> Html
stanPerFile ([FileInfo] -> Html) -> [FileInfo] -> Html
forall a b. (a -> b) -> a -> b
$
        (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 (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

stanPerFile :: FileInfo -> Html
stanPerFile :: FileInfo -> Html
stanPerFile FileInfo{..} = Text -> Text -> Html -> Html
divIdClass "file" "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_ "grey-bg" (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
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 "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 "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 "Lines of Code" Int
fileInfoLoc
        Html -> Html
li (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html -> Html
divClass "extensions" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
            Text -> [Text] -> Html
stanExtensions ".cabal" (Either ExtensionsError ParsedExtensions -> [Text]
extensionsToText Either ExtensionsError ParsedExtensions
fileInfoCabalExtensions)
            Text -> [Text] -> Html
stanExtensions "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_ "col-12 obs-li" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html -> Html
divClass "observations col-12" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
            Html -> Html
h4 "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
observationLoc Observations
fileInfoObservations

stanExtensions :: Text -> [Text] -> Html
stanExtensions :: Text -> [Text] -> Html
stanExtensions from :: Text
from exts :: [Text]
exts = Text -> Html -> Html
divClass "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_ "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
$ "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_ "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 ins :: Id Inspection
ins = Html -> Html
a (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ "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
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{..} = Text -> Text -> Html -> Html
divIdClass (Id Observation -> Text
forall a. Id a -> Text
unId Id Observation
observationId) "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 "observation-general" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html -> Html
tableWithShadow "" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
        Text -> Text -> Html
forall a. ToMarkup a => Text -> a -> Html
tableR "ID"            (Id Observation -> Text
forall a. Id a -> Text
unId Id Observation
observationId)
        Text -> Html -> Html
forall a. ToMarkup a => Text -> a -> Html
tableR "Severity"      (Inspection -> Html
severityFromIns Inspection
inspection)
        Text -> Text -> Html
forall a. ToMarkup a => Text -> a -> Html
tableR "Description"   (Inspection -> Text
inspectionDescription Inspection
inspection)
        Text -> Html -> Html
forall a. ToMarkup a => Text -> a -> Html
tableR "Inspection ID" (Id Inspection -> Html
inspectionLink Id Inspection
observationInspectionId)
        Text -> Html -> Html
forall a. ToMarkup a => Text -> a -> Html
tableR "Category"      (Text -> NonEmpty Category -> Html
categories "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 "File"          String
observationFile

    tableR :: ToMarkup a => Text -> a -> Html
    tableR :: Text -> a -> Html
tableR name :: Text
name val :: 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_ "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_ "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 ins :: Inspection
ins = Text -> Html
severity (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$ forall a. (Show a, IsString Text) => a -> Text
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 severityTxt :: Text
severityTxt = Html -> Html
span (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ "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
$ "severity" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
severityTxt) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
toHtml @Text ""
    Html -> Html
span (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ "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 cl :: Text
cl cats :: 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
$ "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_ "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 (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty Category
cats

solutionsDiv :: Inspection -> Html
solutionsDiv :: Inspection -> Html
solutionsDiv ins :: Inspection
ins = Bool -> Html -> Html
forall m. Monoid m => Bool -> m -> m
memptyIfTrue ([Text] -> 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 "solutions border-shadow" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
    Html -> Html
h4 "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 ins :: HashSet (Id Inspection)
ins = do
    Text -> Html -> Html
divClass "row" (Text -> Html
blockP "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 (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{..}) = do
    Html -> Html
button (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ "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 ("Explore Inspection " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
insId)
    Text -> Html -> Html
divClass "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
<> "-content") "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 ("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 "" 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{..} config :: Config
config warnings :: [Text]
warnings = Text -> Html -> Html
divClass "col-12" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
    Text -> Html -> Html
divClass "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 (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
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. "
        ]
    Text -> Html -> Html
divClass "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 "Action" Html -> Html -> Html
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html -> Html
th "Filter" Html -> Html -> Html
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html -> Html
th "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 "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 "Ignored Observations"
            "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 "Unrecognised Observations"
            "Some observation IDs specified in the configurations are not found"
    Text -> Html -> Html
divClass "config-warnings row" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
        Html -> Html
h4 "Configuration Process Information"
        Html -> Html
p (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
            "Information and warnings that were gathered during the configuration assemble process. "
          Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> "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 (act :: ConfigAction
act, fil :: Text
fil, sc :: 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_ "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 :: [Id a] -> Text -> Text -> Html
toUl ids :: [Id a]
ids headerTxt :: Text
headerTxt desc :: Text
desc = Bool -> Html -> Html
forall m. Monoid m => Bool -> m -> m
memptyIfTrue ([Id 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 "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]
    (ignoredIds :: [Id Observation]
ignoredIds, unknownIds :: [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 "col-5" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
        Text -> Html
blockP "We are using the following severity system to indicate the observation level"

    Text -> Html -> Html
tableWithShadow "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 "Severity" Html -> Html -> Html
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html -> Html
th "Description")
        (Severity -> Html) -> [Severity] -> Html
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Severity -> Html
toSeverityRow ((Bounded Severity, Enum Severity) => [Severity]
forall a. (Bounded a, Enum a) => [a]
universe @Severity)
  where
    toSeverityRow :: Severity -> Html
    toSeverityRow :: Severity -> Html
toSeverityRow s :: 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 "container" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
        Text -> Html -> Html
divClass "row footer-link" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
            Html -> Html
span "This report was generated by "
            Html -> Html
a (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href "https://github.com/kowainik/stan" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
                Text -> Html
forall a. ToMarkup a => a -> Html
toHtml @Text "Stan — Haskell Static Analysis Tool."
        Text -> Html -> Html
divClass "row footer-link" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
            Html -> Html
span "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 "https://kowainik.github.io" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
toHtml @Text "Kowainik"
    Html -> Html
nav (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ "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 "© 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 "Content-Type" Attribute -> Attribute -> Attribute
forall a. Semigroup a => a -> a -> a
<> AttributeValue -> Attribute
A.content "text/html; charset=UTF-8")
    Html
meta Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! (AttributeValue -> Attribute
A.httpEquiv "X-UA-Compatible" Attribute -> Attribute -> Attribute
forall a. Semigroup a => a -> a -> a
<> AttributeValue -> Attribute
A.content "IE=Edge")
    AttributeValue -> AttributeValue -> Html
nameContent "viewport" "width=device-width, initial-scale=1.0"
    AttributeValue -> AttributeValue -> Html
nameContent "description" "Stan Report"
    AttributeValue -> AttributeValue -> Html
nameContent "keywords" "Haskell, Static Analysis"
    AttributeValue -> AttributeValue -> Html
nameContent "author" "Kowainik"
    Html -> Html
title "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 x :: AttributeValue
x y :: 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
    [ "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 :: Text -> Html -> Html
divClass c :: 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 aId :: Text
aId c :: 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 h :: Text
h c :: Text
c rest :: 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 (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 :: Text -> a -> Html
tableRow name :: Text
name val :: 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_ "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_ "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 cl :: 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
$ "border-shadow " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
cl)

uList :: ToMarkup a => [a] -> Html
uList :: [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_ "grey-bg"

hToId :: Text -> Text
hToId :: Text -> Text
hToId = Text -> [Text] -> Text
T.intercalate "-" ([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 :: 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