{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module CC
( printIssue
, fromIdea
) where
import Data.Aeson (ToJSON(..), (.=), encode, object)
import Data.Char (toUpper)
import Data.Text (Text)
import Data.Text qualified as T
import Data.ByteString.Lazy.Char8 qualified as C8
import Idea (Idea(..), Severity(..))
import GHC.Types.SrcLoc qualified as GHC
import GHC.Util qualified as GHC
data Issue = Issue
{ Issue -> Text
issueType :: Text
, Issue -> Text
issueCheckName :: Text
, Issue -> Text
issueDescription :: Text
, Issue -> Text
issueContent :: Text
, Issue -> [Text]
issueCategories :: [Text]
, Issue -> Location
issueLocation :: Location
, Issue -> Int
issueRemediationPoints :: Int
}
data Location = Location FilePath Position Position
data Position = Position Int Int
instance ToJSON Issue where
toJSON :: Issue -> Value
toJSON Issue{Int
[Text]
Text
Location
issueRemediationPoints :: Int
issueLocation :: Location
issueCategories :: [Text]
issueContent :: Text
issueDescription :: Text
issueCheckName :: Text
issueType :: Text
issueRemediationPoints :: Issue -> Int
issueLocation :: Issue -> Location
issueCategories :: Issue -> [Text]
issueContent :: Issue -> Text
issueDescription :: Issue -> Text
issueCheckName :: Issue -> Text
issueType :: Issue -> Text
..} = [Pair] -> Value
object
[ Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
issueType
, Key
"check_name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
issueCheckName
, Key
"description" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
issueDescription
, Key
"content" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object
[ Key
"body" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
issueContent
]
, Key
"categories" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Text]
issueCategories
, Key
"location" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Location
issueLocation
, Key
"remediation_points" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
issueRemediationPoints
]
instance ToJSON Location where
toJSON :: Location -> Value
toJSON (Location FilePath
path Position
begin Position
end) = [Pair] -> Value
object
[ Key
"path" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= FilePath
path
, Key
"positions" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object
[ Key
"begin" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Position
begin
, Key
"end" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Position
end
]
]
instance ToJSON Position where
toJSON :: Position -> Value
toJSON (Position Int
line Int
column) = [Pair] -> Value
object
[ Key
"line" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
line
, Key
"column" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
column
]
printIssue :: Issue -> IO ()
printIssue :: Issue -> IO ()
printIssue = ByteString -> IO ()
C8.putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Semigroup a => a -> a -> a
<> ByteString
"\0") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> ByteString
encode
fromIdea :: Idea -> Issue
fromIdea :: Idea -> Issue
fromIdea Idea{FilePath
[FilePath]
[Refactoring SrcSpan]
[Note]
Maybe FilePath
SrcSpan
Severity
ideaRefactoring :: Idea -> [Refactoring SrcSpan]
ideaNote :: Idea -> [Note]
ideaTo :: Idea -> Maybe FilePath
ideaFrom :: Idea -> FilePath
ideaSpan :: Idea -> SrcSpan
ideaHint :: Idea -> FilePath
ideaSeverity :: Idea -> Severity
ideaDecl :: Idea -> [FilePath]
ideaModule :: Idea -> [FilePath]
ideaRefactoring :: [Refactoring SrcSpan]
ideaNote :: [Note]
ideaTo :: Maybe FilePath
ideaFrom :: FilePath
ideaSpan :: SrcSpan
ideaHint :: FilePath
ideaSeverity :: Severity
ideaDecl :: [FilePath]
ideaModule :: [FilePath]
..} = Issue
{ issueType :: Text
issueType = Text
"issue"
, issueCheckName :: Text
issueCheckName = Text
"HLint/" forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (FilePath -> FilePath
camelize FilePath
ideaHint)
, issueDescription :: Text
issueDescription = FilePath -> Text
T.pack FilePath
ideaHint
, issueContent :: Text
issueContent = FilePath -> Maybe FilePath -> Text
content FilePath
ideaFrom Maybe FilePath
ideaTo forall a. Semigroup a => a -> a -> a
<> forall {a}. Show a => [a] -> Text
listNotes [Note]
ideaNote
, issueCategories :: [Text]
issueCategories = forall {a} {p}. IsString a => p -> [a]
categories FilePath
ideaHint
, issueLocation :: Location
issueLocation = SrcSpan -> Location
fromSrcSpan SrcSpan
ideaSpan
, issueRemediationPoints :: Int
issueRemediationPoints = Severity -> Int
points Severity
ideaSeverity
}
where
content :: FilePath -> Maybe FilePath -> Text
content FilePath
from Maybe FilePath
Nothing = [Text] -> Text
T.unlines
[ Text
"Found"
, Text
""
, Text
"```"
, FilePath -> Text
T.pack FilePath
from
, Text
"```"
, Text
""
, Text
"remove it."
]
content FilePath
from (Just FilePath
to) = [Text] -> Text
T.unlines
[ Text
"Found"
, Text
""
, Text
"```"
, FilePath -> Text
T.pack FilePath
from
, Text
"```"
, Text
""
, Text
"Perhaps"
, Text
""
, Text
"```"
, FilePath -> Text
T.pack FilePath
to
, Text
"```"
]
listNotes :: [a] -> Text
listNotes [] = Text
""
listNotes [a]
notes = [Text] -> Text
T.unlines forall a b. (a -> b) -> a -> b
$
[ Text
""
, Text
"Applying this change:"
, Text
""
] forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map ((Text
"* " forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> FilePath
show) [a]
notes
categories :: p -> [a]
categories p
_ = [a
"Style"]
points :: Severity -> Int
points Severity
Ignore = Int
0
points Severity
Suggestion = Int
basePoints
points Severity
Warning = Int
5 forall a. Num a => a -> a -> a
* Int
basePoints
points Severity
Error = Int
10 forall a. Num a => a -> a -> a
* Int
basePoints
fromSrcSpan :: GHC.SrcSpan -> Location
fromSrcSpan :: SrcSpan -> Location
fromSrcSpan GHC.SrcSpan{Int
FilePath
srcSpanEndColumn :: SrcSpan -> Int
srcSpanEndLine' :: SrcSpan -> Int
srcSpanStartColumn :: SrcSpan -> Int
srcSpanStartLine' :: SrcSpan -> Int
srcSpanFilename :: SrcSpan -> FilePath
srcSpanEndColumn :: Int
srcSpanEndLine' :: Int
srcSpanStartColumn :: Int
srcSpanStartLine' :: Int
srcSpanFilename :: FilePath
..} = FilePath -> Position -> Position -> Location
Location
(FilePath -> FilePath
locationFileName FilePath
srcSpanFilename)
(Int -> Int -> Position
Position Int
srcSpanStartLine' Int
srcSpanStartColumn)
(Int -> Int -> Position
Position Int
srcSpanEndLine' Int
srcSpanEndColumn)
where
locationFileName :: FilePath -> FilePath
locationFileName (Char
'.':Char
'/':FilePath
x) = FilePath
x
locationFileName FilePath
x = FilePath
x
camelize :: String -> String
camelize :: FilePath -> FilePath
camelize = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap FilePath -> FilePath
capitalize forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
words
capitalize :: String -> String
capitalize :: FilePath -> FilePath
capitalize [] = []
capitalize (Char
c:FilePath
rest) = Char -> Char
toUpper Char
c forall a. a -> [a] -> [a]
: FilePath
rest
basePoints :: Int
basePoints :: Int
basePoints = Int
50000