{-# 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.NonEmpty qualified as NE
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
(Int -> Summary -> ShowS)
-> (Summary -> String) -> ([Summary] -> ShowS) -> Show Summary
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Summary -> ShowS
showsPrec :: Int -> Summary -> ShowS
$cshow :: Summary -> String
show :: Summary -> String
$cshowList :: [Summary] -> ShowS
showList :: [Summary] -> ShowS
Show, (forall x. Summary -> Rep Summary x)
-> (forall x. Rep Summary x -> Summary) -> Generic Summary
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
$cfrom :: forall x. Summary -> Rep Summary x
from :: forall x. Summary -> Rep Summary x
$cto :: forall x. Rep Summary x -> Summary
to :: forall x. Rep Summary x -> Summary
Generic)
  deriving ([Summary] -> Value
[Summary] -> Encoding
Summary -> Bool
Summary -> Value
Summary -> Encoding
(Summary -> Value)
-> (Summary -> Encoding)
-> ([Summary] -> Value)
-> ([Summary] -> Encoding)
-> (Summary -> Bool)
-> ToJSON Summary
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Summary -> Value
toJSON :: Summary -> Value
$ctoEncoding :: Summary -> Encoding
toEncoding :: Summary -> Encoding
$ctoJSONList :: [Summary] -> Value
toJSONList :: [Summary] -> Value
$ctoEncodingList :: [Summary] -> Encoding
toEncodingList :: [Summary] -> Encoding
$comitField :: Summary -> Bool
omitField :: Summary -> Bool
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
(Int -> BuiltinHint -> ShowS)
-> (BuiltinHint -> String)
-> ([BuiltinHint] -> ShowS)
-> Show BuiltinHint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BuiltinHint -> ShowS
showsPrec :: Int -> BuiltinHint -> ShowS
$cshow :: BuiltinHint -> String
show :: BuiltinHint -> String
$cshowList :: [BuiltinHint] -> ShowS
showList :: [BuiltinHint] -> ShowS
Show, BuiltinHint -> BuiltinHint -> Bool
(BuiltinHint -> BuiltinHint -> Bool)
-> (BuiltinHint -> BuiltinHint -> Bool) -> Eq BuiltinHint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BuiltinHint -> BuiltinHint -> Bool
== :: BuiltinHint -> BuiltinHint -> Bool
$c/= :: BuiltinHint -> BuiltinHint -> Bool
/= :: BuiltinHint -> BuiltinHint -> Bool
Eq, Eq BuiltinHint
Eq BuiltinHint =>
(BuiltinHint -> BuiltinHint -> Ordering)
-> (BuiltinHint -> BuiltinHint -> Bool)
-> (BuiltinHint -> BuiltinHint -> Bool)
-> (BuiltinHint -> BuiltinHint -> Bool)
-> (BuiltinHint -> BuiltinHint -> Bool)
-> (BuiltinHint -> BuiltinHint -> BuiltinHint)
-> (BuiltinHint -> BuiltinHint -> BuiltinHint)
-> Ord 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
$ccompare :: BuiltinHint -> BuiltinHint -> Ordering
compare :: BuiltinHint -> BuiltinHint -> Ordering
$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
>= :: BuiltinHint -> BuiltinHint -> Bool
$cmax :: BuiltinHint -> BuiltinHint -> BuiltinHint
max :: BuiltinHint -> BuiltinHint -> BuiltinHint
$cmin :: BuiltinHint -> BuiltinHint -> BuiltinHint
min :: BuiltinHint -> BuiltinHint -> BuiltinHint
Ord, (forall x. BuiltinHint -> Rep BuiltinHint x)
-> (forall x. Rep BuiltinHint x -> BuiltinHint)
-> Generic BuiltinHint
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
$cfrom :: forall x. BuiltinHint -> Rep BuiltinHint x
from :: forall x. BuiltinHint -> Rep BuiltinHint x
$cto :: forall x. Rep BuiltinHint x -> BuiltinHint
to :: forall x. Rep BuiltinHint x -> BuiltinHint
Generic)
  deriving ([BuiltinHint] -> Value
[BuiltinHint] -> Encoding
BuiltinHint -> Bool
BuiltinHint -> Value
BuiltinHint -> Encoding
(BuiltinHint -> Value)
-> (BuiltinHint -> Encoding)
-> ([BuiltinHint] -> Value)
-> ([BuiltinHint] -> Encoding)
-> (BuiltinHint -> Bool)
-> ToJSON BuiltinHint
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: BuiltinHint -> Value
toJSON :: BuiltinHint -> Value
$ctoEncoding :: BuiltinHint -> Encoding
toEncoding :: BuiltinHint -> Encoding
$ctoJSONList :: [BuiltinHint] -> Value
toJSONList :: [BuiltinHint] -> Value
$ctoEncodingList :: [BuiltinHint] -> Encoding
toEncodingList :: [BuiltinHint] -> Encoding
$comitField :: BuiltinHint -> Bool
omitField :: BuiltinHint -> Bool
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
(Int -> BuiltinKey -> ShowS)
-> (BuiltinKey -> String)
-> ([BuiltinKey] -> ShowS)
-> Show BuiltinKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BuiltinKey -> ShowS
showsPrec :: Int -> BuiltinKey -> ShowS
$cshow :: BuiltinKey -> String
show :: BuiltinKey -> String
$cshowList :: [BuiltinKey] -> ShowS
showList :: [BuiltinKey] -> ShowS
Show, BuiltinKey -> BuiltinKey -> Bool
(BuiltinKey -> BuiltinKey -> Bool)
-> (BuiltinKey -> BuiltinKey -> Bool) -> Eq BuiltinKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BuiltinKey -> BuiltinKey -> Bool
== :: BuiltinKey -> BuiltinKey -> Bool
$c/= :: BuiltinKey -> BuiltinKey -> Bool
/= :: BuiltinKey -> BuiltinKey -> Bool
Eq, Eq BuiltinKey
Eq BuiltinKey =>
(BuiltinKey -> BuiltinKey -> Ordering)
-> (BuiltinKey -> BuiltinKey -> Bool)
-> (BuiltinKey -> BuiltinKey -> Bool)
-> (BuiltinKey -> BuiltinKey -> Bool)
-> (BuiltinKey -> BuiltinKey -> Bool)
-> (BuiltinKey -> BuiltinKey -> BuiltinKey)
-> (BuiltinKey -> BuiltinKey -> BuiltinKey)
-> Ord 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
$ccompare :: BuiltinKey -> BuiltinKey -> Ordering
compare :: BuiltinKey -> BuiltinKey -> Ordering
$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
>= :: BuiltinKey -> BuiltinKey -> Bool
$cmax :: BuiltinKey -> BuiltinKey -> BuiltinKey
max :: BuiltinKey -> BuiltinKey -> BuiltinKey
$cmin :: BuiltinKey -> BuiltinKey -> BuiltinKey
min :: BuiltinKey -> BuiltinKey -> BuiltinKey
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
(Int -> BuiltinExample -> ShowS)
-> (BuiltinExample -> String)
-> ([BuiltinExample] -> ShowS)
-> Show BuiltinExample
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BuiltinExample -> ShowS
showsPrec :: Int -> BuiltinExample -> ShowS
$cshow :: BuiltinExample -> String
show :: BuiltinExample -> String
$cshowList :: [BuiltinExample] -> ShowS
showList :: [BuiltinExample] -> ShowS
Show, BuiltinExample -> BuiltinExample -> Bool
(BuiltinExample -> BuiltinExample -> Bool)
-> (BuiltinExample -> BuiltinExample -> Bool) -> Eq BuiltinExample
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BuiltinExample -> BuiltinExample -> Bool
== :: BuiltinExample -> BuiltinExample -> Bool
$c/= :: BuiltinExample -> BuiltinExample -> Bool
/= :: BuiltinExample -> BuiltinExample -> Bool
Eq, Eq BuiltinExample
Eq BuiltinExample =>
(BuiltinExample -> BuiltinExample -> Ordering)
-> (BuiltinExample -> BuiltinExample -> Bool)
-> (BuiltinExample -> BuiltinExample -> Bool)
-> (BuiltinExample -> BuiltinExample -> Bool)
-> (BuiltinExample -> BuiltinExample -> Bool)
-> (BuiltinExample -> BuiltinExample -> BuiltinExample)
-> (BuiltinExample -> BuiltinExample -> BuiltinExample)
-> Ord 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
$ccompare :: BuiltinExample -> BuiltinExample -> Ordering
compare :: BuiltinExample -> BuiltinExample -> Ordering
$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
>= :: BuiltinExample -> BuiltinExample -> Bool
$cmax :: BuiltinExample -> BuiltinExample -> BuiltinExample
max :: BuiltinExample -> BuiltinExample -> BuiltinExample
$cmin :: BuiltinExample -> BuiltinExample -> BuiltinExample
min :: BuiltinExample -> BuiltinExample -> BuiltinExample
Ord, (forall x. BuiltinExample -> Rep BuiltinExample x)
-> (forall x. Rep BuiltinExample x -> BuiltinExample)
-> Generic BuiltinExample
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
$cfrom :: forall x. BuiltinExample -> Rep BuiltinExample x
from :: forall x. BuiltinExample -> Rep BuiltinExample x
$cto :: forall x. Rep BuiltinExample x -> BuiltinExample
to :: forall x. Rep BuiltinExample x -> BuiltinExample
Generic)
    deriving ([BuiltinExample] -> Value
[BuiltinExample] -> Encoding
BuiltinExample -> Bool
BuiltinExample -> Value
BuiltinExample -> Encoding
(BuiltinExample -> Value)
-> (BuiltinExample -> Encoding)
-> ([BuiltinExample] -> Value)
-> ([BuiltinExample] -> Encoding)
-> (BuiltinExample -> Bool)
-> ToJSON BuiltinExample
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: BuiltinExample -> Value
toJSON :: BuiltinExample -> Value
$ctoEncoding :: BuiltinExample -> Encoding
toEncoding :: BuiltinExample -> Encoding
$ctoJSONList :: [BuiltinExample] -> Value
toJSONList :: [BuiltinExample] -> Value
$ctoEncodingList :: [BuiltinExample] -> Encoding
toEncodingList :: [BuiltinExample] -> Encoding
$comitField :: BuiltinExample -> Bool
omitField :: BuiltinExample -> Bool
ToJSON) via CustomJSON '[FieldLabelModifier (StripPrefix "e", CamelToSnake)] BuiltinExample

dedupBuiltin :: [(BuiltinKey, BuiltinExample)] -> [BuiltinHint]
dedupBuiltin :: [(BuiltinKey, BuiltinExample)] -> [BuiltinHint]
dedupBuiltin = ((BuiltinKey, [BuiltinExample]) -> BuiltinHint)
-> [(BuiltinKey, [BuiltinExample])] -> [BuiltinHint]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (BuiltinKey, [BuiltinExample]) -> BuiltinHint
makeHint ([(BuiltinKey, [BuiltinExample])] -> [BuiltinHint])
-> ([(BuiltinKey, BuiltinExample)]
    -> [(BuiltinKey, [BuiltinExample])])
-> [(BuiltinKey, BuiltinExample)]
-> [BuiltinHint]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map BuiltinKey [BuiltinExample] -> [(BuiltinKey, [BuiltinExample])]
forall k a. Map k a -> [(k, a)]
Map.toAscList (Map BuiltinKey [BuiltinExample]
 -> [(BuiltinKey, [BuiltinExample])])
-> ([(BuiltinKey, BuiltinExample)]
    -> Map BuiltinKey [BuiltinExample])
-> [(BuiltinKey, BuiltinExample)]
-> [(BuiltinKey, [BuiltinExample])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([BuiltinExample] -> [BuiltinExample] -> [BuiltinExample])
-> [(BuiltinKey, [BuiltinExample])]
-> Map BuiltinKey [BuiltinExample]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith [BuiltinExample] -> [BuiltinExample] -> [BuiltinExample]
forall a. Semigroup a => a -> a -> a
(<>) ([(BuiltinKey, [BuiltinExample])]
 -> Map BuiltinKey [BuiltinExample])
-> ([(BuiltinKey, BuiltinExample)]
    -> [(BuiltinKey, [BuiltinExample])])
-> [(BuiltinKey, BuiltinExample)]
-> Map BuiltinKey [BuiltinExample]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((BuiltinKey, BuiltinExample) -> (BuiltinKey, [BuiltinExample]))
-> [(BuiltinKey, BuiltinExample)]
-> [(BuiltinKey, [BuiltinExample])]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (BuiltinKey, BuiltinExample) -> (BuiltinKey, [BuiltinExample])
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
kName :: BuiltinKey -> String
kSeverity :: BuiltinKey -> Severity
kRefactoring :: BuiltinKey -> Bool
kCategory :: BuiltinKey -> String
kName :: String
kSeverity :: Severity
kRefactoring :: Bool
kCategory :: 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 = [(String, Hint)]
-> ((String, Hint) -> IO [BuiltinHint]) -> IO [BuiltinHint]
forall (m :: * -> *) a b. Monad m => [a] -> (a -> m [b]) -> m [b]
concatForM [(String, Hint)]
builtinHints (((String, Hint) -> IO [BuiltinHint]) -> IO [BuiltinHint])
-> ((String, Hint) -> IO [BuiltinHint]) -> IO [BuiltinHint]
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 (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Couldn't find source hint file " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
file String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", some hints will be missing"
        [BuiltinHint] -> IO [BuiltinHint]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
     else do
        [TestCase]
tests <- String -> IO [TestCase]
parseTestFile String
file
        ([(BuiltinKey, BuiltinExample)] -> [BuiltinHint])
-> IO [(BuiltinKey, BuiltinExample)] -> IO [BuiltinHint]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(BuiltinKey, BuiltinExample)] -> [BuiltinHint]
dedupBuiltin (IO [(BuiltinKey, BuiltinExample)] -> IO [BuiltinHint])
-> ((TestCase -> IO [(BuiltinKey, BuiltinExample)])
    -> IO [(BuiltinKey, BuiltinExample)])
-> (TestCase -> IO [(BuiltinKey, BuiltinExample)])
-> IO [BuiltinHint]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TestCase]
-> (TestCase -> IO [(BuiltinKey, BuiltinExample)])
-> IO [(BuiltinKey, BuiltinExample)]
forall (m :: * -> *) a b. Monad m => [a] -> (a -> m [b]) -> m [b]
concatForM [TestCase]
tests ((TestCase -> IO [(BuiltinKey, BuiltinExample)])
 -> IO [BuiltinHint])
-> (TestCase -> IO [(BuiltinKey, BuiltinExample)])
-> IO [BuiltinHint]
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 (String -> Maybe String
forall a. a -> Maybe a
Just String
inp)
            [(BuiltinKey, BuiltinExample)] -> IO [(BuiltinKey, BuiltinExample)]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(BuiltinKey, BuiltinExample)]
 -> IO [(BuiltinKey, BuiltinExample)])
-> [(BuiltinKey, BuiltinExample)]
-> IO [(BuiltinKey, BuiltinExample)]
forall a b. (a -> b) -> a -> b
$ case Either ParseError ModuleEx
m of
                Right ModuleEx
m -> (Idea -> (BuiltinKey, BuiltinExample))
-> [Idea] -> [(BuiltinKey, BuiltinExample)]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String -> Idea -> (BuiltinKey, BuiltinExample)
ideaToValue String
category String
inp) ([Idea] -> [(BuiltinKey, BuiltinExample)])
-> [Idea] -> [(BuiltinKey, BuiltinExample)]
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
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]
ideaSeverity :: Idea -> Severity
ideaHint :: Idea -> String
ideaSpan :: Idea -> SrcSpan
ideaFrom :: Idea -> String
ideaTo :: Idea -> Maybe String
ideaNote :: Idea -> [Note]
ideaRefactoring :: Idea -> [Refactoring SrcSpan]
..} = (BuiltinKey
k, BuiltinExample
v)
            where
                -- make sure Windows/Linux don't differ on path separators
                to :: Maybe String
to = ShowS -> Maybe String -> Maybe String
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\String
x -> if String
"Combine with " String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
x then String -> String -> ShowS
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 ([Refactoring SrcSpan] -> Bool
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]
  Summary -> IO Summary
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Summary -> IO Summary) -> Summary -> IO Summary
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 (ByteString -> String) -> (a -> ByteString) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
toStrict (ByteString -> ByteString) -> (a -> ByteString) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
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 = (Summary -> String) -> IO Summary -> IO String
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Summary -> String
genSummaryMd (IO Summary -> IO String)
-> ([Setting] -> IO Summary) -> [Setting] -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Setting] -> IO Summary
getSummary

generateJsonSummary :: [Setting] -> IO String
generateJsonSummary :: [Setting] -> IO String
generateJsonSummary = (Summary -> String) -> IO Summary -> IO String
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Summary -> String
forall a. ToJSON a => a -> String
jsonToString (IO Summary -> IO String)
-> ([Setting] -> IO Summary) -> [Setting] -> IO String
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 = (Summary -> String) -> IO Summary -> IO String
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Severity -> Summary -> String
genExhaustiveConfig Severity
severity) (IO Summary -> IO String)
-> ([Setting] -> IO Summary) -> [Setting] -> IO String
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]
sBuiltinRules :: Summary -> [BuiltinHint]
sLhsRhsRules :: Summary -> [HintRule]
sBuiltinRules :: [BuiltinHint]
sLhsRhsRules :: [HintRule]
..} = [String] -> String
unlines ([String] -> String) -> [String] -> String
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"
  ]
    [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (ShowS
forall a. ToJSON a => a -> String
mkLine ShowS -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> [String]
sortDedup (BuiltinHint -> String
hName (BuiltinHint -> String) -> [BuiltinHint] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [BuiltinHint]
sBuiltinRules))
    [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"", String
"# All LHS/RHS hints"]
    [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (ShowS
forall a. ToJSON a => a -> String
mkLine ShowS -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> [String]
sortDedup (HintRule -> String
hintRuleName (HintRule -> String) -> [HintRule] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [HintRule]
sLhsRhsRules))
  where
    sortDedup :: [String] -> [String]
sortDedup = ([String] -> String) -> [[String]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NonEmpty String -> String
forall a. NonEmpty a -> a
NE.head (NonEmpty String -> String)
-> ([String] -> NonEmpty String) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> NonEmpty String
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList) ([[String]] -> [String])
-> ([String] -> [[String]]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [[String]]
forall a. Eq a => [a] -> [[a]]
group ([String] -> [[String]])
-> ([String] -> [String]) -> [String] -> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. Ord a => [a] -> [a]
sort
    mkLine :: a -> String
mkLine a
name = String
"- " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Severity -> String
forall a. Show a => a -> String
show Severity
severity String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
": {name: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. ToJSON a => a -> String
jsonToString a
name String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"}"

genSummaryMd :: Summary -> String
genSummaryMd :: Summary -> String
genSummaryMd Summary{[HintRule]
[BuiltinHint]
sBuiltinRules :: Summary -> [BuiltinHint]
sLhsRhsRules :: Summary -> [HintRule]
sBuiltinRules :: [BuiltinHint]
sLhsRhsRules :: [HintRule]
..} = [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
  [ String
"# Summary of Hints"
  , String
""
  , String
"This page is auto-generated from `hlint --generate-summary`."
  ] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
  [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (String
"## Builtin " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
group ) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
"" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [BuiltinHint] -> [String]
builtinTable [BuiltinHint]
hints | (String
group, [BuiltinHint]
hints) <- [BuiltinHint] -> [(String, [BuiltinHint])]
groupHintsByCategory [BuiltinHint]
sBuiltinRules] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
  [ String
""
  , String
"## Configured hints"
  , String
""
  ]
  [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [HintRule] -> [String]
lhsRhsTable [HintRule]
sLhsRhsRules
  where
    groupHintsByCategory :: [BuiltinHint] -> [(String, [BuiltinHint])]
groupHintsByCategory = Map String [BuiltinHint] -> [(String, [BuiltinHint])]
forall k a. Map k a -> [(k, a)]
Map.toAscList (Map String [BuiltinHint] -> [(String, [BuiltinHint])])
-> ([BuiltinHint] -> Map String [BuiltinHint])
-> [BuiltinHint]
-> [(String, [BuiltinHint])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([BuiltinHint] -> [BuiltinHint] -> [BuiltinHint])
-> [(String, [BuiltinHint])] -> Map String [BuiltinHint]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith [BuiltinHint] -> [BuiltinHint] -> [BuiltinHint]
forall a. Semigroup a => a -> a -> a
(<>) ([(String, [BuiltinHint])] -> Map String [BuiltinHint])
-> ([BuiltinHint] -> [(String, [BuiltinHint])])
-> [BuiltinHint]
-> Map String [BuiltinHint]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BuiltinHint -> (String, [BuiltinHint]))
-> [BuiltinHint] -> [(String, [BuiltinHint])]
forall a b. (a -> b) -> [a] -> [b]
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>"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
xs [String] -> [String] -> [String]
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' Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
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>"]
  [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String] -> [String]
row [String
"<th>Hint Name</th>", String
"<th>Hint</th>", String
"<th>Severity</th>"]
  [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (BuiltinHint -> [String]) -> [BuiltinHint] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap BuiltinHint -> [String]
showBuiltin [BuiltinHint]
builtins
  [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"</table>"]

showBuiltin :: BuiltinHint -> [String]
showBuiltin :: BuiltinHint -> [String]
showBuiltin BuiltinHint{Bool
String
[BuiltinExample]
Severity
hName :: BuiltinHint -> String
hSeverity :: BuiltinHint -> Severity
hRefactoring :: BuiltinHint -> Bool
hCategory :: BuiltinHint -> String
hExamples :: BuiltinHint -> [BuiltinExample]
hName :: String
hSeverity :: Severity
hRefactoring :: Bool
hCategory :: String
hExamples :: [BuiltinExample]
..} = [String]
row1
  where
    row1 :: [String]
row1 = [String] -> [String]
row ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$
      [ String
"<td>" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
hName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"</td>", String
"<td>"]
      [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ BuiltinExample -> [String]
showExample (NonEmpty BuiltinExample -> BuiltinExample
forall a. NonEmpty a -> a
NE.head ([BuiltinExample] -> NonEmpty BuiltinExample
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList [BuiltinExample]
hExamples))
      [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"Does not support refactoring." | Bool -> Bool
not Bool
hRefactoring]
      [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"</td>"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
      [ String
"<td>" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Severity -> String
forall a. Show a => a -> String
show Severity
hSeverity String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"</td>"
      ]
    showExample :: BuiltinExample -> [String]
showExample BuiltinExample{String
Maybe String
eContext :: BuiltinExample -> String
eFrom :: BuiltinExample -> String
eTo :: BuiltinExample -> Maybe String
eContext :: String
eFrom :: String
eTo :: Maybe String
..} =
      [String
"Example: "]
        [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ String -> [String]
haskell String
eContext
        [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"Found:"]
        [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ String -> [String]
haskell String
eFrom
        [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"Suggestion:"]
        [String] -> [String] -> [String]
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>"]
  [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String] -> [String]
row [String
"<th>Hint Name</th>", String
"<th>Hint</th>", String
"<th>Severity</th>"]
  [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (HintRule -> [String]) -> [HintRule] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap HintRule -> [String]
showLhsRhs [HintRule]
hints
  [String] -> [String] -> [String]
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
hintRuleName :: HintRule -> String
hintRuleSeverity :: Severity
hintRuleName :: String
hintRuleNotes :: [Note]
hintRuleScope :: Scope
hintRuleLHS :: HsExtendInstances (LHsExpr GhcPs)
hintRuleRHS :: HsExtendInstances (LHsExpr GhcPs)
hintRuleSide :: Maybe (HsExtendInstances (LHsExpr GhcPs))
hintRuleSeverity :: HintRule -> Severity
hintRuleNotes :: HintRule -> [Note]
hintRuleScope :: HintRule -> Scope
hintRuleLHS :: HintRule -> HsExtendInstances (LHsExpr GhcPs)
hintRuleRHS :: HintRule -> HsExtendInstances (LHsExpr GhcPs)
hintRuleSide :: HintRule -> Maybe (HsExtendInstances (LHsExpr GhcPs))
..} = [String] -> [String]
row ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$
  [ String
"<td>" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
hintRuleName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"</td>"
  , String
"<td>"
  , String
"LHS:"
  ]
  [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ String -> [String]
haskell (HsExtendInstances (GenLocated SrcSpanAnnA (HsExpr GhcPs)) -> String
forall a. Show a => a -> String
show HsExtendInstances (LHsExpr GhcPs)
HsExtendInstances (GenLocated SrcSpanAnnA (HsExpr GhcPs))
hintRuleLHS)
  [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"RHS:"]
  [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ String -> [String]
haskell (HsExtendInstances (GenLocated SrcSpanAnnA (HsExpr GhcPs)) -> String
forall a. Show a => a -> String
show HsExtendInstances (LHsExpr GhcPs)
HsExtendInstances (GenLocated SrcSpanAnnA (HsExpr GhcPs))
hintRuleRHS)
  [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
  [ String
"</td>"
  , String
"<td>" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Severity -> String
forall a. Show a => a -> String
show Severity
hintRuleSeverity String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"</td>"
  ]