{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE DataKinds #-}

module Summary (generateMdSummary, generateJsonSummary, generateExhaustiveConfig) where

import Data.Map qualified as Map
import Control.Monad.Extra
import System.FilePath
import Data.List.Extra
import System.Directory

import Idea
import Apply
import Hint.Type
import Hint.All
import Config.Type
import Test.Annotations
import Deriving.Aeson
import Data.Aeson (encode)
import Data.ByteString.Char8 (unpack)
import Data.ByteString.Lazy (toStrict)

data Summary = Summary
  { Summary -> [BuiltinHint]
sBuiltinRules :: ![BuiltinHint]
  , Summary -> [HintRule]
sLhsRhsRules :: ![HintRule]
  } deriving (Int -> Summary -> ShowS
[Summary] -> ShowS
Summary -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Summary] -> ShowS
$cshowList :: [Summary] -> ShowS
show :: Summary -> String
$cshow :: Summary -> String
showsPrec :: Int -> Summary -> ShowS
$cshowsPrec :: Int -> Summary -> ShowS
Show, forall x. Rep Summary x -> Summary
forall x. Summary -> Rep Summary x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Summary x -> Summary
$cfrom :: forall x. Summary -> Rep Summary x
Generic)
  deriving ([Summary] -> Encoding
[Summary] -> Value
Summary -> Encoding
Summary -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Summary] -> Encoding
$ctoEncodingList :: [Summary] -> Encoding
toJSONList :: [Summary] -> Value
$ctoJSONList :: [Summary] -> Value
toEncoding :: Summary -> Encoding
$ctoEncoding :: Summary -> Encoding
toJSON :: Summary -> Value
$ctoJSON :: Summary -> Value
ToJSON) via CustomJSON '[FieldLabelModifier (StripPrefix "s", CamelToSnake)] Summary

data BuiltinHint = BuiltinHint
  { BuiltinHint -> String
hName :: !String
  , BuiltinHint -> Severity
hSeverity :: !Severity
  , BuiltinHint -> Bool
hRefactoring :: !Bool
  , BuiltinHint -> String
hCategory :: !String
  , BuiltinHint -> [BuiltinExample]
hExamples :: ![BuiltinExample]
  } deriving (Int -> BuiltinHint -> ShowS
[BuiltinHint] -> ShowS
BuiltinHint -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BuiltinHint] -> ShowS
$cshowList :: [BuiltinHint] -> ShowS
show :: BuiltinHint -> String
$cshow :: BuiltinHint -> String
showsPrec :: Int -> BuiltinHint -> ShowS
$cshowsPrec :: Int -> BuiltinHint -> ShowS
Show, BuiltinHint -> BuiltinHint -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BuiltinHint -> BuiltinHint -> Bool
$c/= :: BuiltinHint -> BuiltinHint -> Bool
== :: BuiltinHint -> BuiltinHint -> Bool
$c== :: BuiltinHint -> BuiltinHint -> Bool
Eq, Eq BuiltinHint
BuiltinHint -> BuiltinHint -> Bool
BuiltinHint -> BuiltinHint -> Ordering
BuiltinHint -> BuiltinHint -> BuiltinHint
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BuiltinHint -> BuiltinHint -> BuiltinHint
$cmin :: BuiltinHint -> BuiltinHint -> BuiltinHint
max :: BuiltinHint -> BuiltinHint -> BuiltinHint
$cmax :: BuiltinHint -> BuiltinHint -> BuiltinHint
>= :: BuiltinHint -> BuiltinHint -> Bool
$c>= :: BuiltinHint -> BuiltinHint -> Bool
> :: BuiltinHint -> BuiltinHint -> Bool
$c> :: BuiltinHint -> BuiltinHint -> Bool
<= :: BuiltinHint -> BuiltinHint -> Bool
$c<= :: BuiltinHint -> BuiltinHint -> Bool
< :: BuiltinHint -> BuiltinHint -> Bool
$c< :: BuiltinHint -> BuiltinHint -> Bool
compare :: BuiltinHint -> BuiltinHint -> Ordering
$ccompare :: BuiltinHint -> BuiltinHint -> Ordering
Ord, forall x. Rep BuiltinHint x -> BuiltinHint
forall x. BuiltinHint -> Rep BuiltinHint x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BuiltinHint x -> BuiltinHint
$cfrom :: forall x. BuiltinHint -> Rep BuiltinHint x
Generic)
  deriving ([BuiltinHint] -> Encoding
[BuiltinHint] -> Value
BuiltinHint -> Encoding
BuiltinHint -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [BuiltinHint] -> Encoding
$ctoEncodingList :: [BuiltinHint] -> Encoding
toJSONList :: [BuiltinHint] -> Value
$ctoJSONList :: [BuiltinHint] -> Value
toEncoding :: BuiltinHint -> Encoding
$ctoEncoding :: BuiltinHint -> Encoding
toJSON :: BuiltinHint -> Value
$ctoJSON :: BuiltinHint -> Value
ToJSON) via CustomJSON '[FieldLabelModifier (StripPrefix "h", CamelToSnake)] BuiltinHint

data BuiltinKey = BuiltinKey
  { BuiltinKey -> String
kName :: !String
  , BuiltinKey -> Severity
kSeverity :: !Severity
  , BuiltinKey -> Bool
kRefactoring :: !Bool
  , BuiltinKey -> String
kCategory :: !String
  } deriving (Int -> BuiltinKey -> ShowS
[BuiltinKey] -> ShowS
BuiltinKey -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BuiltinKey] -> ShowS
$cshowList :: [BuiltinKey] -> ShowS
show :: BuiltinKey -> String
$cshow :: BuiltinKey -> String
showsPrec :: Int -> BuiltinKey -> ShowS
$cshowsPrec :: Int -> BuiltinKey -> ShowS
Show, BuiltinKey -> BuiltinKey -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BuiltinKey -> BuiltinKey -> Bool
$c/= :: BuiltinKey -> BuiltinKey -> Bool
== :: BuiltinKey -> BuiltinKey -> Bool
$c== :: BuiltinKey -> BuiltinKey -> Bool
Eq, Eq BuiltinKey
BuiltinKey -> BuiltinKey -> Bool
BuiltinKey -> BuiltinKey -> Ordering
BuiltinKey -> BuiltinKey -> BuiltinKey
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BuiltinKey -> BuiltinKey -> BuiltinKey
$cmin :: BuiltinKey -> BuiltinKey -> BuiltinKey
max :: BuiltinKey -> BuiltinKey -> BuiltinKey
$cmax :: BuiltinKey -> BuiltinKey -> BuiltinKey
>= :: BuiltinKey -> BuiltinKey -> Bool
$c>= :: BuiltinKey -> BuiltinKey -> Bool
> :: BuiltinKey -> BuiltinKey -> Bool
$c> :: BuiltinKey -> BuiltinKey -> Bool
<= :: BuiltinKey -> BuiltinKey -> Bool
$c<= :: BuiltinKey -> BuiltinKey -> Bool
< :: BuiltinKey -> BuiltinKey -> Bool
$c< :: BuiltinKey -> BuiltinKey -> Bool
compare :: BuiltinKey -> BuiltinKey -> Ordering
$ccompare :: BuiltinKey -> BuiltinKey -> Ordering
Ord)

data BuiltinExample = BuiltinExample
    { BuiltinExample -> String
eContext :: !String
    , BuiltinExample -> String
eFrom :: !String
    , BuiltinExample -> Maybe String
eTo :: !(Maybe String)
    } deriving (Int -> BuiltinExample -> ShowS
[BuiltinExample] -> ShowS
BuiltinExample -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BuiltinExample] -> ShowS
$cshowList :: [BuiltinExample] -> ShowS
show :: BuiltinExample -> String
$cshow :: BuiltinExample -> String
showsPrec :: Int -> BuiltinExample -> ShowS
$cshowsPrec :: Int -> BuiltinExample -> ShowS
Show, BuiltinExample -> BuiltinExample -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BuiltinExample -> BuiltinExample -> Bool
$c/= :: BuiltinExample -> BuiltinExample -> Bool
== :: BuiltinExample -> BuiltinExample -> Bool
$c== :: BuiltinExample -> BuiltinExample -> Bool
Eq, Eq BuiltinExample
BuiltinExample -> BuiltinExample -> Bool
BuiltinExample -> BuiltinExample -> Ordering
BuiltinExample -> BuiltinExample -> BuiltinExample
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BuiltinExample -> BuiltinExample -> BuiltinExample
$cmin :: BuiltinExample -> BuiltinExample -> BuiltinExample
max :: BuiltinExample -> BuiltinExample -> BuiltinExample
$cmax :: BuiltinExample -> BuiltinExample -> BuiltinExample
>= :: BuiltinExample -> BuiltinExample -> Bool
$c>= :: BuiltinExample -> BuiltinExample -> Bool
> :: BuiltinExample -> BuiltinExample -> Bool
$c> :: BuiltinExample -> BuiltinExample -> Bool
<= :: BuiltinExample -> BuiltinExample -> Bool
$c<= :: BuiltinExample -> BuiltinExample -> Bool
< :: BuiltinExample -> BuiltinExample -> Bool
$c< :: BuiltinExample -> BuiltinExample -> Bool
compare :: BuiltinExample -> BuiltinExample -> Ordering
$ccompare :: BuiltinExample -> BuiltinExample -> Ordering
Ord, forall x. Rep BuiltinExample x -> BuiltinExample
forall x. BuiltinExample -> Rep BuiltinExample x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BuiltinExample x -> BuiltinExample
$cfrom :: forall x. BuiltinExample -> Rep BuiltinExample x
Generic)
    deriving ([BuiltinExample] -> Encoding
[BuiltinExample] -> Value
BuiltinExample -> Encoding
BuiltinExample -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [BuiltinExample] -> Encoding
$ctoEncodingList :: [BuiltinExample] -> Encoding
toJSONList :: [BuiltinExample] -> Value
$ctoJSONList :: [BuiltinExample] -> Value
toEncoding :: BuiltinExample -> Encoding
$ctoEncoding :: BuiltinExample -> Encoding
toJSON :: BuiltinExample -> Value
$ctoJSON :: BuiltinExample -> Value
ToJSON) via CustomJSON '[FieldLabelModifier (StripPrefix "e", CamelToSnake)] BuiltinExample

dedupBuiltin :: [(BuiltinKey, BuiltinExample)] -> [BuiltinHint]
dedupBuiltin :: [(BuiltinKey, BuiltinExample)] -> [BuiltinHint]
dedupBuiltin = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (BuiltinKey, [BuiltinExample]) -> BuiltinHint
makeHint forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
Map.toAscList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith forall a. Semigroup a => a -> a -> a
(<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {a} {a}. (a, a) -> (a, [a])
exampleToList where
  exampleToList :: (a, a) -> (a, [a])
exampleToList (a
k, a
e) = (a
k, [a
e])
  makeHint :: (BuiltinKey, [BuiltinExample]) -> BuiltinHint
makeHint (BuiltinKey{Bool
String
Severity
kCategory :: String
kRefactoring :: Bool
kSeverity :: Severity
kName :: String
kCategory :: BuiltinKey -> String
kRefactoring :: BuiltinKey -> Bool
kSeverity :: BuiltinKey -> Severity
kName :: BuiltinKey -> String
..}, [BuiltinExample]
examples) = String
-> Severity -> Bool -> String -> [BuiltinExample] -> BuiltinHint
BuiltinHint
    String
kName
    Severity
kSeverity
    Bool
kRefactoring
    String
kCategory
    [BuiltinExample]
examples

-- | The summary of built-in hints is generated by running the test cases in
-- @src/Hint/*.hs@.
mkBuiltinSummary :: IO [BuiltinHint]
mkBuiltinSummary :: IO [BuiltinHint]
mkBuiltinSummary = forall (m :: * -> *) a b. Monad m => [a] -> (a -> m [b]) -> m [b]
concatForM [(String, Hint)]
builtinHints forall a b. (a -> b) -> a -> b
$ \(String
category, Hint
hint) -> do
    let file :: String
file = String
"src/Hint" String -> ShowS
</> String
category String -> ShowS
<.> String
"hs"
    Bool
b <- String -> IO Bool
doesFileExist String
file
    if Bool -> Bool
not Bool
b then do
        String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
"Couldn't find source hint file " forall a. [a] -> [a] -> [a]
++ String
file forall a. [a] -> [a] -> [a]
++ String
", some hints will be missing"
        forall (f :: * -> *) a. Applicative f => a -> f a
pure []
     else do
        [TestCase]
tests <- String -> IO [TestCase]
parseTestFile String
file
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(BuiltinKey, BuiltinExample)] -> [BuiltinHint]
dedupBuiltin forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a b. Monad m => [a] -> (a -> m [b]) -> m [b]
concatForM [TestCase]
tests forall a b. (a -> b) -> a -> b
$ \(TestCase SrcLoc
_ Refactor
_ String
inp Maybe String
_ [Setting]
_) -> do
            Either ParseError ModuleEx
m <- ParseFlags
-> String -> Maybe String -> IO (Either ParseError ModuleEx)
parseModuleEx ParseFlags
defaultParseFlags String
file (forall a. a -> Maybe a
Just String
inp)
            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ case Either ParseError ModuleEx
m of
                Right ModuleEx
m -> forall a b. (a -> b) -> [a] -> [b]
map (String -> String -> Idea -> (BuiltinKey, BuiltinExample)
ideaToValue String
category String
inp) forall a b. (a -> b) -> a -> b
$ [Classify] -> Hint -> [ModuleEx] -> [Idea]
applyHints [] Hint
hint [ModuleEx
m]
                Left ParseError
_ -> []
    where
        ideaToValue :: String -> String -> Idea -> (BuiltinKey, BuiltinExample)
        ideaToValue :: String -> String -> Idea -> (BuiltinKey, BuiltinExample)
ideaToValue String
category String
inp Idea{String
[String]
[Refactoring SrcSpan]
[Note]
Maybe String
SrcSpan
Severity
ideaRefactoring :: Idea -> [Refactoring SrcSpan]
ideaNote :: Idea -> [Note]
ideaTo :: Idea -> Maybe String
ideaFrom :: Idea -> String
ideaSpan :: Idea -> SrcSpan
ideaHint :: Idea -> String
ideaSeverity :: Idea -> Severity
ideaDecl :: Idea -> [String]
ideaModule :: Idea -> [String]
ideaRefactoring :: [Refactoring SrcSpan]
ideaNote :: [Note]
ideaTo :: Maybe String
ideaFrom :: String
ideaSpan :: SrcSpan
ideaHint :: String
ideaSeverity :: Severity
ideaDecl :: [String]
ideaModule :: [String]
..} = (BuiltinKey
k, BuiltinExample
v)
            where
                -- make sure Windows/Linux don't differ on path separators
                to :: Maybe String
to = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\String
x -> if String
"Combine with " forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
x then forall a. Eq a => [a] -> [a] -> [a] -> [a]
replace String
"\\" String
"/" String
x else String
x) Maybe String
ideaTo
                k :: BuiltinKey
k = String -> Severity -> Bool -> String -> BuiltinKey
BuiltinKey String
ideaHint Severity
ideaSeverity (forall a. [a] -> Bool
notNull [Refactoring SrcSpan]
ideaRefactoring) String
category
                v :: BuiltinExample
v = String -> String -> Maybe String -> BuiltinExample
BuiltinExample String
inp String
ideaFrom Maybe String
to

getSummary :: [Setting] -> IO Summary
getSummary :: [Setting] -> IO Summary
getSummary [Setting]
settings = do
  [BuiltinHint]
builtinHints <- IO [BuiltinHint]
mkBuiltinSummary
  let lhsRhsHints :: [HintRule]
lhsRhsHints = [HintRule
hint | SettingMatchExp HintRule
hint <- [Setting]
settings]
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [BuiltinHint] -> [HintRule] -> Summary
Summary [BuiltinHint]
builtinHints [HintRule]
lhsRhsHints

jsonToString :: ToJSON a => a -> String
jsonToString :: forall a. ToJSON a => a -> String
jsonToString = ByteString -> String
unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> ByteString
encode

-- | Generate a summary of hints, including built-in hints and YAML-configured hints
generateMdSummary :: [Setting] -> IO String
generateMdSummary :: [Setting] -> IO String
generateMdSummary = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Summary -> String
genSummaryMd forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Setting] -> IO Summary
getSummary

generateJsonSummary :: [Setting] -> IO String
generateJsonSummary :: [Setting] -> IO String
generateJsonSummary = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. ToJSON a => a -> String
jsonToString forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Setting] -> IO Summary
getSummary

generateExhaustiveConfig :: Severity -> [Setting] -> IO String
generateExhaustiveConfig :: Severity -> [Setting] -> IO String
generateExhaustiveConfig Severity
severity = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Severity -> Summary -> String
genExhaustiveConfig Severity
severity) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Setting] -> IO Summary
getSummary

genExhaustiveConfig :: Severity -> Summary -> String
genExhaustiveConfig :: Severity -> Summary -> String
genExhaustiveConfig Severity
severity Summary{[HintRule]
[BuiltinHint]
sLhsRhsRules :: [HintRule]
sBuiltinRules :: [BuiltinHint]
sLhsRhsRules :: Summary -> [HintRule]
sBuiltinRules :: Summary -> [BuiltinHint]
..} = [String] -> String
unlines forall a b. (a -> b) -> a -> b
$
  [ String
"# HLint configuration file"
  , String
"# https://github.com/ndmitchell/hlint"
  , String
"##########################"
  , String
""
  , String
"# This file contains a template configuration file, which is typically"
  , String
"# placed as .hlint.yaml in the root of your project"
  , String
""
  , String
"# All built-in hints"
  ]
    forall a. [a] -> [a] -> [a]
++ (forall a. ToJSON a => a -> String
mkLine forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> [String]
sortDedup (BuiltinHint -> String
hName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [BuiltinHint]
sBuiltinRules))
    forall a. [a] -> [a] -> [a]
++ [String
"", String
"# All LHS/RHS hints"]
    forall a. [a] -> [a] -> [a]
++ (forall a. ToJSON a => a -> String
mkLine forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> [String]
sortDedup (HintRule -> String
hintRuleName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [HintRule]
sLhsRhsRules))
  where
    sortDedup :: [String] -> [String]
sortDedup = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [[a]]
group forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> [a]
sort
    mkLine :: a -> String
mkLine a
name = String
"- " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Severity
severity forall a. Semigroup a => a -> a -> a
<> String
": {name: " forall a. Semigroup a => a -> a -> a
<> forall a. ToJSON a => a -> String
jsonToString a
name forall a. Semigroup a => a -> a -> a
<> String
"}"

genSummaryMd :: Summary -> String
genSummaryMd :: Summary -> String
genSummaryMd Summary{[HintRule]
[BuiltinHint]
sLhsRhsRules :: [HintRule]
sBuiltinRules :: [BuiltinHint]
sLhsRhsRules :: Summary -> [HintRule]
sBuiltinRules :: Summary -> [BuiltinHint]
..} = [String] -> String
unlines forall a b. (a -> b) -> a -> b
$
  [ String
"# Summary of Hints"
  , String
""
  , String
"This page is auto-generated from `hlint --generate-summary`."
  ] forall a. [a] -> [a] -> [a]
++
  forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"" forall a. a -> [a] -> [a]
: (String
"## Builtin " forall a. [a] -> [a] -> [a]
++ String
group ) forall a. a -> [a] -> [a]
: String
"" forall a. a -> [a] -> [a]
: [BuiltinHint] -> [String]
builtinTable [BuiltinHint]
hints | (String
group, [BuiltinHint]
hints) <- [BuiltinHint] -> [(String, [BuiltinHint])]
groupHintsByCategory [BuiltinHint]
sBuiltinRules] forall a. [a] -> [a] -> [a]
++
  [ String
""
  , String
"## Configured hints"
  , String
""
  ]
  forall a. [a] -> [a] -> [a]
++ [HintRule] -> [String]
lhsRhsTable [HintRule]
sLhsRhsRules
  where
    groupHintsByCategory :: [BuiltinHint] -> [(String, [BuiltinHint])]
groupHintsByCategory = forall k a. Map k a -> [(k, a)]
Map.toAscList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith forall a. Semigroup a => a -> a -> a
(<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BuiltinHint -> (String, [BuiltinHint])
keyCategory
    keyCategory :: BuiltinHint -> (String, [BuiltinHint])
keyCategory BuiltinHint
hint = (BuiltinHint -> String
hCategory BuiltinHint
hint, [BuiltinHint
hint])

row :: [String] -> [String]
row :: [String] -> [String]
row [String]
xs = [String
"<tr>"] forall a. [a] -> [a] -> [a]
++ [String]
xs forall a. [a] -> [a] -> [a]
++ [String
"</tr>"]

-- | Render using <code> if it is single-line, otherwise using <pre>.
haskell :: String -> [String]
haskell :: String -> [String]
haskell String
s
  | Char
'\n' forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
s = [String
"<pre>", String
s, String
"</pre>"]
  | Bool
otherwise = [String
"<code>", String
s, String
"</code>", String
"<br>"]

builtinTable :: [BuiltinHint] -> [String]
builtinTable :: [BuiltinHint] -> [String]
builtinTable [BuiltinHint]
builtins =
  [String
"<table>"]
  forall a. [a] -> [a] -> [a]
++ [String] -> [String]
row [String
"<th>Hint Name</th>", String
"<th>Hint</th>", String
"<th>Severity</th>"]
  forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap BuiltinHint -> [String]
showBuiltin [BuiltinHint]
builtins
  forall a. [a] -> [a] -> [a]
++ [String
"</table>"]

showBuiltin :: BuiltinHint -> [String]
showBuiltin :: BuiltinHint -> [String]
showBuiltin BuiltinHint{Bool
String
[BuiltinExample]
Severity
hExamples :: [BuiltinExample]
hCategory :: String
hRefactoring :: Bool
hSeverity :: Severity
hName :: String
hExamples :: BuiltinHint -> [BuiltinExample]
hCategory :: BuiltinHint -> String
hRefactoring :: BuiltinHint -> Bool
hSeverity :: BuiltinHint -> Severity
hName :: BuiltinHint -> String
..} = [String]
row1
  where
    row1 :: [String]
row1 = [String] -> [String]
row forall a b. (a -> b) -> a -> b
$
      [ String
"<td>" forall a. [a] -> [a] -> [a]
++ String
hName forall a. [a] -> [a] -> [a]
++ String
"</td>", String
"<td>"]
      forall a. [a] -> [a] -> [a]
++ BuiltinExample -> [String]
showExample (forall a. [a] -> a
head [BuiltinExample]
hExamples)
      forall a. [a] -> [a] -> [a]
++ [String
"Does not support refactoring." | Bool -> Bool
not Bool
hRefactoring]
      forall a. [a] -> [a] -> [a]
++ [String
"</td>"] forall a. [a] -> [a] -> [a]
++
      [ String
"<td>" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Severity
hSeverity forall a. [a] -> [a] -> [a]
++ String
"</td>"
      ]
    showExample :: BuiltinExample -> [String]
showExample BuiltinExample{String
Maybe String
eTo :: Maybe String
eFrom :: String
eContext :: String
eTo :: BuiltinExample -> Maybe String
eFrom :: BuiltinExample -> String
eContext :: BuiltinExample -> String
..} =
      [String
"Example: "]
        forall a. [a] -> [a] -> [a]
++ String -> [String]
haskell String
eContext
        forall a. [a] -> [a] -> [a]
++ [String
"Found:"]
        forall a. [a] -> [a] -> [a]
++ String -> [String]
haskell String
eFrom
        forall a. [a] -> [a] -> [a]
++ [String
"Suggestion:"]
        forall a. [a] -> [a] -> [a]
++ String -> [String]
haskell String
eTo'
      where
      eTo' :: String
eTo' = case Maybe String
eTo of
        Maybe String
Nothing -> String
""
        Just String
"" -> String
"Perhaps you should remove it."
        Just String
s -> String
s

lhsRhsTable :: [HintRule] -> [String]
lhsRhsTable :: [HintRule] -> [String]
lhsRhsTable [HintRule]
hints =
  [String
"<table>"]
  forall a. [a] -> [a] -> [a]
++ [String] -> [String]
row [String
"<th>Hint Name</th>", String
"<th>Hint</th>", String
"<th>Severity</th>"]
  forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap HintRule -> [String]
showLhsRhs [HintRule]
hints
  forall a. [a] -> [a] -> [a]
++ [String
"</table>"]

showLhsRhs :: HintRule -> [String]
showLhsRhs :: HintRule -> [String]
showLhsRhs HintRule{String
[Note]
Maybe (HsExtendInstances (LHsExpr GhcPs))
HsExtendInstances (LHsExpr GhcPs)
Scope
Severity
hintRuleSide :: HintRule -> Maybe (HsExtendInstances (LHsExpr GhcPs))
hintRuleRHS :: HintRule -> HsExtendInstances (LHsExpr GhcPs)
hintRuleLHS :: HintRule -> HsExtendInstances (LHsExpr GhcPs)
hintRuleScope :: HintRule -> Scope
hintRuleNotes :: HintRule -> [Note]
hintRuleSeverity :: HintRule -> Severity
hintRuleSide :: Maybe (HsExtendInstances (LHsExpr GhcPs))
hintRuleRHS :: HsExtendInstances (LHsExpr GhcPs)
hintRuleLHS :: HsExtendInstances (LHsExpr GhcPs)
hintRuleScope :: Scope
hintRuleNotes :: [Note]
hintRuleName :: String
hintRuleSeverity :: Severity
hintRuleName :: HintRule -> String
..} = [String] -> [String]
row forall a b. (a -> b) -> a -> b
$
  [ String
"<td>" forall a. [a] -> [a] -> [a]
++ String
hintRuleName forall a. [a] -> [a] -> [a]
++ String
"</td>"
  , String
"<td>"
  , String
"LHS:"
  ]
  forall a. [a] -> [a] -> [a]
++ String -> [String]
haskell (forall a. Show a => a -> String
show HsExtendInstances (LHsExpr GhcPs)
hintRuleLHS)
  forall a. [a] -> [a] -> [a]
++ [String
"RHS:"]
  forall a. [a] -> [a] -> [a]
++ String -> [String]
haskell (forall a. Show a => a -> String
show HsExtendInstances (LHsExpr GhcPs)
hintRuleRHS)
  forall a. [a] -> [a] -> [a]
++
  [ String
"</td>"
  , String
"<td>" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Severity
hintRuleSeverity forall a. [a] -> [a] -> [a]
++ String
"</td>"
  ]