From 17515ad70652c0dc236786a52ecb734c8facf1d0 Mon Sep 17 00:00:00 2001
From: Vidar Holen <spam@vidarholen.net>
Date: Tue, 12 Nov 2013 21:22:52 -0800
Subject: [PATCH] Added proper command line parsing

---
 shellcheck.hs | 152 +++++++++++++++++++++++++++++++++-----------------
 1 file changed, 102 insertions(+), 50 deletions(-)

diff --git a/shellcheck.hs b/shellcheck.hs
index 2e24e53..1ba75fd 100644
--- a/shellcheck.hs
+++ b/shellcheck.hs
@@ -19,69 +19,121 @@ import Control.Monad
 import GHC.Exts
 import GHC.IO.Device
 import ShellCheck.Simple
+import System.Console.GetOpt
 import System.Directory
 import System.Environment
 import System.Exit
 import System.IO
+import qualified Data.Map as Map
 
-clear = ansi 0
-ansi n = "\x1B[" ++ (show n) ++ "m"
+data Flag = Flag String String
 
-colorForLevel "error" = 31 -- red
-colorForLevel "warning" = 33 -- yellow
-colorForLevel "info" = 32 -- green
-colorForLevel "style" = 32 -- green
-colorForLevel "message" = 1 -- bold
-colorForLevel "source" = 0 -- none
-colorForLevel _ = 0 -- none
+header = "Usage: shellcheck [OPTIONS...] FILES..."
+options = [
+    Option ['f'] ["format"]
+        (ReqArg (Flag "format") "FORMAT") "output format"
+    ]
 
-colorComment level comment = (ansi $ colorForLevel level) ++ comment ++ clear
+printErr = hPutStrLn stderr
 
-doFile path colorFunc = do
-    let actualPath = if path == "-" then "/dev/stdin" else path
-    exists <- doesFileExist actualPath
-    if exists then do
-        contents <- readFile actualPath
-        doInput path contents colorFunc
-      else do
-        hPutStrLn stderr (colorFunc "error" $ "No such file: " ++ actualPath)
-        return False
+parseArguments argv =
+    case getOpt Permute options argv of
+        (opts, files, []) ->
+            if not $ null files
+              then
+                return $ Just (opts, map specials files)
+              else do
+                printErr "No files specified.\n"
+                printErr $ usageInfo header options
+                return $ Nothing
 
-doInput filename contents colorFunc = do
-    let fileLines = lines contents
-    let lineCount = length fileLines
-    let comments = shellCheck contents
-    let groups = groupWith scLine comments
-    mapM_ (\x -> do
-        let lineNum = scLine (head x)
-        let line = if lineNum < 1 || lineNum > lineCount
-                        then ""
-                        else fileLines !! (lineNum - 1)
-        putStrLn ""
-        putStrLn $ colorFunc "message" ("In " ++ filename ++" line " ++ (show $ lineNum) ++ ":")
-        putStrLn (colorFunc "source" line)
-        mapM (\c -> putStrLn (colorFunc (scSeverity c) $ cuteIndent c)) x
-        putStrLn ""
-      ) groups
-    return $ null comments
+        (_, _, errors) -> do
+            printErr $ (unlines errors) ++ "\n" ++ usageInfo header options
+            return Nothing
+  where
+    specials "-" = "/dev/stdin"
+    specials x = x
 
-cuteIndent comment =
-    (replicate ((scColumn comment) - 1) ' ') ++ "^-- " ++ (code $ scCode comment) ++ ": " ++ (scMessage comment)
+formats = Map.fromList [
+    ("tty", forTty)
+    ]
 
-code code = "SC" ++ (show code)
+forTty options files = do
+    output <- mapM doFile files
+    return $ and output
+  where
+    clear = ansi 0
+    ansi n = "\x1B[" ++ (show n) ++ "m"
 
-getColorFunc = do
-    term <- hIsTerminalDevice stdout
-    return $ if term then colorComment else const id
+    colorForLevel "error" = 31 -- red
+    colorForLevel "warning" = 33 -- yellow
+    colorForLevel "info" = 32 -- green
+    colorForLevel "style" = 32 -- green
+    colorForLevel "message" = 1 -- bold
+    colorForLevel "source" = 0 -- none
+    colorForLevel _ = 0 -- none
+
+    colorComment level comment = (ansi $ colorForLevel level) ++ comment ++ clear
+
+    doFile path = do
+        let actualPath = if path == "-" then "/dev/stdin" else path
+        exists <- doesFileExist actualPath
+        if exists then do
+            contents <- readFile actualPath
+            doInput path contents
+          else do
+            colorFunc <- getColorFunc
+            printErr (colorFunc "error" $ "No such file: " ++ actualPath)
+            return False
+
+    doInput filename contents = do
+        let fileLines = lines contents
+        let lineCount = length fileLines
+        let comments = shellCheck contents
+        let groups = groupWith scLine comments
+        colorFunc <- getColorFunc
+        mapM_ (\x -> do
+            let lineNum = scLine (head x)
+            let line = if lineNum < 1 || lineNum > lineCount
+                            then ""
+                            else fileLines !! (lineNum - 1)
+            putStrLn ""
+            putStrLn $ colorFunc "message" ("In " ++ filename ++" line " ++ (show $ lineNum) ++ ":")
+            putStrLn (colorFunc "source" line)
+            mapM (\c -> putStrLn (colorFunc (scSeverity c) $ cuteIndent c)) x
+            putStrLn ""
+          ) groups
+        return $ null comments
+
+    cuteIndent comment =
+        (replicate ((scColumn comment) - 1) ' ') ++ "^-- " ++ (code $ scCode comment) ++ ": " ++ (scMessage comment)
+
+    code code = "SC" ++ (show code)
+
+    getColorFunc = do
+        term <- hIsTerminalDevice stdout
+        return $ if term then colorComment else const id
+
+getOption [] _ def = def
+getOption ((Flag var val):_) name _ | name == var = val
+getOption (_:rest) flag def = getOption rest flag def
 
 main = do
     args <- getArgs
-    colors <- getColorFunc
-    if null args then do
-        hPutStrLn stderr "shellcheck -- bash/sh script static analysis tool"
-        hPutStrLn stderr "Usage: shellcheck filenames..."
-        exitFailure
-      else do
-        statuses <- mapM (\f -> doFile f colors) args
-        if and statuses then exitSuccess else exitFailure
+    parsedArgs <- parseArguments args
+    status <- process parsedArgs
+    if status then exitSuccess else exitFailure
+
+process Nothing = return False
+process (Just (options, files)) =
+  let format = getOption options "format" "tty" in
+    case Map.lookup format formats of
+        Nothing -> do
+            printErr $ "Unknown format " ++ format
+            printErr $ "Supported formats:"
+            mapM_ (printErr . write) $ Map.keys formats
+            return False
+          where write s = "  " ++ s
+        Just f -> do
+            f options files