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

Pretty printing of Stan's analysis.
-}

module Stan.Analysis.Pretty
    ( prettyShowAnalysis

      -- * Numbers
    , AnalysisNumbers (..)
    , ProjectHealth (..)
    , analysisToNumbers
    , prettyHealth
    , toProjectHealth
    ) where

import Colourista.Short (b, i)
import Extensions (ExtensionsError, ParsedExtensions)
import Text.Printf (printf)

import Stan.Analysis (Analysis (..))
import Stan.Core.ModuleName (ModuleName (..))
import Stan.FileInfo (FileInfo (..), extensionsToText)
import Stan.Observation (Observation (..), prettyShowObservation)
import Stan.Report.Settings (OutputSettings (..), Verbosity (..))

import qualified Data.HashSet as HS
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import qualified Data.Text as Text
import qualified Slist as S


{- | Shows analysed output of Stan work.
This functions groups 'Observation's by 'FilePath' they are found in.
-}
prettyShowAnalysis :: Analysis -> OutputSettings -> Text
prettyShowAnalysis :: Analysis -> OutputSettings -> Text
prettyShowAnalysis an :: Analysis
an rs :: OutputSettings
rs@OutputSettings{..} = case Verbosity
outputSettingsVerbosity of
    Verbose    -> Text
groupedObservations Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> AnalysisNumbers -> Text
summary (Analysis -> AnalysisNumbers
analysisToNumbers Analysis
an)
    NonVerbose -> [Text] -> Text
forall t. IsText t "unlines" => [t] -> t
unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Slist Text -> [Text]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Slist Text -> [Text]) -> Slist Text -> [Text]
forall a b. (a -> b) -> a -> b
$ OutputSettings -> Observation -> Text
prettyShowObservation OutputSettings
rs (Observation -> Text) -> Slist Observation -> Slist Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Analysis -> Slist Observation
analysisObservations Analysis
an
  where
    groupedObservations :: Text
    groupedObservations :: Text
groupedObservations =
        Text -> [Text] -> Text
Text.intercalate "\n\n"
        ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= "")
        ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (FileInfo -> Text) -> [FileInfo] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (OutputSettings -> FileInfo -> Text
showByFile OutputSettings
rs)
        ([FileInfo] -> [Text]) -> [FileInfo] -> [Text]
forall a b. (a -> b) -> a -> b
$ Map FilePath FileInfo -> [FileInfo]
forall k a. Map k a -> [a]
Map.elems
        (Map FilePath FileInfo -> [FileInfo])
-> Map FilePath FileInfo -> [FileInfo]
forall a b. (a -> b) -> a -> b
$ Analysis -> Map FilePath FileInfo
analysisFileMap Analysis
an

data AnalysisNumbers = AnalysisNumbers
    { AnalysisNumbers -> Int
anModules    :: !Int
    , AnalysisNumbers -> Int
anLoc        :: !Int
    , AnalysisNumbers -> Int
anExts       :: !Int
    , AnalysisNumbers -> Int
anSafeExts   :: !Int
    , AnalysisNumbers -> Int
anIns        :: !Int
    , AnalysisNumbers -> Int
anFoundObs   :: !Int
    , AnalysisNumbers -> Int
anIgnoredObs :: !Int
    , AnalysisNumbers -> Double
anHealth     :: !Double
    }

analysisToNumbers :: Analysis -> AnalysisNumbers
analysisToNumbers :: Analysis -> AnalysisNumbers
analysisToNumbers Analysis{..} = $WAnalysisNumbers :: Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Double
-> AnalysisNumbers
AnalysisNumbers
    { anModules :: Int
anModules    = Int
analysisModulesNum
    , anLoc :: Int
anLoc        = Int
analysisLinesOfCode
    , anExts :: Int
anExts       = Set OnOffExtension -> Int
forall a. Set a -> Int
Set.size (Set OnOffExtension -> Int) -> Set OnOffExtension -> Int
forall a b. (a -> b) -> a -> b
$ (Set OnOffExtension, Set SafeHaskellExtension)
-> Set OnOffExtension
forall a b. (a, b) -> a
fst (Set OnOffExtension, Set SafeHaskellExtension)
analysisUsedExtensions
    , anSafeExts :: Int
anSafeExts   = Set SafeHaskellExtension -> Int
forall a. Set a -> Int
Set.size (Set SafeHaskellExtension -> Int)
-> Set SafeHaskellExtension -> Int
forall a b. (a -> b) -> a -> b
$ (Set OnOffExtension, Set SafeHaskellExtension)
-> Set SafeHaskellExtension
forall a b. (a, b) -> b
snd (Set OnOffExtension, Set SafeHaskellExtension)
analysisUsedExtensions
    , anIns :: Int
anIns        = HashSet (Id Inspection) -> Int
forall a. HashSet a -> Int
HS.size HashSet (Id Inspection)
analysisInspections
    , anFoundObs :: Int
anFoundObs   = Slist Observation -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Slist Observation
analysisObservations
    , anIgnoredObs :: Int
anIgnoredObs = Slist Observation -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Slist Observation
analysisIgnoredObservations
    , anHealth :: Double
anHealth     = Double
calculatedHealth
    }
  where
    calculatedHealth :: Double
    calculatedHealth :: Double
calculatedHealth =
        -- all inspections ignored or no observations
        if HashSet (Id Inspection) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null HashSet (Id Inspection)
analysisInspections Bool -> Bool -> Bool
|| Slist Observation -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Slist Observation
analysisObservations
        then 100
        else
            let totalInspections :: Double
totalInspections = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ HashSet (Id Inspection) -> Int
forall a. HashSet a -> Int
HS.size HashSet (Id Inspection)
analysisInspections
                triggeredInspections :: Double
triggeredInspections =
                    Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral
                    (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ Set (Id Inspection) -> Int
forall a. Set a -> Int
Set.size
                    (Set (Id Inspection) -> Int) -> Set (Id Inspection) -> Int
forall a b. (a -> b) -> a -> b
$ [Id Inspection] -> Set (Id Inspection)
forall a. Ord a => [a] -> Set a
Set.fromList
                    ([Id Inspection] -> Set (Id Inspection))
-> [Id Inspection] -> Set (Id Inspection)
forall a b. (a -> b) -> a -> b
$ (Observation -> Id Inspection) -> [Observation] -> [Id Inspection]
forall a b. (a -> b) -> [a] -> [b]
map Observation -> Id Inspection
observationInspectionId
                    ([Observation] -> [Id Inspection])
-> [Observation] -> [Id Inspection]
forall a b. (a -> b) -> a -> b
$ Slist Observation -> [Observation]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Slist Observation
analysisObservations

            in 100 Double -> Double -> Double
forall a. Num a => a -> a -> a
* (1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
triggeredInspections Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
totalInspections)

{- | Show project health as pretty text with 2 digits after dot.
-}
prettyHealth :: Double -> Text
prettyHealth :: Double -> Text
prettyHealth health :: Double
health =
    if Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor Double
health :: Int) Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
health  -- display without decimal part
    then FilePath -> Text
forall a. ToText a => a -> Text
toText (FilePath -> Double -> FilePath
forall r. PrintfType r => FilePath -> r
printf "%.0f" Double
health :: String) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "%"
    else FilePath -> Text
forall a. ToText a => a -> Text
toText (FilePath -> Double -> FilePath
forall r. PrintfType r => FilePath -> r
printf "%.2f" Double
health :: String) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "%"

{- | Enum to describe project health depending on the value of
'anHealth'.
-}
data ProjectHealth
    = Unhealthy
    | LowHealth
    | MediumHealth
    | Healthy

-- | Calculate 'ProjectHealth'.
toProjectHealth :: Double -> ProjectHealth
toProjectHealth :: Double -> ProjectHealth
toProjectHealth health :: Double
health
    | Double
health Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= 100 = ProjectHealth
Healthy
    | Double
health Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= 80  = ProjectHealth
MediumHealth
    | Double
health Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= 40  = ProjectHealth
LowHealth
    | Bool
otherwise     = ProjectHealth
Unhealthy

summary :: AnalysisNumbers -> Text
summary :: AnalysisNumbers -> Text
summary AnalysisNumbers{..} = [Text] -> Text
forall t. IsText t "unlines" => [t] -> t
unlines
    [ ""
    , Text -> Text
forall str. (IsString str, Semigroup str) => str -> str
b "           Stan's Summary:"
    , Text
top
    , Text -> Text
alignText "Analysed modules" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
alignNum Int
anModules
    , Text
mid
    , Text -> Text
alignText "Analysed Lines of Code" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
alignNum Int
anLoc
    , Text
mid
    , Text -> Text
alignText "Total Haskell2010 extensions" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
alignNum Int
anExts
    , Text
mid
    , Text -> Text
alignText "Total SafeHaskell extensions" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
alignNum Int
anSafeExts
    , Text
mid
    , Text -> Text
alignText "Total checked inspections" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
alignNum Int
anIns
    , Text
mid
    , Text -> Text
alignText "Total found observations" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
alignNum Int
anFoundObs
    , Text
mid
    , Text -> Text
alignText "Total ignored observations" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
alignNum Int
anIgnoredObs
    , Text
mid
    , Text -> Text
alignText "Project health" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
alignVal (Double -> Text
prettyHealth Double
anHealth)
    , Text
bot
    ]
  where
    alignNum :: Int -> Text
    alignNum :: Int -> Text
alignNum = Text -> Text
alignVal (Text -> Text) -> (Int -> Text) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text
forall b a. (Show a, IsString b) => a -> b
show

    alignVal :: Text -> Text
    alignVal :: Text -> Text
alignVal x :: Text
x = " ┃ " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Char -> Text -> Text
Text.justifyLeft 6 ' ' Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " ┃"

    alignText :: Text -> Text
    alignText :: Text -> Text
alignText txt :: Text
txt ="┃ " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Char -> Text -> Text
Text.justifyLeft 28 ' ' Text
txt

    separator :: Text -> Text -> Text -> Text
    separator :: Text -> Text -> Text -> Text
separator l :: Text
l c :: Text
c r :: Text
r = Text
l Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
Text.replicate 30 "━" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
Text.replicate 8 "━" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
r
    top, mid, bot :: Text
    top :: Text
top = Text -> Text -> Text -> Text
separator "┏" "┳" "┓"
    mid :: Text
mid = Text -> Text -> Text -> Text
separator "┣" "╋" "┫"
    bot :: Text
bot = Text -> Text -> Text -> Text
separator "┗" "┻" "┛"

showByFile :: OutputSettings -> FileInfo -> Text
showByFile :: OutputSettings -> FileInfo -> Text
showByFile outputSettings :: OutputSettings
outputSettings FileInfo{..} = if Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 then "" else [Text] -> Text
forall t. IsText t "unlines" => [t] -> t
unlines
    [ Text -> Text
forall str. (IsString str, Semigroup str) => str -> str
i "  File:         " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall str. (IsString str, Semigroup str) => str -> str
b (FilePath -> Text
forall a. ToText a => a -> Text
toText FilePath
fileInfoPath)
    , Text -> Text
forall str. (IsString str, Semigroup str) => str -> str
i "  Module:       " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall str. (IsString str, Semigroup str) => str -> str
b (ModuleName -> Text
unModuleName ModuleName
fileInfoModuleName)
    , Text -> Text
forall str. (IsString str, Semigroup str) => str -> str
i "  LoC:          " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall str. (IsString str, Semigroup str) => str -> str
b (Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
fileInfoLoc)
    , Text -> Text
forall str. (IsString str, Semigroup str) => str -> str
i "  Observations: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall str. (IsString str, Semigroup str) => str -> str
b (Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
len)
    , Text -> Text
forall str. (IsString str, Semigroup str) => str -> str
i "  Extensions from .cabal: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall str. (IsString str, Semigroup str) => str -> str
b (Either ExtensionsError ParsedExtensions -> Text
showExts Either ExtensionsError ParsedExtensions
fileInfoCabalExtensions)
    , Text -> Text
forall str. (IsString str, Semigroup str) => str -> str
i "  Extensions from module: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall str. (IsString str, Semigroup str) => str -> str
b (Either ExtensionsError ParsedExtensions -> Text
showExts Either ExtensionsError ParsedExtensions
fileInfoExtensions)
    , " ┏" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
Text.replicate 78 "━"
    ]

    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
Text.intercalate (" ┃\n ┃" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
Text.replicate 78 "~" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\n ┃\n")
        (Slist Text -> [Text]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Slist Text -> [Text]) -> Slist Text -> [Text]
forall a b. (a -> b) -> a -> b
$ OutputSettings -> Observation -> Text
prettyShowObservation OutputSettings
outputSettings (Observation -> Text) -> Slist Observation -> Slist Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Observation -> RealSrcSpan)
-> Slist Observation -> Slist Observation
forall b a. Ord b => (a -> b) -> Slist a -> Slist a
S.sortOn Observation -> RealSrcSpan
observationSrcSpan Slist Observation
fileInfoObservations)
  where
    len :: Int
    len :: Int
len = Slist Observation -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Slist Observation
fileInfoObservations

    showExts :: Either ExtensionsError ParsedExtensions -> Text
    showExts :: Either ExtensionsError ParsedExtensions -> Text
showExts = Text -> [Text] -> Text
Text.intercalate ", " ([Text] -> Text)
-> (Either ExtensionsError ParsedExtensions -> [Text])
-> Either ExtensionsError ParsedExtensions
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either ExtensionsError ParsedExtensions -> [Text]
extensionsToText