{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
-- |
--
-- Utility for formatting @'Idea'@ data in accordance with the Code Climate
-- spec: <https://github.com/codeclimate/spec>
--
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
        ]

-- | Print an @'Issue'@ with trailing null-terminator and newline
--
-- The trailing newline will be ignored, but makes the output more readable
--
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

-- | Convert an hlint @'Idea'@ to a datatype more easily serialized for CC
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

-- "The baseline remediation points value is 50,000, which is the time it takes
-- to fix a trivial code style issue like a missing semicolon on a single line,
-- including the time for the developer to open the code, make the change, and
-- confidently commit the fix. All other remediation points values are expressed
-- in multiples of that Basic Remediation Point Value."
basePoints :: Int
basePoints :: Int
basePoints = 50000