{-
    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.Format where

import ShellCheck.Data
import ShellCheck.Interface
import ShellCheck.Fixer

import Control.Monad
import Data.Array
import Data.List
import System.IO
import System.Info
import System.Environment

-- A formatter that carries along an arbitrary piece of data
data Formatter = Formatter {
    Formatter -> IO ()
header ::  IO (),
    Formatter -> CheckResult -> SystemInterface IO -> IO ()
onResult :: CheckResult -> SystemInterface IO -> IO (),
    Formatter -> FilePath -> FilePath -> IO ()
onFailure :: FilePath -> ErrorMessage -> IO (),
    Formatter -> IO ()
footer :: IO ()
}

sourceFile :: PositionedComment -> FilePath
sourceFile = Position -> FilePath
posFile (Position -> FilePath)
-> (PositionedComment -> Position) -> PositionedComment -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PositionedComment -> Position
pcStartPos
lineNo :: PositionedComment -> Integer
lineNo = Position -> Integer
posLine (Position -> Integer)
-> (PositionedComment -> Position) -> PositionedComment -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PositionedComment -> Position
pcStartPos
endLineNo :: PositionedComment -> Integer
endLineNo = Position -> Integer
posLine (Position -> Integer)
-> (PositionedComment -> Position) -> PositionedComment -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PositionedComment -> Position
pcEndPos
colNo :: PositionedComment -> Integer
colNo  = Position -> Integer
posColumn (Position -> Integer)
-> (PositionedComment -> Position) -> PositionedComment -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PositionedComment -> Position
pcStartPos
endColNo :: PositionedComment -> Integer
endColNo = Position -> Integer
posColumn (Position -> Integer)
-> (PositionedComment -> Position) -> PositionedComment -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PositionedComment -> Position
pcEndPos
codeNo :: PositionedComment -> Integer
codeNo = Comment -> Integer
cCode (Comment -> Integer)
-> (PositionedComment -> Comment) -> PositionedComment -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PositionedComment -> Comment
pcComment
messageText :: PositionedComment -> FilePath
messageText = Comment -> FilePath
cMessage (Comment -> FilePath)
-> (PositionedComment -> Comment) -> PositionedComment -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PositionedComment -> Comment
pcComment

severityText :: PositionedComment -> String
severityText :: PositionedComment -> FilePath
severityText PositionedComment
pc =
    case Comment -> Severity
cSeverity (PositionedComment -> Comment
pcComment PositionedComment
pc) of
        Severity
ErrorC   -> FilePath
"error"
        Severity
WarningC -> FilePath
"warning"
        Severity
InfoC    -> FilePath
"info"
        Severity
StyleC   -> FilePath
"style"

-- Realign comments from a tabstop of 8 to 1
makeNonVirtual :: [PositionedComment] -> FilePath -> [PositionedComment]
makeNonVirtual [PositionedComment]
comments FilePath
contents =
    (PositionedComment -> PositionedComment)
-> [PositionedComment] -> [PositionedComment]
forall a b. (a -> b) -> [a] -> [b]
map PositionedComment -> PositionedComment
fix [PositionedComment]
comments
  where
    list :: [FilePath]
list = FilePath -> [FilePath]
lines FilePath
contents
    arr :: Array Int FilePath
arr = (Int, Int) -> [FilePath] -> Array Int FilePath
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
1, [FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
list) [FilePath]
list
    untabbedFix :: Fix -> Fix
untabbedFix Fix
f = Fix
newFix {
      fixReplacements :: [Replacement]
fixReplacements = (Replacement -> Replacement) -> [Replacement] -> [Replacement]
forall a b. (a -> b) -> [a] -> [b]
map (\Replacement
r -> Replacement -> Array Int FilePath -> Replacement
forall a. Ranged a => a -> Array Int FilePath -> a
removeTabStops Replacement
r Array Int FilePath
arr) (Fix -> [Replacement]
fixReplacements Fix
f)
    }
    fix :: PositionedComment -> PositionedComment
fix PositionedComment
c = (PositionedComment -> Array Int FilePath -> PositionedComment
forall a. Ranged a => a -> Array Int FilePath -> a
removeTabStops PositionedComment
c Array Int FilePath
arr) {
      pcFix :: Maybe Fix
pcFix = (Fix -> Fix) -> Maybe Fix -> Maybe Fix
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Fix -> Fix
untabbedFix (PositionedComment -> Maybe Fix
pcFix PositionedComment
c)
    }


shouldOutputColor :: ColorOption -> IO Bool
shouldOutputColor :: ColorOption -> IO Bool
shouldOutputColor ColorOption
colorOption =
    case ColorOption
colorOption of
        ColorOption
ColorAlways -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
        ColorOption
ColorNever -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
        ColorOption
ColorAuto -> do
            Bool
isTerminal <- Handle -> IO Bool
hIsTerminalDevice Handle
stdout
            Maybe FilePath
term <- FilePath -> IO (Maybe FilePath)
lookupEnv FilePath
"TERM"
            let windows :: Bool
windows = FilePath
"mingw" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` FilePath
os
            let dumbTerm :: Bool
dumbTerm = Maybe FilePath
term Maybe FilePath -> [Maybe FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
"dumb", FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
"", Maybe FilePath
forall a. Maybe a
Nothing]
            let isUsableTty :: Bool
isUsableTty = Bool
isTerminal Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
windows Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
dumbTerm
            Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
isUsableTty