{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE RecordWildCards #-}

module Report(writeReport) where

import Idea
import Data.Tuple.Extra
import Data.List.Extra
import Data.List.NonEmpty qualified as NE
import Data.Maybe
import Data.Version
import Timing
import Paths_hlint
import HsColour
import EmbedData
import GHC.Util qualified as GHC


writeTemplate :: FilePath -> [(String,[String])] -> FilePath -> IO ()
writeTemplate :: String -> [(String, [String])] -> String -> IO ()
writeTemplate String
dataDir [(String, [String])]
content String
to =
    String -> String -> IO ()
writeFile String
to (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (String -> [String]) -> [String] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap String -> [String]
f ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines String
reportTemplate
    where
        f :: String -> [String]
f (Char
'$':String
xs) = [String] -> Maybe [String] -> [String]
forall a. a -> Maybe a -> a
fromMaybe [Char
'$'Char -> String -> String
forall a. a -> [a] -> [a]
:String
xs] (Maybe [String] -> [String]) -> Maybe [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [(String, [String])] -> Maybe [String]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
xs [(String, [String])]
content
        f String
x = [String
x]


writeReport :: FilePath -> FilePath -> [Idea] -> IO ()
writeReport :: String -> String -> [Idea] -> IO ()
writeReport String
dataDir String
file [Idea]
ideas = String -> String -> IO () -> IO ()
forall a. String -> String -> IO a -> IO a
timedIO String
"Report" String
file (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> [(String, [String])] -> String -> IO ()
writeTemplate String
dataDir [(String, [String])]
inner String
file
    where
        generateIds :: [String] -> [(String,Int)] -- sorted by name
        generateIds :: [String] -> [(String, Int)]
generateIds = (NonEmpty String -> (String, Int))
-> [NonEmpty String] -> [(String, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (NonEmpty String -> String
forall a. NonEmpty a -> a
NE.head (NonEmpty String -> String)
-> (NonEmpty String -> Int) -> NonEmpty String -> (String, Int)
forall a b c. (a -> b) -> (a -> c) -> a -> (b, c)
&&& NonEmpty String -> Int
forall a. NonEmpty a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) ([NonEmpty String] -> [(String, Int)])
-> ([String] -> [NonEmpty String]) -> [String] -> [(String, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [NonEmpty String]
forall (f :: * -> *) a. (Foldable f, Eq a) => f a -> [NonEmpty a]
NE.group -- must be already sorted
        files :: [(String, Int)]
files = [String] -> [(String, Int)]
generateIds ([String] -> [(String, Int)]) -> [String] -> [(String, Int)]
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
forall a. Ord a => [a] -> [a]
sort ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (Idea -> String) -> [Idea] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (SrcSpan -> String
GHC.srcSpanFilename (SrcSpan -> String) -> (Idea -> SrcSpan) -> Idea -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Idea -> SrcSpan
ideaSpan) [Idea]
ideas
        hints :: [(String, Int)]
hints = [String] -> [(String, Int)]
generateIds ([String] -> [(String, Int)]) -> [String] -> [(String, Int)]
forall a b. (a -> b) -> a -> b
$ (Idea -> String) -> [Idea] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Idea -> String
hintName ([Idea] -> [String]) -> [Idea] -> [String]
forall a b. (a -> b) -> a -> b
$ (Idea -> (Int, String)) -> [Idea] -> [Idea]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Int -> Int
forall a. Num a => a -> a
negate (Int -> Int) -> (Idea -> Int) -> Idea -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Severity -> Int
forall a. Enum a => a -> Int
fromEnum (Severity -> Int) -> (Idea -> Severity) -> Idea -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Idea -> Severity
ideaSeverity (Idea -> Int) -> (Idea -> String) -> Idea -> (Int, String)
forall a b c. (a -> b) -> (a -> c) -> a -> (b, c)
&&& Idea -> String
hintName) [Idea]
ideas
        hintName :: Idea -> String
hintName Idea
x = Severity -> String
forall a. Show a => a -> String
show (Idea -> Severity
ideaSeverity Idea
x) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Idea -> String
ideaHint Idea
x

        inner :: [(String, [String])]
inner = if [Idea] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Idea]
ideas then [(String, [String])]
emptyInner else [(String, [String])]
nonEmptyInner

        emptyInner :: [(String, [String])]
emptyInner = [(String
"VERSION",[Char
'v' Char -> String -> String
forall a. a -> [a] -> [a]
: Version -> String
showVersion Version
version]),(String
"CONTENT", [String
"No hints"]),
                      (String
"HINTS", [String
"<li>No hints</li>"]),(String
"FILES", [String
"<li>No files</li>"])]

        nonEmptyInner :: [(String, [String])]
nonEmptyInner = [(String
"VERSION",[Char
'v' Char -> String -> String
forall a. a -> [a] -> [a]
: Version -> String
showVersion Version
version]),(String
"CONTENT",[String]
content),
                         (String
"HINTS",String -> [(String, Int)] -> [String]
forall {a}. Show a => String -> [(String, a)] -> [String]
list String
"hint" [(String, Int)]
hints),(String
"FILES",String -> [(String, Int)] -> [String]
forall {a}. Show a => String -> [(String, a)] -> [String]
list String
"file" [(String, Int)]
files)]

        content :: [String]
content = (Idea -> [String]) -> [Idea] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Idea
i -> String -> Idea -> [String]
writeIdea (Idea -> String
getClass Idea
i) Idea
i) [Idea]
ideas
        getClass :: Idea -> String
getClass Idea
i = String
"hint" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [(String, Int)] -> String -> String
forall {b} {b}. Eq b => [(b, b)] -> b -> String
f [(String, Int)]
hints (Idea -> String
hintName Idea
i) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" file" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [(String, Int)] -> String -> String
forall {b} {b}. Eq b => [(b, b)] -> b -> String
f [(String, Int)]
files (SrcSpan -> String
GHC.srcSpanFilename (SrcSpan -> String) -> SrcSpan -> String
forall a b. (a -> b) -> a -> b
$ Idea -> SrcSpan
ideaSpan Idea
i)
            where f :: [(b, b)] -> b -> String
f [(b, b)]
xs b
x = Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Int
forall a. Partial => Maybe a -> a
fromJust (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ ((b, b) -> Bool) -> [(b, b)] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex (b -> b -> Bool
forall a. Eq a => a -> a -> Bool
(==) b
x (b -> Bool) -> ((b, b) -> b) -> (b, b) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b, b) -> b
forall a b. (a, b) -> a
fst) [(b, b)]
xs

        list :: String -> [(String, a)] -> [String]
list String
mode = (Integer -> (String, a) -> String)
-> Integer -> [(String, a)] -> [String]
forall a b c. Enum a => (a -> b -> c) -> a -> [b] -> [c]
zipWithFrom Integer -> (String, a) -> String
forall {a} {p}. (Show a, Show p) => p -> (String, a) -> String
f Integer
0
            where
                f :: p -> (String, a) -> String
f p
i (String
name,a
n) = String
"<li><a id=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
id String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" href=\"javascript:show('" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
id String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"')\">" String -> String -> String
forall a. [a] -> [a] -> [a]
++
                               String -> String
escapeHTML String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")</a></li>"
                    where id :: String
id = String
mode String -> String -> String
forall a. [a] -> [a] -> [a]
++ p -> String
forall a. Show a => a -> String
show p
i


writeIdea :: String -> Idea -> [String]
writeIdea :: String -> Idea -> [String]
writeIdea String
cls Idea{String
[String]
[Refactoring SrcSpan]
[Note]
Maybe String
SrcSpan
Severity
ideaSpan :: Idea -> SrcSpan
ideaSeverity :: Idea -> Severity
ideaHint :: Idea -> String
ideaModule :: [String]
ideaDecl :: [String]
ideaSeverity :: Severity
ideaHint :: String
ideaSpan :: SrcSpan
ideaFrom :: String
ideaTo :: Maybe String
ideaNote :: [Note]
ideaRefactoring :: [Refactoring SrcSpan]
ideaModule :: Idea -> [String]
ideaDecl :: Idea -> [String]
ideaFrom :: Idea -> String
ideaTo :: Idea -> Maybe String
ideaNote :: Idea -> [Note]
ideaRefactoring :: Idea -> [Refactoring SrcSpan]
..} =
    [String
"<div class=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
cls String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
">"
    ,String -> String
escapeHTML (SrcSpan -> String
GHC.showSrcSpan SrcSpan
ideaSpan String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Severity -> String
forall a. Show a => a -> String
show Severity
ideaSeverity String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ideaHint) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"<br/>"
    ,String
"Found<br/>"
    ,String -> String
hsColourHTML String
ideaFrom] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
    (case Maybe String
ideaTo of
        Maybe String
Nothing -> []
        Just String
to ->
            [String
"Perhaps" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (if String
to String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"" then String
" you should remove it." else String
"") String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"<br/>"
            ,String -> String
hsColourHTML String
to]) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
    [let n :: String
n = [Note] -> String
showNotes [Note]
ideaNote in if String
n String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"" then String
"<span class='note'>Note: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
writeNote String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"</span>" else String
""
    ,String
"</div>"
    ,String
""]

-- Unescaped, but may have `backticks` for code
writeNote :: String -> String
writeNote :: String -> String
writeNote = [String] -> String
f ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> [String]
forall a. (Partial, Eq a) => [a] -> [a] -> [[a]]
splitOn String
"`"
    where f :: [String] -> String
f (String
a:String
b:[String]
c) = String -> String
escapeHTML String
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"<tt>" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
escapeHTML String
b String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"</tt>" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
f [String]
c
          f [String]
xs = (String -> String) -> [String] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap String -> String
escapeHTML [String]
xs