{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE RecordWildCards, NoMonomorphismRestriction #-}

module Idea(
    Idea(..),
    rawIdea, idea, suggest, suggestRemove, ideaRemove, warn, ignore,
    rawIdeaN, suggestN, ignoreNoSuggestion,
    showIdeasJson, showIdeaANSI,
    Note(..), showNotes,
    Severity(..),
    ) where

import Data.List.Extra
import Config.Type
import HsColour
import Refact.Types hiding (SrcSpan)
import Refact.Types qualified as R
import Prelude
import GHC.Types.SrcLoc
import GHC.Utils.Outputable
import GHC.Util

import Language.Haskell.GhclibParserEx.GHC.Utils.Outputable

-- | An idea suggest by a 'Hint'.
data Idea = Idea
    {Idea -> [String]
ideaModule :: [String] -- ^ The modules the idea is for, usually a singleton.
    ,Idea -> [String]
ideaDecl :: [String] -- ^ The declarations the idea is for, usually a singleton, typically the function name, but may be a type name.
    ,Idea -> Severity
ideaSeverity :: Severity -- ^ The severity of the idea, e.g. 'Warning'.
    ,Idea -> String
ideaHint :: String -- ^ The name of the hint that generated the idea, e.g. @\"Use reverse\"@.
    ,Idea -> SrcSpan
ideaSpan :: SrcSpan -- ^ The source code the idea relates to.
    ,Idea -> String
ideaFrom :: String -- ^ The contents of the source code the idea relates to.
    ,Idea -> Maybe String
ideaTo :: Maybe String -- ^ The suggested replacement, or 'Nothing' for no replacement (e.g. on parse errors).
    ,Idea -> [Note]
ideaNote :: [Note] -- ^ Notes about the effect of applying the replacement.
    ,Idea -> [Refactoring SrcSpan]
ideaRefactoring :: [Refactoring R.SrcSpan] -- ^ How to perform this idea
    }
    deriving Idea -> Idea -> Bool
(Idea -> Idea -> Bool) -> (Idea -> Idea -> Bool) -> Eq Idea
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Idea -> Idea -> Bool
== :: Idea -> Idea -> Bool
$c/= :: Idea -> Idea -> Bool
/= :: Idea -> Idea -> Bool
Eq

-- I don't use aeson here for 2 reasons:
-- 1) Aeson doesn't escape unicode characters, and I want to (allows me to ignore encoding)
-- 2) I want to control the format so it's slightly human readable as well
showIdeaJson :: Idea -> String
showIdeaJson :: Idea -> String
showIdeaJson idea :: Idea
idea@Idea{ideaSpan :: Idea -> SrcSpan
ideaSpan=srcSpan :: SrcSpan
srcSpan@SrcSpan{Int
String
srcSpanFilename :: String
srcSpanStartLine' :: Int
srcSpanStartColumn :: Int
srcSpanEndLine' :: Int
srcSpanEndColumn :: Int
srcSpanFilename :: SrcSpan -> String
srcSpanStartLine' :: SrcSpan -> Int
srcSpanStartColumn :: SrcSpan -> Int
srcSpanEndLine' :: SrcSpan -> Int
srcSpanEndColumn :: SrcSpan -> Int
..}, String
[String]
[Refactoring SrcSpan]
[Note]
Maybe String
Severity
ideaModule :: Idea -> [String]
ideaDecl :: Idea -> [String]
ideaSeverity :: Idea -> Severity
ideaHint :: Idea -> String
ideaFrom :: Idea -> String
ideaTo :: Idea -> Maybe String
ideaNote :: Idea -> [Note]
ideaRefactoring :: Idea -> [Refactoring SrcSpan]
ideaModule :: [String]
ideaDecl :: [String]
ideaSeverity :: Severity
ideaHint :: String
ideaFrom :: String
ideaTo :: Maybe String
ideaNote :: [Note]
ideaRefactoring :: [Refactoring SrcSpan]
..} = [(String, String)] -> String
forall {a}. Show a => [(a, String)] -> String
dict
    [(String
"module", [String] -> String
list ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
str [String]
ideaModule)
    ,(String
"decl", [String] -> String
list ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
str [String]
ideaDecl)
    ,(String
"severity", String -> String
str (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Severity -> String
forall a. Show a => a -> String
show Severity
ideaSeverity)
    ,(String
"hint", String -> String
str String
ideaHint)
    ,(String
"file", String -> String
str String
srcSpanFilename)
    ,(String
"startLine", Int -> String
forall a. Show a => a -> String
show Int
srcSpanStartLine')
    ,(String
"startColumn", Int -> String
forall a. Show a => a -> String
show Int
srcSpanStartColumn)
    ,(String
"endLine", Int -> String
forall a. Show a => a -> String
show Int
srcSpanEndLine')
    ,(String
"endColumn", Int -> String
forall a. Show a => a -> String
show Int
srcSpanEndColumn)
    ,(String
"from", String -> String
str String
ideaFrom)
    ,(String
"to", String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"null" String -> String
str Maybe String
ideaTo)
    ,(String
"note", [String] -> String
list ((Note -> String) -> [Note] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String
str (String -> String) -> (Note -> String) -> Note -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Note -> String
forall a. Show a => a -> String
show) [Note]
ideaNote))
    ,(String
"refactorings", String -> String
str (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ [Refactoring SrcSpan] -> String
forall a. Show a => a -> String
show [Refactoring SrcSpan]
ideaRefactoring)
    ]
  where
    str :: String -> String
str String
x = String
"\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
escapeJSON String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\""
    dict :: [(a, String)] -> String
dict [(a, String)]
xs = String
"{" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," [a -> String
forall a. Show a => a -> String
show a
k String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
v | (a
k,String
v) <- [(a, String)]
xs] String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"}"
    list :: [String] -> String
list [String]
xs = String
"[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," [String]
xs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"

-- | Show a list of 'Idea' values as a JSON string.
showIdeasJson :: [Idea] -> String
showIdeasJson :: [Idea] -> String
showIdeasJson [Idea]
ideas = String
"[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n," ((Idea -> String) -> [Idea] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Idea -> String
showIdeaJson [Idea]
ideas) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"

instance Show Idea where
    show :: Idea -> String
show = (String -> String) -> Idea -> String
showEx String -> String
forall a. a -> a
id


-- | Show an 'Idea' with ANSI color codes to give syntax coloring to the Haskell code.
showIdeaANSI :: Idea -> String
showIdeaANSI :: Idea -> String
showIdeaANSI = (String -> String) -> Idea -> String
showEx String -> String
hsColourConsole

showEx :: (String -> String) -> Idea -> String
showEx :: (String -> String) -> Idea -> String
showEx String -> String
tt Idea{String
[String]
[Refactoring SrcSpan]
[Note]
Maybe String
SrcSpan
Severity
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]
ideaModule :: [String]
ideaDecl :: [String]
ideaSeverity :: Severity
ideaHint :: String
ideaSpan :: SrcSpan
ideaFrom :: String
ideaTo :: Maybe String
ideaNote :: [Note]
ideaRefactoring :: [Refactoring SrcSpan]
..} = [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
    [SrcSpan -> String
showSrcSpan SrcSpan
ideaSpan String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (if String
ideaHint String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"" then String
"" else 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 -> Maybe String -> [String]
f String
"Found" (String -> Maybe String
forall a. a -> Maybe a
Just String
ideaFrom) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ String -> Maybe String -> [String]
f String
"Perhaps" Maybe String
ideaTo [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
    [String
"Note: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n | let n :: String
n = [Note] -> String
showNotes [Note]
ideaNote, String
n String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
""]
    where
        f :: String -> Maybe String -> [String]
f String
msg Maybe String
Nothing = []
        f String
msg (Just String
x) | [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
xs = [String
msg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" you should remove it."]
                       | Bool
otherwise = (String
msg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":") String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"  "String -> String -> String
forall a. [a] -> [a] -> [a]
++) [String]
xs
            where xs :: [String]
xs = String -> [String]
lines (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ String -> String
tt String
x


rawIdea :: Severity -> String -> SrcSpan -> String -> Maybe String -> [Note]-> [Refactoring R.SrcSpan] -> Idea
rawIdea :: Severity
-> String
-> SrcSpan
-> String
-> Maybe String
-> [Note]
-> [Refactoring SrcSpan]
-> Idea
rawIdea = [String]
-> [String]
-> Severity
-> String
-> SrcSpan
-> String
-> Maybe String
-> [Note]
-> [Refactoring SrcSpan]
-> Idea
Idea [] []

rawIdeaN :: Severity -> String -> SrcSpan -> String -> Maybe String -> [Note] -> Idea
rawIdeaN :: Severity
-> String -> SrcSpan -> String -> Maybe String -> [Note] -> Idea
rawIdeaN Severity
a String
b SrcSpan
c String
d Maybe String
e [Note]
f = [String]
-> [String]
-> Severity
-> String
-> SrcSpan
-> String
-> Maybe String
-> [Note]
-> [Refactoring SrcSpan]
-> Idea
Idea [] [] Severity
a String
b SrcSpan
c String
d Maybe String
e [Note]
f []

idea :: (GHC.Utils.Outputable.Outputable a, GHC.Utils.Outputable.Outputable b) =>
         Severity -> String -> Located a -> Located b -> [Refactoring R.SrcSpan] -> Idea
idea :: forall a b.
(Outputable a, Outputable b) =>
Severity
-> String
-> Located a
-> Located b
-> [Refactoring SrcSpan]
-> Idea
idea Severity
severity String
hint Located a
from Located b
to =
  Severity
-> String
-> SrcSpan
-> String
-> Maybe String
-> [Note]
-> [Refactoring SrcSpan]
-> Idea
rawIdea Severity
severity String
hint (Located a -> SrcSpan
forall l e. GenLocated l e -> l
getLoc Located a
from) (Located a -> String
forall a. Outputable a => a -> String
unsafePrettyPrint Located a
from) (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Located b -> String
forall a. Outputable a => a -> String
unsafePrettyPrint Located b
to) []

-- Construct an Idea that suggests "Perhaps you should remove it."
ideaRemove :: Severity -> String -> SrcSpan -> String -> [Refactoring R.SrcSpan] -> Idea
ideaRemove :: Severity
-> String -> SrcSpan -> String -> [Refactoring SrcSpan] -> Idea
ideaRemove Severity
severity String
hint SrcSpan
span String
from = Severity
-> String
-> SrcSpan
-> String
-> Maybe String
-> [Note]
-> [Refactoring SrcSpan]
-> Idea
rawIdea Severity
severity String
hint SrcSpan
span String
from (String -> Maybe String
forall a. a -> Maybe a
Just String
"") []

suggest :: (GHC.Utils.Outputable.Outputable a, GHC.Utils.Outputable.Outputable b) =>
            String -> Located a -> Located b -> [Refactoring R.SrcSpan] -> Idea
suggest :: forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
suggest = Severity
-> String
-> Located a
-> Located b
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
Severity
-> String
-> Located a
-> Located b
-> [Refactoring SrcSpan]
-> Idea
idea Severity
Suggestion

suggestRemove :: String -> SrcSpan -> String -> [Refactoring R.SrcSpan] -> Idea
suggestRemove :: String -> SrcSpan -> String -> [Refactoring SrcSpan] -> Idea
suggestRemove = Severity
-> String -> SrcSpan -> String -> [Refactoring SrcSpan] -> Idea
ideaRemove Severity
Suggestion

warn :: (GHC.Utils.Outputable.Outputable a, GHC.Utils.Outputable.Outputable b) =>
         String -> Located a -> Located b -> [Refactoring R.SrcSpan] -> Idea
warn :: forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
warn = Severity
-> String
-> Located a
-> Located b
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
Severity
-> String
-> Located a
-> Located b
-> [Refactoring SrcSpan]
-> Idea
idea Severity
Warning

ignoreNoSuggestion :: (GHC.Utils.Outputable.Outputable a)
                    => String -> Located a -> Idea
ignoreNoSuggestion :: forall a. Outputable a => String -> Located a -> Idea
ignoreNoSuggestion String
hint Located a
x = Severity
-> String -> SrcSpan -> String -> Maybe String -> [Note] -> Idea
rawIdeaN Severity
Ignore String
hint (Located a -> SrcSpan
forall l e. GenLocated l e -> l
getLoc Located a
x) (Located a -> String
forall a. Outputable a => a -> String
unsafePrettyPrint Located a
x) Maybe String
forall a. Maybe a
Nothing []

ignore :: (GHC.Utils.Outputable.Outputable a) =>
           String -> Located a -> Located a -> [Refactoring R.SrcSpan] -> Idea
ignore :: forall a.
Outputable a =>
String -> Located a -> Located a -> [Refactoring SrcSpan] -> Idea
ignore = Severity
-> String
-> Located a
-> Located a
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
Severity
-> String
-> Located a
-> Located b
-> [Refactoring SrcSpan]
-> Idea
idea Severity
Ignore

ideaN :: (GHC.Utils.Outputable.Outputable a) =>
          Severity -> String -> Located a -> Located a -> Idea
ideaN :: forall a.
Outputable a =>
Severity -> String -> Located a -> Located a -> Idea
ideaN Severity
severity String
hint Located a
from Located a
to = Severity
-> String
-> Located a
-> Located a
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
Severity
-> String
-> Located a
-> Located b
-> [Refactoring SrcSpan]
-> Idea
idea Severity
severity String
hint Located a
from Located a
to []

suggestN :: (GHC.Utils.Outputable.Outputable a) =>
             String -> Located a -> Located a -> Idea
suggestN :: forall a. Outputable a => String -> Located a -> Located a -> Idea
suggestN = Severity -> String -> Located a -> Located a -> Idea
forall a.
Outputable a =>
Severity -> String -> Located a -> Located a -> Idea
ideaN Severity
Suggestion