{-# LANGUAGE OverloadedStrings #-}
module ShellCheck.Formatter.JSON1 (format) where
import ShellCheck.Interface
import ShellCheck.Formatter.Format
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 <- [PositionedComment] -> IO (IORef [PositionedComment])
forall a. a -> IO (IORef a)
newIORef []
Formatter -> IO Formatter
forall (m :: * -> *) a. Monad m => a -> m a
return Formatter :: IO ()
-> (CheckResult -> SystemInterface IO -> IO ())
-> (FilePath -> FilePath -> IO ())
-> IO ()
-> Formatter
Formatter {
header :: IO ()
header = () -> IO ()
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 {
:: [PositionedComment]
}
instance ToJSON Json1Output where
toJSON :: Json1Output -> Value
toJSON result :: Json1Output
result = [Pair] -> Value
object [
"comments" Text -> [PositionedComment] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Json1Output -> [PositionedComment]
comments Json1Output
result
]
toEncoding :: Json1Output -> Encoding
toEncoding result :: Json1Output
result = Series -> Encoding
pairs (
"comments" Text -> [PositionedComment] -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Json1Output -> [PositionedComment]
comments Json1Output
result
)
instance ToJSON Replacement where
toJSON :: Replacement -> Value
toJSON replacement :: 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 [
"precedence" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Replacement -> Int
repPrecedence Replacement
replacement,
"insertionPoint" Text -> FilePath -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.=
case Replacement -> InsertionPoint
repInsertionPoint Replacement
replacement of
InsertBefore -> "beforeStart" :: String
InsertAfter -> "afterEnd",
"line" Text -> Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Position -> Integer
posLine Position
start,
"column" Text -> Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Position -> Integer
posColumn Position
start,
"endLine" Text -> Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Position -> Integer
posLine Position
end,
"endColumn" Text -> Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Position -> Integer
posColumn Position
end,
"replacement" Text -> FilePath -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= FilePath
str
]
instance ToJSON PositionedComment where
toJSON :: PositionedComment -> Value
toJSON comment :: 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 [
"file" Text -> FilePath -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Position -> FilePath
posFile Position
start,
"line" Text -> Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Position -> Integer
posLine Position
start,
"endLine" Text -> Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Position -> Integer
posLine Position
end,
"column" Text -> Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Position -> Integer
posColumn Position
start,
"endColumn" Text -> Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Position -> Integer
posColumn Position
end,
"level" Text -> FilePath -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= PositionedComment -> FilePath
severityText PositionedComment
comment,
"code" Text -> Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Comment -> Integer
cCode Comment
c,
"message" Text -> FilePath -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Comment -> FilePath
cMessage Comment
c,
"fix" Text -> Maybe Fix -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= PositionedComment -> Maybe Fix
pcFix PositionedComment
comment
]
toEncoding :: PositionedComment -> Encoding
toEncoding comment :: 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 (
"file" Text -> FilePath -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Position -> FilePath
posFile Position
start
Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "line" Text -> Integer -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Position -> Integer
posLine Position
start
Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "endLine" Text -> Integer -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Position -> Integer
posLine Position
end
Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "column" Text -> Integer -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Position -> Integer
posColumn Position
start
Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "endColumn" Text -> Integer -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Position -> Integer
posColumn Position
end
Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "level" Text -> FilePath -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= PositionedComment -> FilePath
severityText PositionedComment
comment
Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "code" Text -> Integer -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Comment -> Integer
cCode Comment
c
Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "message" Text -> FilePath -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Comment -> FilePath
cMessage Comment
c
Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "fix" Text -> Maybe Fix -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= PositionedComment -> Maybe Fix
pcFix PositionedComment
comment
)
instance ToJSON Fix where
toJSON :: Fix -> Value
toJSON fix :: Fix
fix = [Pair] -> Value
object [
"replacements" Text -> [Replacement] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fix -> [Replacement]
fixReplacements Fix
fix
]
outputError :: FilePath -> FilePath -> IO ()
outputError file :: FilePath
file msg :: FilePath
msg = 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
forall a. [a] -> [a] -> [a]
++ FilePath
msg
collectResult :: IORef [PositionedComment]
-> CheckResult -> SystemInterface IO -> IO ()
collectResult ref :: IORef [PositionedComment]
ref cr :: CheckResult
cr sys :: SystemInterface IO
sys = ([PositionedComment] -> IO ()) -> [[PositionedComment]] -> IO ()
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 = (PositionedComment -> FilePath)
-> [PositionedComment] -> [[PositionedComment]]
forall b a. Ord b => (a -> b) -> [a] -> [[a]]
groupWith PositionedComment -> FilePath
sourceFile [PositionedComment]
comments
f :: [PositionedComment] -> IO ()
f :: [PositionedComment] -> IO ()
f group :: [PositionedComment]
group = do
let filename :: FilePath
filename = PositionedComment -> FilePath
sourceFile ([PositionedComment] -> PositionedComment
forall a. [a] -> a
head [PositionedComment]
group)
Either FilePath FilePath
result <- SystemInterface IO -> FilePath -> IO (Either FilePath FilePath)
forall (m :: * -> *).
SystemInterface m -> FilePath -> m (Either FilePath FilePath)
siReadFile SystemInterface IO
sys 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
forall a. a -> a
id Either FilePath FilePath
result
let comments' :: [PositionedComment]
comments' = [PositionedComment] -> FilePath -> [PositionedComment]
makeNonVirtual [PositionedComment]
comments FilePath
contents
IORef [PositionedComment]
-> ([PositionedComment] -> [PositionedComment]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef [PositionedComment]
ref (\x :: [PositionedComment]
x -> [PositionedComment]
comments' [PositionedComment] -> [PositionedComment] -> [PositionedComment]
forall a. [a] -> [a] -> [a]
++ [PositionedComment]
x)
finish :: IORef [PositionedComment] -> IO ()
finish ref :: IORef [PositionedComment]
ref = do
[PositionedComment]
list <- IORef [PositionedComment] -> IO [PositionedComment]
forall a. IORef a -> IO a
readIORef IORef [PositionedComment]
ref
ByteString -> IO ()
BL.putStrLn (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Json1Output -> ByteString
forall a. ToJSON a => a -> ByteString
encode (Json1Output -> ByteString) -> Json1Output -> ByteString
forall a b. (a -> b) -> a -> b
$ Json1Output :: [PositionedComment] -> Json1Output
Json1Output { comments :: [PositionedComment]
comments = [PositionedComment]
list }