{-# LANGUAGE RecordWildCards, NoMonomorphismRestriction #-}
module Idea(
Idea(..),
rawIdea, idea, suggest, warn, ignore,
rawIdeaN, suggestN,
showIdeasJson, showANSI,
Note(..), showNotes,
Severity(..)
) where
import Data.Functor
import Data.List.Extra
import HSE.All
import Config.Type
import HsColour
import Refact.Types hiding (SrcSpan)
import qualified Refact.Types as R
import Prelude
data Idea = Idea
{ideaModule :: [String]
,ideaDecl :: [String]
,ideaSeverity :: Severity
,ideaHint :: String
,ideaSpan :: SrcSpan
,ideaFrom :: String
,ideaTo :: Maybe String
,ideaNote :: [Note]
,ideaRefactoring :: [Refactoring R.SrcSpan]
}
deriving (Eq,Ord)
showIdeaJson :: Idea -> String
showIdeaJson idea@Idea{ideaSpan=srcSpan@SrcSpan{..}, ..} = dict
[("module", list $ map str ideaModule)
,("decl", list $ map str ideaDecl)
,("severity", str $ show ideaSeverity)
,("hint", str ideaHint)
,("file", str srcSpanFilename)
,("startLine", show srcSpanStartLine)
,("startColumn", show srcSpanStartColumn)
,("endLine", show srcSpanEndLine)
,("endColumn", show srcSpanEndColumn)
,("from", str ideaFrom)
,("to", maybe "null" str ideaTo)
,("note", list (map (str . show) ideaNote))
,("refactorings", str $ show ideaRefactoring)
]
where
str x = "\"" ++ escapeJSON x ++ "\""
dict xs = "{" ++ intercalate "," [show k ++ ":" ++ v | (k,v) <- xs] ++ "}"
list xs = "[" ++ intercalate "," xs ++ "]"
showIdeasJson :: [Idea] -> String
showIdeasJson ideas = "[" ++ intercalate "\n," (map showIdeaJson ideas) ++ "]"
instance Show Idea where
show = showEx id
showANSI :: IO (Idea -> String)
showANSI = showEx <$> hsColourConsole
showEx :: (String -> String) -> Idea -> String
showEx tt Idea{..} = unlines $
[showSrcLoc (getPointLoc ideaSpan) ++ ": " ++ (if ideaHint == "" then "" else show ideaSeverity ++ ": " ++ ideaHint)] ++
f "Found" (Just ideaFrom) ++ f "Why not" ideaTo ++
["Note: " ++ n | let n = showNotes ideaNote, n /= ""]
where
f msg Nothing = []
f msg (Just x) | null xs = [msg ++ " remove it."]
| otherwise = (msg ++ ":") : map (" "++) xs
where xs = lines $ tt x
rawIdea = Idea [] []
rawIdeaN a b c d e f = Idea [] [] a b c d e f []
idea severity hint from to = rawIdea severity hint (srcInfoSpan $ ann from) (f from) (Just $ f to) []
where f = trimStart . prettyPrint
suggest = idea Suggestion
warn = idea Warning
ignore = idea Ignore
ideaN severity hint from to = idea severity hint from to []
suggestN = ideaN Suggestion