shellcheck/shellcheck.hs

{-
    Copyright 2012-2015 Vidar Holen

    This file is part of ShellCheck.
    http://www.vidarholen.net/contents/shellcheck

    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 <http://www.gnu.org/licenses/>.
-}
import ShellCheck.Data
import ShellCheck.Checker
import ShellCheck.Interface

import ShellCheck.Formatter.Format
import qualified ShellCheck.Formatter.CheckStyle
import qualified ShellCheck.Formatter.GCC
import qualified ShellCheck.Formatter.JSON
import qualified ShellCheck.Formatter.TTY

import Control.Exception
import Control.Monad
import Control.Monad.Except
import Data.Char
import Data.Functor
import Data.Either
import qualified Data.Map as Map
import Data.Maybe
import Data.Monoid
import Prelude hiding (catch)
import System.Console.GetOpt
import System.Environment
import System.Exit
import System.IO

data Flag = Flag String String
data Status =
    NoProblems
    | SomeProblems
    | BadInput
    | SupportFailure
    | SyntaxFailure
    | RuntimeException
  deriving (Ord, Eq, Show)

instance Monoid Status where
    mempty = NoProblems
    mappend = max

usageHeader = "Usage: shellcheck [OPTIONS...] FILES..."
options = [
    Option "e" ["exclude"]
        (ReqArg (Flag "exclude") "CODE1,CODE2..") "exclude types of warnings",
    Option "f" ["format"]
        (ReqArg (Flag "format") "FORMAT") "output format",
    Option "s" ["shell"]
        (ReqArg (Flag "shell") "SHELLNAME") "Specify dialect (bash,sh,ksh)",
    Option "V" ["version"]
        (NoArg $ Flag "version" "true") "Print version information"
    ]

printErr = lift . hPutStrLn stderr

parseArguments :: [String] -> ExceptT Status IO ([Flag], [FilePath])
parseArguments argv =
    case getOpt Permute options argv of
        (opts, files, []) -> return (opts, files)
        (_, _, errors) -> do
            printErr $ concat errors ++ "\n" ++ usageInfo usageHeader options
            throwError SyntaxFailure

formats :: Map.Map String (IO Formatter)
formats = Map.fromList [
    ("checkstyle", ShellCheck.Formatter.CheckStyle.format),
    ("gcc", ShellCheck.Formatter.GCC.format),
    ("json", ShellCheck.Formatter.JSON.format),
    ("tty", ShellCheck.Formatter.TTY.format)
    ]

getOption [] _ = Nothing
getOption (Flag var val:_) name | name == var = return val
getOption (_:rest) flag = getOption rest flag

getOptions options name =
    map (\(Flag _ val) -> val) . filter (\(Flag var _) -> var == name) $ options

split char str =
    split' str []
  where
    split' (a:rest) element =
        if a == char
        then reverse element : split' rest []
        else split' rest (a:element)
    split' [] element = [reverse element]

getExclusions options =
    let elements = concatMap (split ',') $ getOptions options "exclude"
        clean = dropWhile (not . isDigit)
    in
        map (Prelude.read . clean) elements :: [Int]

toStatus = liftM (either id id) . runExceptT

main = do
    args <- getArgs
    status <- toStatus $ do
        (flags, files) <- parseArguments args
        process flags files
    exitWith $ statusToCode status

statusToCode status =
    case status of
        NoProblems -> ExitSuccess
        SomeProblems -> ExitFailure 1
        BadInput -> ExitFailure 5
        SyntaxFailure -> ExitFailure 3
        SupportFailure -> ExitFailure 4
        RuntimeException -> ExitFailure 2

process :: [Flag] -> [FilePath] -> ExceptT Status IO Status
process flags files = do
    options <- foldM (flip parseOption) emptyCheckSpec flags
    verifyFiles files
    let format = fromMaybe "tty" $ getOption flags "format"
    formatter <-
        case Map.lookup format formats of
            Nothing -> do
                printErr $ "Unknown format " ++ format
                printErr "Supported formats:"
                mapM_ (printErr . write) $ Map.keys formats
                throwError SupportFailure
              where write s = "  " ++ s
            Just f -> ExceptT $ fmap Right f
    let sys = ioInterface (const False)
    lift $ runFormatter sys formatter options files

runFormatter :: SystemInterface IO -> Formatter -> CheckSpec -> [FilePath]
            -> IO Status
runFormatter sys format spec files = do
    header format
    result <- foldM f NoProblems files
    footer format
    return result
  where
    f :: Status -> FilePath -> IO Status
    f status file = do
        newStatus <- process file `catch` handler file
        return $ status `mappend` newStatus
    handler :: FilePath -> IOException -> IO Status
    handler file e = do
        onFailure format file (show e)
        return RuntimeException

    process :: FilePath -> IO Status
    process filename = do
        contents <- inputFile filename
        let checkspec = spec {
            csFilename = filename,
            csScript = contents
        }
        result <- checkScript sys checkspec
        onResult format result contents
        return $
            if null (crComments result)
            then NoProblems
            else SomeProblems

parseOption flag options =
    case flag of
        Flag "shell" str ->
            fromMaybe (die $ "Unknown shell: " ++ str) $ do
                shell <- shellForExecutable str
                return $ return options { csShellTypeOverride = Just shell }

        Flag "exclude" str -> do
            new <- mapM parseNum $ split ',' str
            let old = csExcludedWarnings options
            return options { csExcludedWarnings = new ++ old }

        Flag "version" _ -> do
            liftIO printVersion
            throwError NoProblems

        _ -> return options
  where
    die s = do
        printErr s
        throwError SupportFailure
    parseNum ('S':'C':str) = parseNum str
    parseNum num = do
        unless (all isDigit num) $ do
            printErr $ "Bad exclusion: " ++ num
            throwError SyntaxFailure
        return (Prelude.read num :: Integer)

ioInterface filter =
    SystemInterface {
        siReadFile = get
    }
  where
    get file =
        if filter file
          then (Right <$> inputFile file) `catch` handler
          else return $ Left (file ++ " was not specified as input.")

    handler :: IOException -> IO (Either ErrorMessage String)
    handler ex = return . Left $ show ex

inputFile file = do
    contents <-
            if file == "-"
            then getContents
            else readFile file

    seq (length contents) $
        return contents

verifyFiles files =
    when (null files) $ do
        printErr "No files specified.\n"
        printErr $ usageInfo usageHeader options
        throwError SyntaxFailure

printVersion = do
    putStrLn   "ShellCheck - shell script analysis tool"
    putStrLn $ "version: " ++ shellcheckVersion
    putStrLn   "license: GNU General Public License, version 3"
    putStrLn   "website: http://www.shellcheck.net"