{-# LANGUAGE OverloadedStrings #-}
module ShellCheck.Formatter.JSON (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 = forall {p}. IORef [PositionedComment] -> CheckResult -> p -> IO ()
collectResult IORef [PositionedComment]
ref,
onFailure :: FilePath -> FilePath -> IO ()
onFailure = FilePath -> FilePath -> IO ()
outputError,
footer :: IO ()
footer = forall {a}. ToJSON a => IORef a -> IO ()
finish IORef [PositionedComment]
ref
}
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 -> p -> IO ()
collectResult IORef [PositionedComment]
ref CheckResult
cr p
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 = 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 a -> IO ()
finish IORef a
ref = do
a
list <- forall a. IORef a -> IO a
readIORef IORef a
ref
ByteString -> IO ()
BL.putStrLn forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> ByteString
encode a
list