{-# LANGUAGE RecordWildCards #-}

module Report(writeReport) where

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


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


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

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

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

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

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

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


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

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