{-
    Copyright 2012-2019 Vidar Holen

    This file is part of ShellCheck.
    https://www.shellcheck.net

    ShellCheck is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    ShellCheck is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program.  If not, see <https://www.gnu.org/licenses/>.
-}
module ShellCheck.Formatter.GCC (format) where

import ShellCheck.Interface
import ShellCheck.Formatter.Format

import Data.List
import System.IO
import qualified Data.List.NonEmpty as NE

format :: IO Formatter
format :: IO Formatter
format = Formatter -> IO Formatter
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Formatter {
    header :: IO ()
header = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (),
    footer :: IO ()
footer = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (),
    onFailure :: FilePath -> FilePath -> IO ()
onFailure = FilePath -> FilePath -> IO ()
outputError,
    onResult :: CheckResult -> SystemInterface IO -> IO ()
onResult = CheckResult -> SystemInterface IO -> IO ()
outputAll
}

outputError :: FilePath -> FilePath -> IO ()
outputError FilePath
file FilePath
error = Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
file FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
": " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
error

outputAll :: CheckResult -> SystemInterface IO -> IO ()
outputAll CheckResult
cr SystemInterface IO
sys = (NonEmpty PositionedComment -> IO ())
-> [NonEmpty PositionedComment] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ NonEmpty PositionedComment -> IO ()
f [NonEmpty PositionedComment]
groups
  where
    comments :: [PositionedComment]
comments = CheckResult -> [PositionedComment]
crComments CheckResult
cr
    groups :: [NonEmpty PositionedComment]
groups = (PositionedComment -> FilePath)
-> [PositionedComment] -> [NonEmpty PositionedComment]
forall (f :: * -> *) b a.
(Foldable f, Eq b) =>
(a -> b) -> f a -> [NonEmpty a]
NE.groupWith PositionedComment -> FilePath
sourceFile [PositionedComment]
comments
    f :: NE.NonEmpty PositionedComment -> IO ()
    f :: NonEmpty PositionedComment -> IO ()
f NonEmpty PositionedComment
group = do
        let filename :: FilePath
filename = PositionedComment -> FilePath
sourceFile (NonEmpty PositionedComment -> PositionedComment
forall a. NonEmpty a -> a
NE.head NonEmpty PositionedComment
group)
        Either FilePath FilePath
result <- SystemInterface IO
-> Maybe Bool -> FilePath -> IO (Either FilePath FilePath)
forall (m :: * -> *).
SystemInterface m
-> Maybe Bool -> FilePath -> m (Either FilePath FilePath)
siReadFile SystemInterface IO
sys (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True) FilePath
filename
        let contents :: FilePath
contents = (FilePath -> FilePath)
-> (FilePath -> FilePath) -> Either FilePath FilePath -> FilePath
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (FilePath -> FilePath -> FilePath
forall a b. a -> b -> a
const FilePath
"") FilePath -> FilePath
forall a. a -> a
id Either FilePath FilePath
result
        FilePath -> FilePath -> [PositionedComment] -> IO ()
outputResult FilePath
filename FilePath
contents (NonEmpty PositionedComment -> [PositionedComment]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty PositionedComment
group)

outputResult :: FilePath -> FilePath -> [PositionedComment] -> IO ()
outputResult FilePath
filename FilePath
contents [PositionedComment]
warnings = do
    let comments :: [PositionedComment]
comments = [PositionedComment] -> FilePath -> [PositionedComment]
makeNonVirtual [PositionedComment]
warnings FilePath
contents
    (PositionedComment -> IO ()) -> [PositionedComment] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (FilePath -> IO ()
putStrLn (FilePath -> IO ())
-> (PositionedComment -> FilePath) -> PositionedComment -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> PositionedComment -> FilePath
formatComment FilePath
filename) [PositionedComment]
comments

formatComment :: FilePath -> PositionedComment -> FilePath
formatComment FilePath
filename PositionedComment
c = [FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
    FilePath
filename, FilePath
":",
    Integer -> FilePath
forall a. Show a => a -> FilePath
show (Integer -> FilePath) -> Integer -> FilePath
forall a b. (a -> b) -> a -> b
$ PositionedComment -> Integer
lineNo PositionedComment
c, FilePath
":",
    Integer -> FilePath
forall a. Show a => a -> FilePath
show (Integer -> FilePath) -> Integer -> FilePath
forall a b. (a -> b) -> a -> b
$ PositionedComment -> Integer
colNo PositionedComment
c, FilePath
": ",
    case PositionedComment -> FilePath
severityText PositionedComment
c of
        FilePath
"error" -> FilePath
"error"
        FilePath
"warning" -> FilePath
"warning"
        FilePath
_ -> FilePath
"note",
    FilePath
": ",
    [FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([FilePath] -> FilePath)
-> (FilePath -> [FilePath]) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
lines (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ PositionedComment -> FilePath
messageText PositionedComment
c,
    FilePath
" [SC", Integer -> FilePath
forall a. Show a => a -> FilePath
show (Integer -> FilePath) -> Integer -> FilePath
forall a b. (a -> b) -> a -> b
$ PositionedComment -> Integer
codeNo PositionedComment
c, FilePath
"]"
  ]