From 2f5a7be421c0f7be4747593b33aa493fb981152f Mon Sep 17 00:00:00 2001
From: Vidar Holen <spam@vidarholen.net>
Date: Sun, 4 Nov 2012 18:02:51 -0800
Subject: [PATCH] Added cute simplified API plus a CLI frontend

---
 Shpell/Analytics.hs |  2 +-
 Shpell/Parser.hs    |  2 +-
 Shpell/Simple.hs    | 32 ++++++++++++++++++++++
 shpell.hs           | 65 +++++++++++++++++++++++++++++++++++++++++++++
 4 files changed, 99 insertions(+), 2 deletions(-)
 create mode 100644 Shpell/Simple.hs
 create mode 100644 shpell.hs

diff --git a/Shpell/Analytics.hs b/Shpell/Analytics.hs
index 7e2377a..7bf3499 100644
--- a/Shpell/Analytics.hs
+++ b/Shpell/Analytics.hs
@@ -9,7 +9,7 @@ import Debug.Trace
 
 checks = map runBasicAnalysis basicChecks
 
-checkAll = checkList checks
+runAllAnalytics = checkList checks
 checkList l t m = foldl (\x f -> f t x) m l
 
 runBasicAnalysis f t m = snd $ runState (doAnalysis f t) m
diff --git a/Shpell/Parser.hs b/Shpell/Parser.hs
index fabbf20..473c3f3 100644
--- a/Shpell/Parser.hs
+++ b/Shpell/Parser.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE NoMonomorphismRestriction #-}
 
-module Shpell.Parser (Token(..), Note(..), Severity(..), parseShell, ParseResult(..), notesFromMap, Metadata(..), doAnalysis, doTransform) where 
+module Shpell.Parser (Token(..), Note(..), Severity(..), parseShell, ParseResult(..), ParseNote(..), notesFromMap, Metadata(..), doAnalysis, doTransform, sortNotes) where 
 
 import Text.Parsec
 import Text.Parsec.Pos (initialPos)
diff --git a/Shpell/Simple.hs b/Shpell/Simple.hs
new file mode 100644
index 0000000..4b282f5
--- /dev/null
+++ b/Shpell/Simple.hs
@@ -0,0 +1,32 @@
+module Shpell.Simple (shpellCheck, ShpellComment, shpellLine, shpellColumn, shpellSeverity, shpellComment) where
+
+import Shpell.Parser
+import Shpell.Analytics
+import Data.Maybe
+import Text.Parsec.Pos
+
+data ShpellComment = ShpellComment { shpellLine :: Int, shpellColumn :: Int, shpellSeverity :: String, shpellComment :: String }
+
+
+instance Show ShpellComment where
+    show c = concat ["(", show $ shpellLine c, ",", show $ shpellColumn c, ") ", shpellSeverity c, ": ", shpellComment c]
+
+shpellCheck script = 
+    let (ParseResult result notes) = parseShell "-" script in
+        let allNotes = notes ++ (concat $ maybeToList $ do
+            (tree, map) <- result
+            let newMap = runAllAnalytics tree map
+            return $ notesFromMap newMap 
+            )
+        in
+            map formatNote $ sortNotes allNotes
+
+
+severityToString s = 
+    case s of 
+        ErrorC -> "error"
+        WarningC -> "warning"
+        InfoC -> "info"
+        StyleC -> "style"
+
+formatNote (ParseNote pos severity text) = ShpellComment (sourceLine pos) (sourceColumn pos) (severityToString severity) text
diff --git a/shpell.hs b/shpell.hs
new file mode 100644
index 0000000..cbd2b86
--- /dev/null
+++ b/shpell.hs
@@ -0,0 +1,65 @@
+import Control.Monad
+import GHC.Exts
+import GHC.IO.Device
+import Shpell.Simple
+import System.Directory
+import System.Environment
+import System.Exit
+import System.IO
+
+
+clear = ansi 0
+ansi n = "\x1B[" ++ (show n) ++ "m"
+
+colorForLevel "error" = 31 -- red
+colorForLevel "warning" = 33 -- yellow
+colorForLevel "info" = 33 -- yellow
+colorForLevel "style" = 31 -- green
+colorForLevel "message" = 1 -- bold
+colorForLevel "source" = 0 -- none
+colorForLevel _ = 0 -- none
+
+colorComment level comment = (ansi $ colorForLevel level) ++ comment ++ clear
+
+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
+        putStrLn (colorFunc "error" $ "No such file: " ++ actualPath)
+
+doInput filename contents colorFunc = do
+    let fileLines = lines contents
+    let comments = shpellCheck contents
+    let groups = groupWith shpellLine comments
+    if not $ null comments then do
+        mapM_ (\x -> do
+            let line = fileLines !! (shpellLine (head x) - 1)
+            putStrLn ""
+            putStrLn $ colorFunc "message" ("In " ++ filename ++" line " ++ (show $ shpellLine (head x)) ++ ":")
+            putStrLn (colorFunc "source" line)
+            mapM (\c -> putStrLn (colorFunc (shpellSeverity c) $ cuteIndent c)) x
+            putStrLn ""
+          ) groups
+      else do
+        putStrLn ("No comments for " ++ filename)
+
+cuteIndent comment = 
+    (replicate ((shpellColumn comment) - 1) ' ') ++ "^-- " ++ (shpellComment comment)
+
+getColorFunc = do
+    term <- hIsTerminalDevice stdout
+    return $ if term then colorComment else const id
+
+main = do
+    args <- getArgs
+    colors <- getColorFunc
+    if null args then do
+        hPutStrLn stderr "shpell -- bash/sh shell script static analysis tool"
+        hPutStrLn stderr "Usage: shpell filenames..."
+        exitFailure
+      else 
+        mapM (\f -> doFile f colors) args
+
-- 
GitLab