{-# LANGUAGE CPP #-}

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

__Observation__ — a suggestion found in the target project by @Stan@.
-}

module Stan.Observation
    ( Observation (..)
    , Observations

      -- * Smart constructors
    , mkObservation
    , mkObservationId

    , ignoredObservations

      -- * Pretty print
    , prettyShowObservation
    , prettyShowIgnoredObservations
    , prettyObservationSource
    ) where

import Colourista (blue, bold, formatWith, green, italic, reset, yellow)
import Colourista.Short (b, i)
import Data.Aeson.Micro (ToJSON (..), object, (.=))
import Data.List (partition)
import Slist (Slist)

import Stan.Category (prettyShowCategory)
import Stan.Core.Id (Id (..))
import Stan.Core.ModuleName (ModuleName (..), fromGhcModule)
import Stan.Ghc.Compat (RealSrcSpan, srcSpanEndCol, srcSpanEndLine, srcSpanFile, srcSpanStartCol,
                        srcSpanStartLine)
import Stan.Hie.Compat (HieFile (..))
import Stan.Inspection (Inspection (..))
import Stan.Inspection.All (getInspectionById)
import Stan.Report.Settings (OutputSettings (..), Verbosity (..), isHidden)
import Stan.Severity (prettyShowSeverity, severityColour)

import qualified Crypto.Hash.SHA1 as SHA1
#if MIN_VERSION_base64(1,0,0)
import qualified Data.Base64.Types
#endif
import qualified Data.ByteString.Base64 as Base64
import qualified Data.ByteString.Char8 as BS
import qualified Data.HashSet as HS
import qualified Data.List.NonEmpty as NE
import qualified Data.Text as Text
import qualified Slist as S


{- | Data type to represent discovered by Stan suggestions.
-}
data Observation = Observation
    { Observation -> Id Observation
observationId           :: !(Id Observation)
    , Observation -> Id Inspection
observationInspectionId :: !(Id Inspection)
    , Observation -> RealSrcSpan
observationSrcSpan      :: !RealSrcSpan
    , Observation -> FilePath
observationFile         :: !FilePath
    , Observation -> ModuleName
observationModuleName   :: !ModuleName
    , Observation -> ByteString
observationFileContent  :: !ByteString
    } deriving stock (Int -> Observation -> ShowS
[Observation] -> ShowS
Observation -> FilePath
(Int -> Observation -> ShowS)
-> (Observation -> FilePath)
-> ([Observation] -> ShowS)
-> Show Observation
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Observation -> ShowS
showsPrec :: Int -> Observation -> ShowS
$cshow :: Observation -> FilePath
show :: Observation -> FilePath
$cshowList :: [Observation] -> ShowS
showList :: [Observation] -> ShowS
Show, Observation -> Observation -> Bool
(Observation -> Observation -> Bool)
-> (Observation -> Observation -> Bool) -> Eq Observation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Observation -> Observation -> Bool
== :: Observation -> Observation -> Bool
$c/= :: Observation -> Observation -> Bool
/= :: Observation -> Observation -> Bool
Eq)

instance ToJSON Observation where
    toJSON :: Observation -> Value
toJSON Observation{FilePath
ByteString
RealSrcSpan
Id Inspection
Id Observation
ModuleName
observationId :: Observation -> Id Observation
observationInspectionId :: Observation -> Id Inspection
observationSrcSpan :: Observation -> RealSrcSpan
observationFile :: Observation -> FilePath
observationModuleName :: Observation -> ModuleName
observationFileContent :: Observation -> ByteString
observationId :: Id Observation
observationInspectionId :: Id Inspection
observationSrcSpan :: RealSrcSpan
observationFile :: FilePath
observationModuleName :: ModuleName
observationFileContent :: ByteString
..} = [Pair] -> Value
object
        [ Text
"id"           Text -> Id Observation -> Pair
forall v. ToJSON v => Text -> v -> Pair
.= Id Observation
observationId
        , Text
"inspectionId" Text -> Id Inspection -> Pair
forall v. ToJSON v => Text -> v -> Pair
.= Id Inspection
observationInspectionId
        , Text
"srcSpan"      Text -> Text -> Pair
forall v. ToJSON v => Text -> v -> Pair
.= RealSrcSpan -> Text
showSpan RealSrcSpan
observationSrcSpan
        , Text
"startLine"    Text -> Int -> Pair
forall v. ToJSON v => Text -> v -> Pair
.= RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
observationSrcSpan
        , Text
"startCol"     Text -> Int -> Pair
forall v. ToJSON v => Text -> v -> Pair
.= RealSrcSpan -> Int
srcSpanStartCol RealSrcSpan
observationSrcSpan
        , Text
"endLine"      Text -> Int -> Pair
forall v. ToJSON v => Text -> v -> Pair
.= RealSrcSpan -> Int
srcSpanEndLine RealSrcSpan
observationSrcSpan
        , Text
"endCol"       Text -> Int -> Pair
forall v. ToJSON v => Text -> v -> Pair
.= RealSrcSpan -> Int
srcSpanEndCol RealSrcSpan
observationSrcSpan
        , Text
"file"         Text -> Text -> Pair
forall v. ToJSON v => Text -> v -> Pair
.= FilePath -> Text
forall a. ToText a => a -> Text
toText FilePath
observationFile
        , Text
"moduleName"   Text -> ModuleName -> Pair
forall v. ToJSON v => Text -> v -> Pair
.= ModuleName
observationModuleName
        ]

-- | Type alias for the sized list of 'Observation's.
type Observations = Slist Observation

-- | Smart constructor for 'Observation's from 'HieFile's.
mkObservation
    :: Id Inspection  -- ^ Corresponding 'Inspection's 'Id'.
    -> HieFile
    -> RealSrcSpan  -- ^ Position.
    -> Observation
mkObservation :: Id Inspection -> HieFile -> RealSrcSpan -> Observation
mkObservation Id Inspection
insId HieFile{FilePath
[AvailInfo]
ByteString
Array Int HieTypeFlat
Module
HieASTs Int
hie_hs_file :: FilePath
hie_module :: Module
hie_types :: Array Int HieTypeFlat
hie_asts :: HieASTs Int
hie_exports :: [AvailInfo]
hie_hs_src :: ByteString
hie_hs_file :: HieFile -> FilePath
hie_module :: HieFile -> Module
hie_types :: HieFile -> Array Int HieTypeFlat
hie_asts :: HieFile -> HieASTs Int
hie_exports :: HieFile -> [AvailInfo]
hie_hs_src :: HieFile -> ByteString
..} RealSrcSpan
srcSpan = Observation
    { observationId :: Id Observation
observationId = Id Inspection -> ModuleName -> RealSrcSpan -> Id Observation
mkObservationId Id Inspection
insId ModuleName
moduleName RealSrcSpan
srcSpan
    , observationInspectionId :: Id Inspection
observationInspectionId = Id Inspection
insId
    , observationSrcSpan :: RealSrcSpan
observationSrcSpan = RealSrcSpan
srcSpan
    , observationFile :: FilePath
observationFile = FilePath
hie_hs_file
    , observationModuleName :: ModuleName
observationModuleName = ModuleName
moduleName
    , observationFileContent :: ByteString
observationFileContent = ByteString
hie_hs_src
    }
  where
    moduleName :: ModuleName
    moduleName :: ModuleName
moduleName = Module -> ModuleName
fromGhcModule Module
hie_module


-- | Show 'Observation' in a human-friendly format.
prettyShowObservation :: OutputSettings -> Observation -> Text
prettyShowObservation :: OutputSettings -> Observation -> Text
prettyShowObservation OutputSettings{ToggleSolution
Verbosity
outputSettingsVerbosity :: Verbosity
outputSettingsSolutionVerbosity :: ToggleSolution
outputSettingsVerbosity :: OutputSettings -> Verbosity
outputSettingsSolutionVerbosity :: OutputSettings -> ToggleSolution
..} o :: Observation
o@Observation{FilePath
ByteString
RealSrcSpan
Id Inspection
Id Observation
ModuleName
observationId :: Observation -> Id Observation
observationInspectionId :: Observation -> Id Inspection
observationSrcSpan :: Observation -> RealSrcSpan
observationFile :: Observation -> FilePath
observationModuleName :: Observation -> ModuleName
observationFileContent :: Observation -> ByteString
observationId :: Id Observation
observationInspectionId :: Id Inspection
observationSrcSpan :: RealSrcSpan
observationFile :: FilePath
observationModuleName :: ModuleName
observationFileContent :: ByteString
..} = case Verbosity
outputSettingsVerbosity of
    Verbosity
NonVerbose -> Text
simpleShowObservation
    Verbosity
Verbose -> [Text] -> Text
forall t. IsText t "unlines" => [t] -> t
unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text
" ┃  " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)
        ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$  [Text]
observationTable
        [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> (Text
"" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Bool -> Observation -> [Text]
prettyObservationSource Bool
True Observation
o)
        [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> (Text
"" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
solution)
  where
    simpleShowObservation :: Text
    simpleShowObservation :: Text
simpleShowObservation =
        Text
" ✦ "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall str. (IsString str, Semigroup str) => str -> str
b (Id Observation -> Text
forall a. Id a -> Text
unId Id Observation
observationId)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
" [" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
sev Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"] "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall str. (IsString str, Semigroup str) => str -> str
i (RealSrcSpan -> Text
showSpan RealSrcSpan
observationSrcSpan)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" — "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Inspection -> Text
inspectionName Inspection
inspection


    observationTable :: [Text]
    observationTable :: [Text]
observationTable =
        [ Text -> Text
element Text
"ID:            " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall str. (IsString str, Semigroup str) => str -> str
b (Id Observation -> Text
forall a. Id a -> Text
unId Id Observation
observationId)
        , Text -> Text
element Text
"Severity:      " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
sev
        , Text -> Text
element Text
"Inspection ID: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Id Inspection -> Text
forall a. Id a -> Text
unId Id Inspection
observationInspectionId
        , Text -> Text
element Text
"Name:          " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Inspection -> Text
inspectionName Inspection
inspection
        , Text -> Text
element Text
"Description:   " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Inspection -> Text
inspectionDescription Inspection
inspection
        , Text -> Text
element Text
"Category:      " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
categories
        , Text -> Text
element Text
"File:          " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
forall a. ToText a => a -> Text
toText FilePath
observationFile
        ]
      where
        element :: Text -> Text
        element :: Text -> Text
element = [Text] -> Text -> Text
forall str. (IsString str, Semigroup str) => [str] -> str -> str
formatWith [Text
forall str. IsString str => str
italic] (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"✦ " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)

    sev :: Text
    sev :: Text
sev = Severity -> Text
prettyShowSeverity (Inspection -> Severity
inspectionSeverity Inspection
inspection)

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

    categories :: Text
    categories :: Text
categories = Text -> [Text] -> Text
Text.intercalate Text
" "
        ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Category -> Text) -> [Category] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Category -> Text
prettyShowCategory ([Category] -> [Text]) -> [Category] -> [Text]
forall a b. (a -> b) -> a -> b
$ NonEmpty Category -> [Category]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty Category -> [Category])
-> NonEmpty Category -> [Category]
forall a b. (a -> b) -> a -> b
$ Inspection -> NonEmpty Category
inspectionCategory Inspection
inspection

    solution :: [Text]
    solution :: [Text]
solution
        | ToggleSolution -> Bool
isHidden ToggleSolution
outputSettingsSolutionVerbosity Bool -> Bool -> Bool
|| [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
sols = []
        | Bool
otherwise = Text
"💡 " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text -> Text
forall str. (IsString str, Semigroup str) => [str] -> str -> str
formatWith [Text
forall str. IsString str => str
italic, Text
forall str. IsString str => str
green] Text
"Possible solution:" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:
            (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text
"    ⍟ " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) [Text]
sols
      where
        sols :: [Text]
        sols :: [Text]
sols = Inspection -> [Text]
inspectionSolution Inspection
inspection


prettyObservationSource
    :: Bool  -- ^ Use colouring
    -> Observation
    -> [Text]
prettyObservationSource :: Bool -> Observation -> [Text]
prettyObservationSource Bool
isColour Observation{FilePath
ByteString
RealSrcSpan
Id Inspection
Id Observation
ModuleName
observationId :: Observation -> Id Observation
observationInspectionId :: Observation -> Id Inspection
observationSrcSpan :: Observation -> RealSrcSpan
observationFile :: Observation -> FilePath
observationModuleName :: Observation -> ModuleName
observationFileContent :: Observation -> ByteString
observationId :: Id Observation
observationInspectionId :: Id Inspection
observationSrcSpan :: RealSrcSpan
observationFile :: FilePath
observationModuleName :: ModuleName
observationFileContent :: ByteString
..} =
      Int -> Text
alignLine (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
    Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (Int -> Text) -> [Int] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
x -> Int -> Text
alignLine Int
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
getSourceLine Int
x) [Int
n .. Int
endL]
    [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Int -> Text
alignLine (Int
endL Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
arrows]
  where
    n, endL :: Int
    n :: Int
n = RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
observationSrcSpan
    endL :: Int
endL = RealSrcSpan -> Int
srcSpanEndLine RealSrcSpan
observationSrcSpan

    alignLine :: Int -> Text
    alignLine :: Int -> Text
alignLine Int
x = Int -> Char -> Text -> Text
Text.justifyRight Int
4 Char
' ' (Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
x) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ┃ "

    getSourceLine :: Int -> Text
    getSourceLine :: Int -> Text
getSourceLine Int
x = Text -> (ByteString -> Text) -> Maybe ByteString -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        Text
"<UNAVAILABLE> Open the issue in the tool that created the HIE files for you."
        ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8
        (ByteString -> [ByteString]
BS.lines ByteString
observationFileContent [ByteString] -> Int -> Maybe ByteString
forall a. [a] -> Int -> Maybe a
!!? (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))

    arrows :: Text
    arrows :: Text
arrows = Bool -> Text -> Text
whenColour Bool
isColour (Severity -> Text
severityColour (Severity -> Text) -> Severity -> Text
forall a b. (a -> b) -> a -> b
$ Inspection -> Severity
inspectionSeverity (Inspection -> Severity) -> Inspection -> Severity
forall a b. (a -> b) -> a -> b
$ Id Inspection -> Inspection
getInspectionById Id Inspection
observationInspectionId)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
Text.replicate Int
start Text
" "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
Text.replicate Int
arrow Text
"^"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Bool -> Text -> Text
whenColour Bool
isColour Text
forall str. IsString str => str
reset
      where
        start :: Int
start = RealSrcSpan -> Int
srcSpanStartCol RealSrcSpan
observationSrcSpan Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
        arrow :: Int
arrow = RealSrcSpan -> Int
srcSpanEndCol RealSrcSpan
observationSrcSpan Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

{- | Show 'RealSrcSpan' in the following format:

@
filename.ext(11:12-13:14)
@
-}
showSpan :: RealSrcSpan -> Text
showSpan :: RealSrcSpan -> Text
showSpan RealSrcSpan
s = FastString -> Text
forall b a. (Show a, IsString b) => a -> b
show (RealSrcSpan -> FastString
srcSpanFile RealSrcSpan
s)
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show (RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
s)
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show (RealSrcSpan -> Int
srcSpanStartCol RealSrcSpan
s)
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show (RealSrcSpan -> Int
srcSpanEndLine RealSrcSpan
s)
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show (RealSrcSpan -> Int
srcSpanEndCol RealSrcSpan
s)
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"

{- | Checkes the predicate on colourfulness and returns an empty text when the
colouroing is disabled.
-}
whenColour :: Bool -> Text -> Text
whenColour :: Bool -> Text -> Text
whenColour = Bool -> Text -> Text
forall m. Monoid m => Bool -> m -> m
memptyIfFalse

{- Returns the list of ignored and unrecognised 'Observation' 'Id's
respectfully.
-}
ignoredObservations
    :: [Id Observation]
    -> Observations
    -> ([Id Observation], [Id Observation])
      -- ^ Ignored         ^ Unknown
ignoredObservations :: [Id Observation]
-> Observations -> ([Id Observation], [Id Observation])
ignoredObservations [Id Observation]
ids Observations
obs = ([Id Observation]
ignoredIds, [Id Observation]
unknownIds)
  where
    obsIds :: HashSet (Id Observation)
    obsIds :: HashSet (Id Observation)
obsIds = [Item (HashSet (Id Observation))] -> HashSet (Id Observation)
forall l. IsList l => [Item l] -> l
fromList ([Item (HashSet (Id Observation))] -> HashSet (Id Observation))
-> [Item (HashSet (Id Observation))] -> HashSet (Id Observation)
forall a b. (a -> b) -> a -> b
$ Slist (Item (HashSet (Id Observation)))
-> [Item (HashSet (Id Observation))]
forall a. Slist a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Slist (Item (HashSet (Id Observation)))
 -> [Item (HashSet (Id Observation))])
-> Slist (Item (HashSet (Id Observation)))
-> [Item (HashSet (Id Observation))]
forall a b. (a -> b) -> a -> b
$ (Observation -> Id Observation)
-> Observations -> Slist (Id Observation)
forall a b. (a -> b) -> Slist a -> Slist b
S.map Observation -> Id Observation
observationId Observations
obs

    ignoredIds, unknownIds :: [Id Observation]
    ([Id Observation]
ignoredIds, [Id Observation]
unknownIds) = (Id Observation -> Bool)
-> [Id Observation] -> ([Id Observation], [Id Observation])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (Id Observation -> HashSet (Id Observation) -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`HS.member` HashSet (Id Observation)
obsIds) [Id Observation]
ids

{- Pretty shows the list of ignored and unrecognised 'Observation' 'Id's
respectfully.

@
Ignored Observation IDs:
    - OBS-STAN-0005-ZKmeC0-125:45
Unrecognised Observation IDs:
    - asd
@
-}
prettyShowIgnoredObservations :: [Id Observation] -> Observations -> Text
prettyShowIgnoredObservations :: [Id Observation] -> Observations -> Text
prettyShowIgnoredObservations [] Observations
_ = Text
""
prettyShowIgnoredObservations [Id Observation]
ids Observations
obs = Text
ignored Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
unknown
  where
    ignored :: Text
    ignored :: Text
ignored =
        if [Id Observation] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Id Observation]
ignoredIds
        then Text
""
        else [Text] -> Text -> Text
forall str. (IsString str, Semigroup str) => [str] -> str -> str
formatWith [Text
forall str. IsString str => str
bold, Text
forall str. IsString str => str
blue] Text
"Ignored Observation IDs:\n"
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Id Observation] -> Text
showIds [Id Observation]
ignoredIds

    unknown :: Text
    unknown :: Text
unknown =
        if [Id Observation] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Id Observation]
unknownIds
        then Text
""
        else [Text] -> Text -> Text
forall str. (IsString str, Semigroup str) => [str] -> str -> str
formatWith [Text
forall str. IsString str => str
bold, Text
forall str. IsString str => str
yellow] Text
"Unrecognised Observation IDs:\n"
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Id Observation] -> Text
showIds [Id Observation]
unknownIds

    showIds :: [Id Observation] -> Text
    showIds :: [Id Observation] -> Text
showIds = [Text] -> Text
forall t. IsText t "unlines" => [t] -> t
unlines ([Text] -> Text)
-> ([Id Observation] -> [Text]) -> [Id Observation] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Id Observation -> Text) -> [Id Observation] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
(<>) Text
"    - " (Text -> Text)
-> (Id Observation -> Text) -> Id Observation -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Id Observation -> Text
forall a. Id a -> Text
unId)

    ignoredIds, unknownIds :: [Id Observation]
    ([Id Observation]
ignoredIds, [Id Observation]
unknownIds) = [Id Observation]
-> Observations -> ([Id Observation], [Id Observation])
ignoredObservations [Id Observation]
ids Observations
obs

{- | Create a stable 'Observation' 'Id' in a such way that:

1. 'Id' doesn't depend on other inspections in this file.
2. 'Id' uniquely identifies 'Observation' location.
3. 'Id's are guaranteed to be the same if the module content didn't
change between different @stan@ runs.

The 'Observation' 'Id' should look like this:

@
OBS-STAN-XXXX-<module-name-hash>-10:42
@
-}
mkObservationId :: Id Inspection -> ModuleName -> RealSrcSpan -> Id Observation
mkObservationId :: Id Inspection -> ModuleName -> RealSrcSpan -> Id Observation
mkObservationId Id Inspection
insId ModuleName
moduleName RealSrcSpan
srcSpan = Text -> Id Observation
forall a. Text -> Id a
Id (Text -> Id Observation) -> Text -> Id Observation
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
Text.intercalate Text
"-"
    [ Text
"OBS"
    , Id Inspection -> Text
forall a. Id a -> Text
unId Id Inspection
insId
    , ModuleName -> Text
hashModuleName ModuleName
moduleName
    , Int -> Text
forall b a. (Show a, IsString b) => a -> b
show (RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
srcSpan) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show (RealSrcSpan -> Int
srcSpanStartCol RealSrcSpan
srcSpan)
    ]

#if MIN_VERSION_base64(1,0,0)
extractBase64 :: Data.Base64.Types.Base64 k a -> a
extractBase64 :: forall (k :: Alphabet) a. Base64 k a -> a
extractBase64 = Base64 k a -> a
forall (k :: Alphabet) a. Base64 k a -> a
Data.Base64.Types.extractBase64
#else
extractBase64 :: a -> a
extractBase64 = id
#endif

{- | Hash module name to a short string of length @6@. Hashing
algorithm is the following:

1. First, run SHA-1.
2. Then, encode with @base64@.
3. Last, take first @6@ characters.
-}
hashModuleName :: ModuleName -> Text
hashModuleName :: ModuleName -> Text
hashModuleName =
    Int -> Text -> Text
Text.take Int
6
    (Text -> Text) -> (ModuleName -> Text) -> ModuleName -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base64 'StdPadded Text -> Text
forall (k :: Alphabet) a. Base64 k a -> a
extractBase64
    (Base64 'StdPadded Text -> Text)
-> (ModuleName -> Base64 'StdPadded Text) -> ModuleName -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Base64 'StdPadded Text
Base64.encodeBase64
    (ByteString -> Base64 'StdPadded Text)
-> (ModuleName -> ByteString)
-> ModuleName
-> Base64 'StdPadded Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
SHA1.hash
    (ByteString -> ByteString)
-> (ModuleName -> ByteString) -> ModuleName -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8
    (Text -> ByteString)
-> (ModuleName -> Text) -> ModuleName -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> Text
unModuleName