content: {- |
  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 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 "SafeHaskell 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 ->
              [ "After analyzing your code, Stan has many suggestions for you on how to improve it."
              , "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 does not have any suggestions for your code."
              ]
  
      summary :: Html
      summary = case createSummary analysis of
          Nothing -> liSum $ do
              h4 "Congratulations! Your project has zero suggestions!"
              span "Stan carefully ran all configured inspection and found 0 observations for 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 observations is "
                  severity (show @Text summarySeverity)
  
      liSum :: Html -> Html
      liSum = li ! A.class_ "sum"
  
  stanObservations :: Analysis -> Html
  stanObservations Analysis{..} = do
      let toRender = filter (not . null . fileInfoObservations) $ Map.elems analysisFileMap
      divClass "row" $ blockP $ fold
          [ "Based on the analysis results, Stan found several areas for improvement "
          , "in the analysed files. In Stan terminology, we call these findings "
          , "Observations. Below you can see the more detailed "
          , "information about each observation, and find the possible ways to fix "
          , "them for your project."
          ]
      ul $ traverse_ tocPerFile toRender
      traverse_ stanPerFile toRender
  
  tocPerFile :: FileInfo -> Html
  tocPerFile FileInfo{fileInfoModuleName = ModuleName mName} =
      li $ span $ a ! A.class_ "ins-link" ! A.href (fromText $ "#" <> mName) $ toHtml mName
  
  stanPerFile :: FileInfo -> Html
  stanPerFile FileInfo{..} = divIdClass "file" "row" $ do
      h3 ! A.class_ "grey-bg" ! A.id (fromText $ unModuleName fileInfoModuleName) $ 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 observationSrcSpan 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 sv = tr $ do
          td (severity $ show sv)
          td (toHtml $ severityDescription sv)
  
  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
  