{-# LANGUAGE OverloadedStrings #-}
{-
    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.JSON1 (format) where

import ShellCheck.Interface
import ShellCheck.Formatter.Format

import Control.DeepSeq
import Data.Aeson
import Data.IORef
import Data.Monoid
import GHC.Exts
import System.IO
import qualified Data.ByteString.Lazy.Char8 as BL

format :: IO Formatter
format :: IO Formatter
format = do
    IORef [PositionedComment]
ref <- forall a. a -> IO (IORef a)
newIORef []
    forall (m :: * -> *) a. Monad m => a -> m a
return Formatter {
        header :: IO ()
header = forall (m :: * -> *) a. Monad m => a -> m a
return (),
        onResult :: CheckResult -> SystemInterface IO -> IO ()
onResult = IORef [PositionedComment]
-> CheckResult -> SystemInterface IO -> IO ()
collectResult IORef [PositionedComment]
ref,
        onFailure :: FilePath -> FilePath -> IO ()
onFailure = FilePath -> FilePath -> IO ()
outputError,
        footer :: IO ()
footer = IORef [PositionedComment] -> IO ()
finish IORef [PositionedComment]
ref
    }

data Json1Output = Json1Output {
    Json1Output -> [PositionedComment]
comments :: [PositionedComment]
    }

instance ToJSON Json1Output where
    toJSON :: Json1Output -> Value
toJSON Json1Output
result = [Pair] -> Value
object [
        Key
"comments" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Json1Output -> [PositionedComment]
comments Json1Output
result
        ]
    toEncoding :: Json1Output -> Encoding
toEncoding Json1Output
result = Series -> Encoding
pairs (
        Key
"comments" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Json1Output -> [PositionedComment]
comments Json1Output
result
        )

instance ToJSON Replacement where
    toJSON :: Replacement -> Value
toJSON Replacement
replacement =
        let start :: Position
start = Replacement -> Position
repStartPos Replacement
replacement
            end :: Position
end = Replacement -> Position
repEndPos Replacement
replacement
            str :: FilePath
str = Replacement -> FilePath
repString Replacement
replacement in
        [Pair] -> Value
object [
          Key
"precedence" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Replacement -> Int
repPrecedence Replacement
replacement,
          Key
"insertionPoint"  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=
            case Replacement -> InsertionPoint
repInsertionPoint Replacement
replacement of
                InsertionPoint
InsertBefore -> FilePath
"beforeStart" :: String
                InsertionPoint
InsertAfter  -> FilePath
"afterEnd",
          Key
"line" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Position -> Integer
posLine Position
start,
          Key
"column" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Position -> Integer
posColumn Position
start,
          Key
"endLine" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Position -> Integer
posLine Position
end,
          Key
"endColumn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Position -> Integer
posColumn Position
end,
          Key
"replacement" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= FilePath
str
        ]

instance ToJSON PositionedComment where
  toJSON :: PositionedComment -> Value
toJSON PositionedComment
comment =
    let start :: Position
start = PositionedComment -> Position
pcStartPos PositionedComment
comment
        end :: Position
end = PositionedComment -> Position
pcEndPos PositionedComment
comment
        c :: Comment
c = PositionedComment -> Comment
pcComment PositionedComment
comment in
    [Pair] -> Value
object [
      Key
"file" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Position -> FilePath
posFile Position
start,
      Key
"line" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Position -> Integer
posLine Position
start,
      Key
"endLine" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Position -> Integer
posLine Position
end,
      Key
"column" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Position -> Integer
posColumn Position
start,
      Key
"endColumn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Position -> Integer
posColumn Position
end,
      Key
"level" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PositionedComment -> FilePath
severityText PositionedComment
comment,
      Key
"code" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Comment -> Integer
cCode Comment
c,
      Key
"message" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Comment -> FilePath
cMessage Comment
c,
      Key
"fix" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PositionedComment -> Maybe Fix
pcFix PositionedComment
comment
    ]

  toEncoding :: PositionedComment -> Encoding
toEncoding PositionedComment
comment =
    let start :: Position
start = PositionedComment -> Position
pcStartPos PositionedComment
comment
        end :: Position
end = PositionedComment -> Position
pcEndPos PositionedComment
comment
        c :: Comment
c = PositionedComment -> Comment
pcComment PositionedComment
comment in
    Series -> Encoding
pairs (
         Key
"file" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Position -> FilePath
posFile Position
start
      forall a. Semigroup a => a -> a -> a
<> Key
"line" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Position -> Integer
posLine Position
start
      forall a. Semigroup a => a -> a -> a
<> Key
"endLine" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Position -> Integer
posLine Position
end
      forall a. Semigroup a => a -> a -> a
<> Key
"column" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Position -> Integer
posColumn Position
start
      forall a. Semigroup a => a -> a -> a
<> Key
"endColumn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Position -> Integer
posColumn Position
end
      forall a. Semigroup a => a -> a -> a
<> Key
"level" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PositionedComment -> FilePath
severityText PositionedComment
comment
      forall a. Semigroup a => a -> a -> a
<> Key
"code" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Comment -> Integer
cCode Comment
c
      forall a. Semigroup a => a -> a -> a
<> Key
"message" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Comment -> FilePath
cMessage Comment
c
      forall a. Semigroup a => a -> a -> a
<> Key
"fix" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PositionedComment -> Maybe Fix
pcFix PositionedComment
comment
    )

instance ToJSON Fix where
    toJSON :: Fix -> Value
toJSON Fix
fix = [Pair] -> Value
object [
        Key
"replacements" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Fix -> [Replacement]
fixReplacements Fix
fix
        ]

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

collectResult :: IORef [PositionedComment]
-> CheckResult -> SystemInterface IO -> IO ()
collectResult IORef [PositionedComment]
ref CheckResult
cr SystemInterface IO
sys = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [PositionedComment] -> IO ()
f [[PositionedComment]]
groups
  where
    comments :: [PositionedComment]
comments = CheckResult -> [PositionedComment]
crComments CheckResult
cr
    groups :: [[PositionedComment]]
groups = forall b a. Ord b => (a -> b) -> [a] -> [[a]]
groupWith PositionedComment -> FilePath
sourceFile [PositionedComment]
comments
    f :: [PositionedComment] -> IO ()
    f :: [PositionedComment] -> IO ()
f [PositionedComment]
group = do
        let filename :: FilePath
filename = PositionedComment -> FilePath
sourceFile (forall a. [a] -> a
head [PositionedComment]
group)
        Either FilePath FilePath
result <- forall (m :: * -> *).
SystemInterface m
-> Maybe Bool -> FilePath -> m (Either FilePath FilePath)
siReadFile SystemInterface IO
sys (forall a. a -> Maybe a
Just Bool
True) FilePath
filename
        let contents :: FilePath
contents = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const FilePath
"") forall a. a -> a
id Either FilePath FilePath
result
        let comments' :: [PositionedComment]
comments' = [PositionedComment] -> FilePath -> [PositionedComment]
makeNonVirtual [PositionedComment]
comments FilePath
contents
        forall a b. NFData a => a -> b -> b
deepseq [PositionedComment]
comments' forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef [PositionedComment]
ref (\[PositionedComment]
x -> [PositionedComment]
comments' forall a. [a] -> [a] -> [a]
++ [PositionedComment]
x)

finish :: IORef [PositionedComment] -> IO ()
finish IORef [PositionedComment]
ref = do
    [PositionedComment]
list <- forall a. IORef a -> IO a
readIORef IORef [PositionedComment]
ref
    ByteString -> IO ()
BL.putStrLn forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> ByteString
encode forall a b. (a -> b) -> a -> b
$ Json1Output { comments :: [PositionedComment]
comments = [PositionedComment]
list }