{-# 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 dataDir :: FilePath
dataDir content :: [(FilePath, [FilePath])]
content to :: 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 ('$':xs :: FilePath
xs) = [FilePath] -> Maybe [FilePath] -> [FilePath]
forall a. a -> Maybe a -> a
fromMaybe ['$'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 x :: FilePath
x = [FilePath
x]
writeReport :: FilePath -> FilePath -> [Idea] -> IO ()
writeReport :: FilePath -> FilePath -> [Idea] -> IO ()
writeReport dataDir :: FilePath
dataDir file :: FilePath
file ideas :: [Idea]
ideas = FilePath -> FilePath -> IO () -> IO ()
forall a. FilePath -> FilePath -> IO a -> IO a
timedIO "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)]
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
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 x :: 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
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 = [("VERSION",['v' Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: Version -> FilePath
showVersion Version
version]),("CONTENT", ["No hints"]),
("HINTS", ["<li>No hints</li>"]),("FILES", ["<li>No files</li>"])]
nonEmptyInner :: [(FilePath, [FilePath])]
nonEmptyInner = [("VERSION",['v' Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: Version -> FilePath
showVersion Version
version]),("CONTENT",[FilePath]
content),
("HINTS",FilePath -> [(FilePath, Int)] -> [FilePath]
forall a. Show a => FilePath -> [(FilePath, a)] -> [FilePath]
list "hint" [(FilePath, Int)]
hints),("FILES",FilePath -> [(FilePath, Int)] -> [FilePath]
forall a. Show a => FilePath -> [(FilePath, a)] -> [FilePath]
list "file" [(FilePath, Int)]
files)]
content :: [FilePath]
content = (Idea -> [FilePath]) -> [Idea] -> [FilePath]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\i :: Idea
i -> FilePath -> Idea -> [FilePath]
writeIdea (Idea -> FilePath
getClass Idea
i) Idea
i) [Idea]
ideas
getClass :: Idea -> FilePath
getClass i :: Idea
i = "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]
++ " 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 xs :: [(a, b)]
xs x :: 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 mode :: 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 0
where
f :: a -> (FilePath, a) -> FilePath
f i :: a
i (name :: FilePath
name,n :: a
n) = "<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]
++ " href=\"javascript:show('" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
id FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "')\">" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
FilePath -> FilePath
escapeHTML FilePath
name FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ " (" 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]
++ ")</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 cls :: FilePath
cls Idea{..} =
["<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
escapeHTML (SrcSpan -> FilePath
GHC.showSrcSpan SrcSpan
ideaSpan FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ": " 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
forall a. [a] -> [a] -> [a]
++ FilePath
ideaHint) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "<br/>"
,"Found<br/>"
,FilePath -> FilePath
hsColourHTML FilePath
ideaFrom] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
(case Maybe FilePath
ideaTo of
Nothing -> []
Just to :: FilePath
to ->
["Perhaps" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (if FilePath
to FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== "" then " you should remove it." else "") FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "<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
/= "" then "<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]
++ "</span>" else ""
,"</div>"
,""]
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 "`"
where f :: [FilePath] -> FilePath
f (a :: FilePath
a:b :: FilePath
b:c :: [FilePath]
c) = FilePath -> FilePath
escapeHTML FilePath
a FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "<tt>" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
escapeHTML FilePath
b FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "</tt>" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
f [FilePath]
c
f xs :: [FilePath]
xs = (FilePath -> FilePath) -> [FilePath] -> FilePath
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap FilePath -> FilePath
escapeHTML [FilePath]
xs