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