Some cleanup to make room for future improvements.

ShellCheck.cabal

@@ -41,18 +41,19 @@ library
       containers,
       directory,
       json,
-      mtl,
+      mtl >= 2.2.1,
       parsec,
       regex-tdfa,
       QuickCheck >= 2.7.4
     exposed-modules:
+      ShellCheck.Checker
+      ShellCheck.Analyzer
+      ShellCheck.Parser
       ShellCheck.Analytics
       ShellCheck.AST
       ShellCheck.Data
-      ShellCheck.Options
+      ShellCheck.Interface
-      ShellCheck.Parser
       ShellCheck.Regex
-      ShellCheck.Simple
     other-modules:
       Paths_ShellCheck
 
@@ -63,10 +64,9 @@ executable shellcheck
       containers,
       directory,
       json,
-      mtl,
+      mtl >= 2.2.1,
       parsec,
       regex-tdfa,
-      transformers,
       QuickCheck >= 2.7.4
     main-is: shellcheck.hs
 
@@ -78,10 +78,9 @@ test-suite test-shellcheck
       containers,
       directory,
       json,
-      mtl,
+      mtl >= 2.2.1,
       parsec,
       regex-tdfa,
-      transformers,
       QuickCheck >= 2.7.4
     main-is: test/shellcheck.hs
 

ShellCheck/Analytics.hs

@@ -18,10 +18,17 @@
     along with this program.  If not, see <http://www.gnu.org/licenses/>.
 -}
 {-# LANGUAGE TemplateHaskell, FlexibleContexts #-}
-module ShellCheck.Analytics (AnalysisOptions(..), defaultAnalysisOptions, filterByAnnotation, runAnalytics, shellForExecutable, runTests) where
+module ShellCheck.Analytics (runAnalytics, ShellCheck.Analytics.runTests) where
+
+import ShellCheck.AST
+import ShellCheck.Data
+import ShellCheck.Parser
+import ShellCheck.Interface
+import ShellCheck.Regex
 
 import Control.Arrow (first)
 import Control.Monad
+import Control.Monad.Identity
 import Control.Monad.State
 import Control.Monad.Writer
 import Data.Char
@@ -31,11 +38,6 @@ import Data.List
 import Data.Maybe
 import Data.Ord
 import Debug.Trace
-import ShellCheck.AST
-import ShellCheck.Options
-import ShellCheck.Data
-import ShellCheck.Parser hiding (runTests)
-import ShellCheck.Regex
 import qualified Data.Map as Map
 import Test.QuickCheck.All (forAllProperties)
 import Test.QuickCheck.Test (quickCheckWithResult, stdArgs, maxSuccess)
@@ -48,7 +50,7 @@ data Parameters = Parameters {
     }
 
 -- Checks that are run on the AST root
-treeChecks :: [Parameters -> Token -> [Note]]
+treeChecks :: [Parameters -> Token -> [TokenComment]]
 treeChecks = [
     runNodeAnalysis
         (\p t -> (mapM_ ((\ f -> f t) . (\ f -> f p))
@@ -81,19 +83,28 @@ checksFor Bash = [
     ,checkForDecimals
     ]
 
-runAnalytics :: AnalysisOptions -> Token -> [Note]
+runAnalytics :: AnalysisSpec -> AnalysisResult
-runAnalytics options root = runList options root treeChecks
+runAnalytics options = AnalysisResult {
-
+        arComments = 
-runList options root list = notes
+            nub . filterByAnnotation (asScript options) $
-    where
+                runList options treeChecks
-        params = Parameters {
-                shellType = fromMaybe (determineShell root) $ optionShellType options,
-                shellTypeSpecified = isJust $ optionShellType options,
-                parentMap = getParentTree root,
-                variableFlow = getVariableFlow (shellType params) (parentMap params) root
     }
-        notes = filter (\c -> getCode c `notElem` optionExcludes options) $ concatMap (\f -> f params root) list
+
-        getCode (Note _ _ c _) = c
+runList :: AnalysisSpec -> [Parameters -> Token -> [TokenComment]]
+    -> [TokenComment]
+runList spec list = notes
+    where
+        root = asScript spec
+        params = Parameters {
+                shellType = fromMaybe (determineShell root) $ asShellType spec,
+                shellTypeSpecified = isJust $ asShellType spec,
+                parentMap = getParentTree root,
+                variableFlow =
+                    getVariableFlow (shellType params) (parentMap params) root
+        }
+        notes = concatMap (\f -> f params root) list
+
+getCode (TokenComment _ (Comment _ c _)) = c
 
 
 checkList l t = concatMap (\f -> f t) l
@@ -107,21 +118,10 @@ determineShell (T_Script _ shebang _) = fromMaybe Bash . shellForExecutable $ sh
           shellFor s | ' ' `elem` s = shellFor $ takeWhile (/= ' ') s
           shellFor s = reverse . takeWhile (/= '/') . reverse $ s
 
-shellForExecutable "sh" = return Sh
-shellForExecutable "ash" = return Sh
-shellForExecutable "dash" = return Sh
-
-shellForExecutable "ksh" = return Ksh
-shellForExecutable "ksh88" = return Ksh
-shellForExecutable "ksh93" = return Ksh
-
-shellForExecutable "bash" = return Bash
-shellForExecutable _ = Nothing
-
 -- Checks that are run on each node in the AST
 runNodeAnalysis f p t = execWriter (doAnalysis (f p) t)
 
-nodeChecks :: [Parameters -> Token -> Writer [Note] ()]
+nodeChecks :: [Parameters -> Token -> Writer [TokenComment] ()]
 nodeChecks = [
     checkUuoc
     ,checkPipePitfalls
@@ -216,10 +216,9 @@ nodeChecks = [
 filterByAnnotation token =
     filter (not . shouldIgnore)
   where
-    numFor (Note _ _ code _) = code
+    idFor (TokenComment id _) = id
-    idFor (Note id  _ _ _) = id
     shouldIgnore note =
-        any (shouldIgnoreFor (numFor note)) $
+        any (shouldIgnoreFor (getCode note)) $
             getPath parents (T_Bang $ idFor note)
     shouldIgnoreFor num (T_Annotation _ anns _) =
         any hasNum anns
@@ -228,12 +227,17 @@ filterByAnnotation token =
     shouldIgnoreFor _ _ = False
     parents = getParentTree token
 
-addNote note = tell [note]
+makeComment :: Severity -> Id -> Code -> String -> TokenComment
-makeNote severity id code note = addNote $ Note id severity code note
+makeComment severity id code note =
-warn = makeNote WarningC
+    TokenComment id $ Comment severity code note
-err = makeNote ErrorC
+
-info = makeNote InfoC
+addComment note = tell [note]
-style = makeNote StyleC
+
+warn :: MonadWriter [TokenComment] m => Id -> Code -> String -> m ()
+warn  id code str = addComment $ makeComment WarningC id code str
+err   id code str = addComment $ makeComment ErrorC id code str
+info  id code str = addComment $ makeComment InfoC id code str
+style id code str = addComment $ makeComment StyleC id code str
 
 isVariableStartChar x = x == '_' || isAsciiLower x || isAsciiUpper x
 isVariableChar x = isVariableStartChar x || isDigit x
@@ -343,23 +347,33 @@ getLeadingFlags = getFlagsUntil (not . ("-" `isPrefixOf`))
         [] -> Nothing
         (r:_) -> Just r
 
-verify :: (Parameters -> Token -> Writer [Note] ()) -> String -> Bool
+verify :: (Parameters -> Token -> Writer [TokenComment] ()) -> String -> Bool
 verify f s = checkNode f s == Just True
 
-verifyNot :: (Parameters -> Token -> Writer [Note] ()) -> String -> Bool
+verifyNot :: (Parameters -> Token -> Writer [TokenComment] ()) -> String -> Bool
 verifyNot f s = checkNode f s == Just False
 
-verifyTree :: (Parameters -> Token -> [Note]) -> String -> Bool
+verifyTree :: (Parameters -> Token -> [TokenComment]) -> String -> Bool
-verifyTree f s = checkTree f s == Just True
+verifyTree f s = producesComments f s == Just True
 
-verifyNotTree :: (Parameters -> Token -> [Note]) -> String -> Bool
+verifyNotTree :: (Parameters -> Token -> [TokenComment]) -> String -> Bool
-verifyNotTree f s = checkTree f s == Just False
+verifyNotTree f s = producesComments f s == Just False
 
-checkNode f = checkTree (runNodeAnalysis f)
-checkTree f s = case parseShell defaultAnalysisOptions "-" s of
-        (ParseResult (Just (t, m)) _) -> Just . not . null $ runList defaultAnalysisOptions t [f]
-        _ -> Nothing
 
+defaultSpec root = AnalysisSpec {
+    asScript = root,
+    asShellType = Nothing,
+    asExecutionMode = Executed
+}
+
+checkNode f = producesComments (runNodeAnalysis f)
+producesComments :: (Parameters -> Token -> [TokenComment]) -> String -> Maybe Bool
+producesComments f s = do
+        root <- prRoot pResult
+        return . not . null $ runList (defaultSpec root) [f]
+  where
+    pSpec = ParseSpec { psScript = s }
+    pResult = runIdentity $ parseScript (mockedSystemInterface []) pSpec
 
 -- Copied from https://wiki.haskell.org/Edit_distance
 dist :: Eq a => [a] -> [a] -> Int
@@ -628,13 +642,13 @@ mayBecomeMultipleArgs t = willBecomeMultipleArgs t || f t
 prop_checkShebangParameters1 = verifyTree checkShebangParameters "#!/usr/bin/env bash -x\necho cow"
 prop_checkShebangParameters2 = verifyNotTree checkShebangParameters "#! /bin/sh  -l "
 checkShebangParameters _ (T_Script id sb _) =
-    [Note id ErrorC 2096 "On most OS, shebangs can only specify a single parameter." | length (words sb) > 2]
+    [makeComment ErrorC id 2096 "On most OS, shebangs can only specify a single parameter." | length (words sb) > 2]
 
 prop_checkShebang1 = verifyNotTree checkShebang "#!/usr/bin/env bash -x\necho cow"
 prop_checkShebang2 = verifyNotTree checkShebang "#! /bin/sh  -l "
 prop_checkShebang3 = verifyTree checkShebang "ls -l"
 checkShebang params (T_Script id sb _) =
-    [Note id ErrorC 2148 "Tips depend on target shell and yours is unknown. Add a shebang."
+    [makeComment ErrorC id 2148 "Tips depend on target shell and yours is unknown. Add a shebang."
         | not (shellTypeSpecified params) && sb == "" ]
 
 prop_checkBashisms = verify checkBashisms "while read a; do :; done < <(a)"
@@ -901,15 +915,15 @@ prop_checkRedirectToSame5 = verifyNot checkRedirectToSame "foo > bar 2> bar"
 checkRedirectToSame params s@(T_Pipeline _ _ list) =
     mapM_ (\l -> (mapM_ (\x -> doAnalysis (checkOccurrences x) l) (getAllRedirs list))) list
   where
-    note x = Note x InfoC 2094
+    note x = makeComment InfoC x 2094
                 "Make sure not to read and write the same file in the same pipeline."
     checkOccurrences t@(T_NormalWord exceptId x) u@(T_NormalWord newId y) =
         when (exceptId /= newId
                 && x == y
                 && not (isOutput t && isOutput u)
                 && not (special t)) $ do
-            addNote $ note newId
+            addComment $ note newId
-            addNote $ note exceptId
+            addComment $ note exceptId
     checkOccurrences _ _ = return ()
     getAllRedirs = concatMap (\t ->
         case t of
@@ -1028,7 +1042,7 @@ checkArrayWithoutIndex params _ =
         return . maybeToList $ do
             name <- getLiteralString token
             assignment <- Map.lookup name map
-            return [Note id WarningC 2128
+            return [makeComment WarningC id 2128
                     "Expanding an array without an index only gives the first element."]
     readF _ _ _ = return []
 
@@ -2495,6 +2509,17 @@ findSubshelled (StackScopeEnd:rest) ((reason, scope):oldScopes) deadVars =
         foldl (\m (_, token, var, _) ->
             Map.insert var (Dead token reason) m) deadVars scope
 
+
+-- FIXME: This is a very strange way of doing it.
+-- For each variable read/write, run a stateful function that emits
+-- comments. The comments are collected and returned.
+doVariableFlowAnalysis ::
+    (Token -> Token -> String -> State t [v])
+    -> (Token -> Token -> String -> DataType -> State t [v])
+    -> t
+    -> [StackData]
+    -> [v]
+
 doVariableFlowAnalysis readFunc writeFunc empty flow = evalState (
     foldM (\list x -> do { l <- doFlow x;  return $ l ++ list; }) [] flow
     ) empty
@@ -2548,7 +2573,7 @@ checkSpacefulness params t =
 
     readF _ token name = do
         spaced <- hasSpaces name
-        return [Note (getId token) InfoC 2086 warning |
+        return [makeComment InfoC (getId token) 2086 warning |
                   spaced
                   && not (isArrayExpansion token) -- There's another warning for this
                   && not (isCounting token)
@@ -2652,9 +2677,9 @@ checkQuotesInLiterals params t =
               && not (isParamTo parents "eval" expr)
               && not (isQuoteFree parents expr)
               then [
-                  Note (fromJust assignment)WarningC 2089
+                  makeComment WarningC (fromJust assignment) 2089
                       "Quotes/backslashes will be treated literally. Use an array.",
-                  Note (getId expr) WarningC 2090
+                  makeComment WarningC (getId expr) 2090
                       "Quotes/backslashes in this variable will not be respected."
                 ]
               else [])

ShellCheck/Analyzer.hs

@@ -0,0 +1,27 @@
+{-
+    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/>.
+-}
+module ShellCheck.Analyzer (analyzeScript) where
+
+import ShellCheck.Interface
+import ShellCheck.Analytics
+
+-- TODO: Clean up the cruft this is layered on
+analyzeScript :: AnalysisSpec -> AnalysisResult
+analyzeScript = runAnalytics

ShellCheck/Checker.hs

@@ -0,0 +1,124 @@
+{-
+    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/>.
+-}
+{-# LANGUAGE TemplateHaskell #-}
+module ShellCheck.Checker (checkScript, ShellCheck.Checker.runTests) where
+
+import ShellCheck.Interface
+import ShellCheck.Parser
+import ShellCheck.Analyzer
+
+import Data.Either
+import Data.Functor
+import Data.List
+import Data.Maybe
+import Data.Ord
+import Control.Monad.Identity
+import qualified Data.Map as Map
+import qualified System.IO
+import Prelude hiding (readFile)
+import Control.Monad
+
+import Test.QuickCheck.All
+
+tokenToPosition map (TokenComment id c) = fromMaybe fail $ do
+    position <- Map.lookup id map
+    return $ PositionedComment position c
+  where
+    fail = error "Internal shellcheck error: id doesn't exist. Please report!"
+
+checkScript :: Monad m => SystemInterface m -> CheckSpec -> m CheckResult
+checkScript sys spec = do
+    results <- checkScript (csScript spec)
+    return CheckResult {
+        crComments = results
+    }
+  where
+    checkScript contents = do
+        result <- parseScript sys ParseSpec { psScript = contents }
+        let parseMessages = prComments result
+        let analysisMessages =
+                fromMaybe [] $
+                    (arComments . analyzeScript . analysisSpec)
+                        <$> prRoot result
+        let translator = tokenToPosition (prTokenPositions result)
+        return . sortMessages . filter shouldInclude $
+            (parseMessages ++ map translator analysisMessages)
+
+    shouldInclude (PositionedComment _ (Comment _ code _)) =
+        code `notElem` csExcludedWarnings spec
+
+    sortMessages = sortBy (comparing order)
+    order (PositionedComment pos (Comment severity code message)) =
+        (posFile pos, posLine pos, posColumn pos, code, message)
+    getPosition (PositionedComment pos _) = pos
+
+    analysisSpec root =
+        AnalysisSpec {
+            asScript = root,
+            asShellType = csShellTypeOverride spec,
+            asExecutionMode = Executed
+         }
+
+getErrors sys spec =
+    map getCode . crComments $
+        runIdentity (checkScript sys spec)
+  where
+    getCode (PositionedComment _ (Comment _ code _)) = code
+
+check str =
+    getErrors
+        (mockedSystemInterface [])
+        emptyCheckSpec {
+            csScript = str,
+            csExcludedWarnings = [2148]
+        }
+
+prop_findsParseIssue = check "echo \"$12\"" == [1037]
+
+prop_commentDisablesParseIssue1 =
+    null $ check "#shellcheck disable=SC1037\necho \"$12\""
+prop_commentDisablesParseIssue2 =
+    null $ check "#shellcheck disable=SC1037\n#lol\necho \"$12\""
+
+prop_findsAnalysisIssue =
+    check "echo $1" == [2086]
+prop_commentDisablesAnalysisIssue1 =
+    null $ check "#shellcheck disable=SC2086\necho $1"
+prop_commentDisablesAnalysisIssue2 =
+    null $ check "#shellcheck disable=SC2086\n#lol\necho $1"
+
+prop_optionDisablesIssue1 =
+    null $ getErrors
+                (mockedSystemInterface [])
+                emptyCheckSpec {
+                    csScript = "echo $1",
+                    csExcludedWarnings = [2148, 2086]
+                }
+
+prop_optionDisablesIssue2 =
+    null $ getErrors
+                (mockedSystemInterface [])
+                emptyCheckSpec {
+                    csScript = "echo \"$10\"",
+                    csExcludedWarnings = [2148, 1037]
+                }
+
+return []
+runTests = $quickCheckAll

ShellCheck/Data.hs

@@ -1,5 +1,6 @@
 module ShellCheck.Data where
 
+import ShellCheck.Interface
 import Data.Version (showVersion)
 import Paths_ShellCheck (version)
 
@@ -73,3 +74,15 @@ sampleWords = [
     "tango", "uniform", "victor", "whiskey", "xray", "yankee",
     "zulu"
   ]
+
+shellForExecutable :: String -> Maybe Shell
+shellForExecutable "sh" = return Sh
+shellForExecutable "ash" = return Sh
+shellForExecutable "dash" = return Sh
+
+shellForExecutable "ksh" = return Ksh
+shellForExecutable "ksh88" = return Ksh
+shellForExecutable "ksh93" = return Ksh
+
+shellForExecutable "bash" = return Bash
+shellForExecutable _ = Nothing

ShellCheck/Interface.hs

@@ -0,0 +1,99 @@
+{-
+    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/>.
+-}
+module ShellCheck.Interface where
+
+import ShellCheck.AST
+import Control.Monad.Identity
+import qualified Data.Map as Map
+
+
+data SystemInterface m = SystemInterface {
+    -- Read a file by filename, or return an error
+    siReadFile :: String -> m (Either ErrorMessage String)
+}
+
+-- ShellCheck input and output
+data CheckSpec = CheckSpec {
+    csScript :: String,
+    csExcludedWarnings :: [Integer],
+    csShellTypeOverride :: Maybe Shell
+} deriving (Show, Eq)
+
+data CheckResult = CheckResult {
+    crComments :: [PositionedComment]
+} deriving (Show, Eq)
+
+emptyCheckSpec = CheckSpec {
+    csScript = "",
+    csExcludedWarnings = [],
+    csShellTypeOverride = Nothing
+}
+
+-- Parser input and output
+data ParseSpec = ParseSpec {
+    psScript :: String
+} deriving (Show, Eq)
+
+data ParseResult = ParseResult {
+    prComments :: [PositionedComment],
+    prTokenPositions :: Map.Map Id Position,
+    prRoot :: Maybe Token
+} deriving (Show, Eq)
+
+-- Analyzer input and output
+data AnalysisSpec = AnalysisSpec {
+    asScript :: Token,
+    asShellType :: Maybe Shell,
+    asExecutionMode :: ExecutionMode
+}
+
+data AnalysisResult = AnalysisResult {
+    arComments :: [TokenComment]
+}
+
+-- Supporting data types
+data Shell = Ksh | Sh | Bash deriving (Show, Eq)
+data ExecutionMode = Executed | Sourced deriving (Show, Eq)
+
+type ErrorMessage = String
+type Code = Integer
+
+data Severity = ErrorC | WarningC | InfoC | StyleC deriving (Show, Eq, Ord)
+data Position = Position {
+    posFile :: String,    -- Filename
+    posLine :: Integer,   -- 1 based source line
+    posColumn :: Integer  -- 1 based source column, where tabs are 8
+} deriving (Show, Eq)
+
+data Comment = Comment Severity Code String deriving (Show, Eq)
+data PositionedComment = PositionedComment Position Comment deriving (Show, Eq)
+data TokenComment = TokenComment Id Comment deriving (Show, Eq)
+
+-- For testing
+mockedSystemInterface :: [(String, String)] -> SystemInterface Identity
+mockedSystemInterface files = SystemInterface {
+    siReadFile = rf
+}
+  where
+    rf file =
+        case filter ((== file) . fst) files of
+            [] -> return $ Left "File not included in mock."
+            [(_, contents)] -> return $ Right contents
+

ShellCheck/Options.hs

@@ -1,14 +0,0 @@
-module ShellCheck.Options where
-
-data Shell = Ksh | Sh | Bash
-    deriving (Show, Eq)
-
-data AnalysisOptions = AnalysisOptions {
-    optionShellType :: Maybe Shell,
-    optionExcludes :: [Integer]
-}
-
-defaultAnalysisOptions = AnalysisOptions {
-    optionShellType = Nothing,
-    optionExcludes = []
-}

ShellCheck/Parser.hs

@@ -18,19 +18,21 @@
     along with this program.  If not, see <http://www.gnu.org/licenses/>.
 -}
 {-# LANGUAGE NoMonomorphismRestriction, TemplateHaskell, FlexibleContexts #-}
-module ShellCheck.Parser (Note(..), Severity(..), parseShell, ParseResult(..), ParseNote(..), sortNotes, noteToParseNote, runTests, readScript) where
+module ShellCheck.Parser (parseScript, runTests) where
 
 import ShellCheck.AST
 import ShellCheck.Data
-import ShellCheck.Options
+import ShellCheck.Interface
-import Text.Parsec
+import Text.Parsec hiding (runParser)
 import Debug.Trace
 import Control.Monad
-import Control.Arrow (first)
+import Control.Monad.Identity
 import Data.Char
+import Data.Functor
 import Data.List (isPrefixOf, isInfixOf, isSuffixOf, partition, sortBy, intercalate, nub)
 import qualified Data.Map as Map
 import qualified Control.Monad.State as Ms
+import qualified Control.Monad.Reader as Mr
 import Data.Maybe
 import Prelude hiding (readList)
 import System.IO
@@ -38,6 +40,10 @@ import Text.Parsec.Error
 import GHC.Exts (sortWith)
 import Test.QuickCheck.All (quickCheckAll)
 
+type SCBase m = Mr.ReaderT (SystemInterface m) (Ms.StateT SystemState m)
+type SCParser m v = ParsecT String UserState (SCBase m) v
+
+backslash :: Monad m => SCParser m Char
 backslash = char '\\'
 linefeed = optional carriageReturn >> char '\n'
 singleQuote = char '\'' <|> unicodeSingleQuote
@@ -119,9 +125,18 @@ almostSpace =
 --------- Message/position annotation on top of user state
 data Note = Note Id Severity Code String deriving (Show, Eq)
 data ParseNote = ParseNote SourcePos Severity Code String deriving (Show, Eq)
-data Severity = ErrorC | WarningC | InfoC | StyleC deriving (Show, Eq, Ord)
 data Context = ContextName SourcePos String | ContextAnnotation [Annotation] deriving (Show)
-type Code = Integer
+
+data UserState = UserState {
+    lastId :: Id,
+    positionMap :: Map.Map Id SourcePos,
+    parseNotes :: [ParseNote]
+}
+initialUserState = UserState {
+    lastId = Id $ -1,
+    positionMap = Map.empty,
+    parseNotes = []
+}
 
 codeForParseNote (ParseNote _ _ code _) = code
 noteToParseNote map (Note id severity code message) =
@@ -129,17 +144,17 @@ noteToParseNote map (Note id severity code message) =
     where
         pos = fromJust $ Map.lookup id map
 
-initialState = (Id $ -1, Map.empty, [])
 
-getLastId = do
+getLastId = lastId <$> getState
-    (id, _, _) <- getState
-    return id
 
 getNextIdAt sourcepos = do
-    (id, map, notes) <- getState
+    state <- getState
-    let newId = incId id
+    let newId = incId (lastId state)
-    let newMap = Map.insert newId sourcepos map
+    let newMap = Map.insert newId sourcepos (positionMap state)
-    putState (newId, newMap, notes)
+    putState $ state {
+        lastId = newId,
+        positionMap = newMap
+    }
     return newId
   where incId (Id n) = Id $ n+1
 
@@ -147,23 +162,16 @@ getNextId = do
     pos <- getPosition
     getNextIdAt pos
 
-modifyMap f = do
+getMap = positionMap <$> getState
-    (id, map, parsenotes) <- getState
+getParseNotes = parseNotes <$> getState
-    putState (id, f map, parsenotes)
-
-getMap = do
-    (_, map, _) <- getState
-    return map
-
-getParseNotes = do
-    (_, _, notes) <- getState
-    return notes
 
 addParseNote n = do
     irrelevant <- shouldIgnoreCode (codeForParseNote n)
     unless irrelevant $ do
-        (a, b, notes) <- getState
+        state <- getState
-        putState (a, b, n:notes)
+        putState $ state {
+            parseNotes = n : parseNotes state
+        }
 
 shouldIgnoreCode code = do
     context <- getCurrentContexts
@@ -175,16 +183,22 @@ shouldIgnoreCode code = do
     disabling' (DisableComment n) = code == n
 
 -- Store potential parse problems outside of parsec
+
+data SystemState = SystemState {
+    contextStack :: [Context],
+    parseProblems :: [ParseNote]
+}
+initialSystemState = SystemState {
+    contextStack = [],
+    parseProblems = []
+}
+
 parseProblem level code msg = do
     pos <- getPosition
     parseProblemAt pos level code msg
 
-setCurrentContexts c =
+setCurrentContexts c = Ms.modify (\state -> state { contextStack = c })
-    Ms.modify (\(list, _) -> (list, c))
+getCurrentContexts = contextStack <$> Ms.get
-
-getCurrentContexts = do
-    (_, context) <- Ms.get
-    return context
 
 popContext = do
     v <- getCurrentContexts
@@ -203,7 +217,11 @@ pushContext c = do
 parseProblemAt pos level code msg = do
     irrelevant <- shouldIgnoreCode code
     unless irrelevant $
-        Ms.modify (first ((:) (ParseNote pos level code msg)))
+        Ms.modify (\state -> state {
+            parseProblems = note:parseProblems state
+        })
+  where
+    note = ParseNote pos level code msg
 
 -- Store non-parse problems inside
 
@@ -2152,15 +2170,17 @@ readScript = do
 
     readUtf8Bom = called "Byte Order Mark" $ string "\xFEFF"
 
-rp p filename contents = Ms.runState (runParserT p initialState filename contents) ([], [])
 
-isWarning p s = fst cs && (not . null . snd $ cs) where cs = checkString p s
+isWarning p s = parsesCleanly p s == Just False
-isOk p s = fst cs && (null . snd $ cs) where cs = checkString p s
+isOk p s =      parsesCleanly p s == Just True
 
-checkString parser string =
+parsesCleanly parser string = runIdentity $ do
-    case rp (parser >> eof >> getState) "-" string of
+    (res, sys) <- runParser (mockedSystemInterface [])
-        (Right (tree, map, notes), (problems, _)) -> (True, notes ++ problems)
+                    (parser >> eof >> getState) "-" string
-        (Left _, (n, _)) -> (False, n)
+    case (res, sys) of
+        (Right userState, systemState) ->
+            return $ Just . null $ parseNotes userState ++ parseProblems systemState
+        (Left _, _) -> return Nothing
 
 parseWithNotes parser = do
     item <- parser
@@ -2172,8 +2192,6 @@ compareNotes (ParseNote pos1 level1 _ s1) (ParseNote pos2 level2 _ s2) = compare
 sortNotes = sortBy compareNotes
 
 
-data ParseResult = ParseResult { parseResult :: Maybe (Token, Map.Map Id SourcePos), parseNotes :: [ParseNote] } deriving (Show)
-
 makeErrorFor parsecError =
     ParseNote (errorPos parsecError) ErrorC 1072 $
         getStringFromParsec $ errorMessages parsecError
@@ -2191,13 +2209,39 @@ getStringFromParsec errors =
                 Message s     ->  if null s then Nothing else return $ s ++ "."
         unexpected s = "Unexpected " ++ (if null s then "eof" else s) ++ "."
 
-parseShell options filename contents =
+runParser :: Monad m =>
-    case rp (parseWithNotes readScript) filename contents of
+    SystemInterface m ->
-        (Right (script, map, notes), (parsenotes, _)) ->
+    SCParser m v ->
-            ParseResult (Just (script, map)) (nub . sortNotes . excludeNotes $ notes ++ parsenotes)
+    String ->
-        (Left err, (p, context)) ->
+    String ->
-            ParseResult Nothing
+    m (Either ParseError v, SystemState)
-                (nub . sortNotes . excludeNotes $ p ++ notesForContext context ++ [makeErrorFor err])
+
+runParser sys p filename contents =
+    Ms.runStateT
+        (Mr.runReaderT
+            (runParserT p initialUserState filename contents)
+            sys)
+        initialSystemState
+
+parseShell sys contents = do
+    (result, state) <- runParser sys (parseWithNotes readScript) "" contents
+    case result of
+        Right (script, tokenMap, notes) ->
+            return ParseResult {
+                prComments = map toPositionedComment $ nub $ notes ++ parseProblems state,
+                prTokenPositions = Map.map posToPos tokenMap,
+                prRoot = Just script
+            }
+        Left err ->
+            return ParseResult {
+                prComments =
+                    map toPositionedComment $
+                        notesForContext (contextStack state)
+                        ++ [makeErrorFor err]
+                        ++ parseProblems state,
+                prTokenPositions = Map.empty,
+                prRoot = Nothing
+            }
   where
     isName (ContextName _ _) = True
     isName _ = False
@@ -2206,7 +2250,25 @@ parseShell options filename contents =
         "Couldn't parse this " ++ str ++ "."
     second (ContextName pos str) = ParseNote pos InfoC 1009 $
         "The mentioned parser error was in this " ++ str ++ "."
-    excludeNotes = filter (\c -> codeForParseNote c `notElem` optionExcludes options)
+
+
+toPositionedComment :: ParseNote -> PositionedComment
+toPositionedComment (ParseNote pos severity code message) =
+    PositionedComment (posToPos pos) $ Comment severity code message
+
+posToPos :: SourcePos -> Position
+posToPos sp = Position {
+    posFile = sourceName sp,
+    posLine = fromIntegral $ sourceLine sp,
+    posColumn = fromIntegral $ sourceColumn sp
+}
+
+-- TODO: Clean up crusty old code that this is layered on top of
+parseScript :: Monad m =>
+        SystemInterface m -> ParseSpec -> m ParseResult
+parseScript sys spec =
+    parseShell sys (psScript spec)
+
 
 lt x = trace (show x) x
 ltt t = trace (show t)

ShellCheck/Simple.hs

@@ -1,82 +0,0 @@
-{-
-    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/>.
--}
-{-# LANGUAGE TemplateHaskell #-}
-module ShellCheck.Simple (shellCheck, ShellCheckComment, scLine, scColumn, scSeverity, scCode, scMessage, runTests) where
-
-import Data.List
-import Data.Maybe
-import ShellCheck.Analytics hiding (runTests)
-import ShellCheck.Options
-import ShellCheck.Parser hiding (runTests)
-import Test.QuickCheck.All (quickCheckAll)
-import Text.Parsec.Pos
-
-shellCheck :: AnalysisOptions -> String -> [ShellCheckComment]
-shellCheck options script =
-    let (ParseResult result notes) = parseShell options "-" script in
-        let allNotes = notes ++ concat (maybeToList $ do
-            (tree, posMap) <- result
-            let list = runAnalytics options tree
-            return $ map (noteToParseNote posMap) $ filterByAnnotation tree list
-            )
-        in
-            map formatNote $ nub $ sortNotes allNotes
-
-data ShellCheckComment = ShellCheckComment { scLine :: Int, scColumn :: Int, scSeverity :: String, scCode :: Int, scMessage :: String }
-
-instance Show ShellCheckComment where
-    show c = concat ["(", show $ scLine c, ",", show $ scColumn c, ") ", scSeverity c, ": ", show (scCode c), " ", scMessage c]
-
-severityToString s =
-    case s of
-        ErrorC -> "error"
-        WarningC -> "warning"
-        InfoC -> "info"
-        StyleC -> "style"
-
-formatNote (ParseNote pos severity code text) =
-    ShellCheckComment (sourceLine pos) (sourceColumn pos) (severityToString severity) (fromIntegral code) text
-
-testCheck = shellCheck defaultAnalysisOptions { optionExcludes = [2148] } -- Ignore #! warnings
-prop_findsParseIssue =
-    let comments = testCheck "echo \"$12\"" in
-        length comments == 1 && scCode (head comments) == 1037
-prop_commentDisablesParseIssue1 =
-    null $ testCheck "#shellcheck disable=SC1037\necho \"$12\""
-prop_commentDisablesParseIssue2 =
-    null $ testCheck "#shellcheck disable=SC1037\n#lol\necho \"$12\""
-
-prop_findsAnalysisIssue =
-    let comments = testCheck "echo $1" in
-        length comments == 1 && scCode (head comments) == 2086
-prop_commentDisablesAnalysisIssue1 =
-    null $ testCheck "#shellcheck disable=SC2086\necho $1"
-prop_commentDisablesAnalysisIssue2 =
-    null $ testCheck "#shellcheck disable=SC2086\n#lol\necho $1"
-
-prop_optionDisablesIssue1 =
-    null $ shellCheck (defaultAnalysisOptions { optionExcludes = [2086, 2148] }) "echo $1"
-
-prop_optionDisablesIssue2 =
-    null $ shellCheck (defaultAnalysisOptions { optionExcludes = [2148, 1037] }) "echo \"$10\""
-
-return []
-runTests = $quickCheckAll
-

shellcheck.hs

@@ -17,43 +17,59 @@
     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 Control.Exception
 import Control.Monad
-import Control.Monad.Trans
+import Control.Monad.Except
-import Control.Monad.Trans.Error
-import Control.Monad.Trans.List
 import Data.Char
+import Data.Functor
+import Data.Either
+import Data.IORef
 import Data.List
+import qualified Data.Map as Map
 import Data.Maybe
 import Data.Monoid
 import GHC.Exts
 import GHC.IO.Device
 import Prelude hiding (catch)
-import ShellCheck.Data
-import ShellCheck.Options
-import ShellCheck.Simple
-import ShellCheck.Analytics
 import System.Console.GetOpt
-import System.Directory
 import System.Environment
 import System.Exit
-import System.Info
 import System.IO
+import System.Info
 import Text.JSON
 import qualified Data.Map as Map
 
 data Flag = Flag String String
-data Status = NoProblems | SomeProblems | BadInput | SupportFailure | SyntaxFailure | RuntimeException deriving (Ord, Eq)
+data Status =
-
+    NoProblems
-data JsonComment = JsonComment FilePath ShellCheckComment
+    | SomeProblems
-
+    | BadInput
-instance Error Status where
+    | SupportFailure
-    noMsg = RuntimeException
+    | SyntaxFailure
+    | RuntimeException
+  deriving (Ord, Eq)
 
 instance Monoid Status where
     mempty = NoProblems
     mappend = max
 
+lineNo (PositionedComment pos _) = posLine pos
+colNo  (PositionedComment pos _) = posColumn pos
+codeNo (PositionedComment _ (Comment _ code _)) = code
+messageText (PositionedComment _ (Comment _ _ t)) = t
+
+severityText :: PositionedComment -> String
+severityText (PositionedComment _ (Comment c _ _)) =
+    case c of
+        ErrorC   -> "error"
+        WarningC -> "warning"
+        InfoC    -> "info"
+        StyleC   -> "style"
+
 header = "Usage: shellcheck [OPTIONS...] FILES..."
 options = [
     Option "e" ["exclude"]
@@ -66,51 +82,42 @@ options = [
         (NoArg $ Flag "version" "true") "Print version information"
     ]
 
-printErr = hPutStrLn stderr
+printOut = lift . hPutStrLn stdout
+printErr = lift . hPutStrLn stderr
 
-
+instance JSON (PositionedComment) where
-instance JSON (JsonComment) where
+  showJSON comment@(PositionedComment pos (Comment level code string)) = makeObj [
-  showJSON (JsonComment filename c) = makeObj [
+      ("file", showJSON $ posFile pos),
-      ("file", showJSON filename),
+      ("line", showJSON $ posLine pos),
-      ("line", showJSON $ scLine c),
+      ("column", showJSON $ posColumn pos),
-      ("column", showJSON $ scColumn c),
+      ("level", showJSON $ severityText comment),
-      ("level", showJSON $ scSeverity c),
+      ("code", showJSON code),
-      ("code", showJSON $ scCode c),
+      ("message", showJSON string)
-      ("message", showJSON $ scMessage c)
       ]
+    where
+
   readJSON = undefined
 
-parseArguments :: [String] -> ErrorT Status IO ([Flag], [FilePath])
+
+parseArguments :: [String] -> ExceptT Status IO ([Flag], [FilePath])
 parseArguments argv =
     case getOpt Permute options argv of
         (opts, files, []) -> return (opts, files)
         (_, _, errors) -> do
-            liftIO . printErr $ concat errors ++ "\n" ++ usageInfo header options
+            printErr $ concat errors ++ "\n" ++ usageInfo header options
             throwError SyntaxFailure
 
-formats :: Map.Map String (AnalysisOptions -> [FilePath] -> IO Status)
 formats = Map.fromList [
+{-
     ("json", forJson),
     ("gcc", forGcc),
     ("checkstyle", forCheckstyle),
+-}
     ("tty", forTty)
     ]
 
-toStatus = liftM (either id (const NoProblems)) . runErrorT
+forTty :: SystemInterface IO -> CheckSpec -> [FilePath] -> ExceptT Status IO ()
-
+forTty sys spec files = mapM_ doFile files
-catchExceptions :: IO Status -> IO Status
-catchExceptions action = action `catch` handler
-  where
-    handler err = do
-        printErr $ show (err :: SomeException)
-        return RuntimeException
-
-checkComments comments = if null comments then NoProblems else SomeProblems
-
-forTty :: AnalysisOptions -> [FilePath] -> IO Status
-forTty options files = do
-    output <- mapM doFile files
-    return $ mconcat output
   where
     clear = ansi 0
     ansi n = "\x1B[" ++ show n ++ "m"
@@ -126,88 +133,99 @@ forTty options files = do
     colorComment level comment =
         ansi (colorForLevel level) ++ comment ++ clear
 
-    doFile path = catchExceptions $ do
+    doFile filename = do
-        contents <- readContents path
+        contents <- lift $ inputFile filename
-        doInput path contents
+        comments <- lift (crComments <$> checkScript sys spec { csScript = contents })
-
-    doInput filename contents = do
         let fileLines = lines contents
-        let lineCount = length fileLines
+        let lineCount = fromIntegral $ length fileLines
-        let comments = getComments options contents
+        let groups = groupWith lineNo comments
-        let groups = groupWith scLine comments
         colorFunc <- getColorFunc
         mapM_ (\x -> do
-            let lineNum = scLine (head x)
+            let lineNum = lineNo (head x)
             let line = if lineNum < 1 || lineNum > lineCount
                             then ""
-                            else fileLines !! (lineNum - 1)
+                            else fileLines !! (fromIntegral $ lineNum - 1)
-            putStrLn ""
+            printOut ""
-            putStrLn $ colorFunc "message"
+            printOut $ colorFunc "message"
                 ("In " ++ filename ++" line " ++ show lineNum ++ ":")
-            putStrLn (colorFunc "source" line)
+            printOut (colorFunc "source" line)
-            mapM_ (\c -> putStrLn (colorFunc (scSeverity c) $ cuteIndent c)) x
+            mapM_ (\c -> printOut (colorFunc (severityText c) $ cuteIndent c)) x
-            putStrLn ""
+            printOut ""
           ) groups
-        return . checkComments $ comments
 
+    cuteIndent :: PositionedComment -> String
     cuteIndent comment =
-        replicate (scColumn comment - 1) ' ' ++
+        replicate (fromIntegral $ colNo comment - 1) ' ' ++
-            "^-- " ++ code (scCode comment) ++ ": " ++ scMessage comment
+            "^-- " ++ code (codeNo comment) ++ ": " ++ messageText comment
 
     code code = "SC" ++ show code
 
     getColorFunc = do
-        term <- hIsTerminalDevice stdout
+        term <- lift $ hIsTerminalDevice stdout
         let windows = "mingw" `isPrefixOf` os
         return $ if term && not windows then colorComment else const id
 
-forJson :: AnalysisOptions -> [FilePath] -> IO Status
+{-
-forJson options files = catchExceptions $ do
+forJson :: a -> Formatter
-    comments <- runListT $ do
+forJson _ result = do
-        file <- ListT $ return files
+    let comments = concatMap getComments (crComments result)
-        comment <- ListT $ commentsFor options file
+    lift $ putStrLn $ encodeStrict comments
-        return $ JsonComment file comment
+  where
-    putStrLn $ encodeStrict comments
+    getComments (_, FileResult comments) = comments
-    return $ checkComments comments
+    getComments (file, FileError str) = [
+        PositionedComment
+            Position {
+                posFile = file,
+                posLine = 1,
+                posColumn = 1
+            }
+            (Comment ErrorC 1000 str)
+        ]
 
 -- Mimic GCC "file:line:col: (error|warning|note): message" format
-forGcc :: AnalysisOptions -> [FilePath] -> IO Status
+forGcc :: SystemInterface IO -> Formatter
-forGcc options files = do
+forGcc io result = do
-    files <- mapM process files
+    mapM_ (uncurry process) (crComments result)
-    return $ mconcat files
   where
-    process file = catchExceptions $ do
+    process filename (FileError string) = do
-        contents <- readContents file
+        printErr $ string
-        let comments = makeNonVirtual (getComments options contents) contents
+
-        mapM_ (putStrLn . format file) comments
+    process filename (FileResult result) = do
-        return $ checkComments comments
+        fileInput <- lift $ siReadFile io filename
+        when (isLeft fileInput) $ do
+            printErr $ "Failed to re-open " ++ filename
+            throwError RuntimeException
+        let contents = fromRight fileInput
+        let comments = makeNonVirtual result contents
+        mapM_ (printOut . format filename) comments
 
     format filename c = concat [
             filename, ":",
-            show $ scLine c, ":",
+            show $ lineNo c, ":",
-            show $ scColumn c, ": ",
+            show $ colNo c, ": ",
-            case scSeverity c of
+            case severityText c of
                 "error" -> "error"
                 "warning" -> "warning"
                 _ -> "note",
             ": ",
-            concat . lines $ scMessage c,
+            concat . lines $ messageText c,
-            " [SC", show $ scCode c, "]"
+            " [SC", show $ codeNo c, "]"
       ]
 
 -- Checkstyle compatible output. A bit of a hack to avoid XML dependencies
-forCheckstyle :: AnalysisOptions -> [FilePath] -> IO Status
+forCheckstyle :: SystemInterface IO -> Formatter
-forCheckstyle options files = do
+forCheckstyle _ result = do
-    putStrLn "<?xml version='1.0' encoding='UTF-8'?>"
+    printOut "<?xml version='1.0' encoding='UTF-8'?>"
-    putStrLn "<checkstyle version='4.3'>"
+    printOut "<checkstyle version='4.3'>"
-    statuses <- mapM process files
+    statuses <- mapM process (crComments result)
-    putStrLn "</checkstyle>"
+    printOut "</checkstyle>"
     return $ mconcat statuses
   where
-    process file = catchExceptions $ do
+    process (file, FileError str) =
-        comments <- commentsFor options file
+        printOut (formatError file str)
-        putStrLn (formatFile file comments)
+
-        return $ checkComments comments
+    process (file, FileResult comments) =
+        printOut (formatFile file comments)
 
     severity "error" = "error"
     severity "warning" = "warning"
@@ -225,35 +243,39 @@ forCheckstyle options files = do
 
     format c = concat [
         "<error ",
-        attr "line" $ show . scLine $ c,
+        attr "line" $ show . lineNo $ c,
-        attr "column" $ show . scColumn $ c,
+        attr "column" $ show . colNo $ c,
-        attr "severity" $ severity . scSeverity $ c,
+        attr "severity" . severity $ severityText c,
-        attr "message" $ scMessage c,
+        attr "message" $ messageText c,
-        attr "source" $ "ShellCheck.SC" ++ show (scCode c),
+        attr "source" $ "ShellCheck.SC" ++ show (codeNo c),
         "/>\n"
         ]
 
-commentsFor options file = liftM (getComments options) $ readContents file
+    formatError file msg = concat [
+        "<file ", attr "name" file, ">\n",
+        "<error ",
+            attr "line" "1",
+            attr "column" "1",
+            attr "severity" $ severity "error",
+            attr "message" msg,
+            attr "source" "ShellCheck",
+        "/>\n",
+        "</file>"
+        ]
+-}
 
-getComments = shellCheck
-
-readContents :: FilePath -> IO String
-readContents file =
-    if file == "-"
-    then getContents
-    else readFile file
 
 -- Realign comments from a tabstop of 8 to 1
 makeNonVirtual comments contents =
     map fix comments
   where
     ls = lines contents
-    fix c = c {
+    fix c@(PositionedComment pos comment) = PositionedComment pos {
-        scColumn =
+        posColumn =
-            if scLine c > 0 && scLine c <= length ls
+            if lineNo c > 0 && lineNo c <= fromIntegral (length ls)
-            then real (ls !! (scLine c - 1)) 0 0 (scColumn c)
+            then real (ls !! (fromIntegral $ lineNo c - 1)) 0 0 (colNo c)
-            else scColumn c
+            else colNo c
-    }
+    } comment
     real _ r v target | target <= v = r
     real [] r v _ = r -- should never happen
     real ('\t':rest) r v target =
@@ -285,7 +307,9 @@ getExclusions options =
 excludeCodes codes =
     filter (not . hasCode)
   where
-    hasCode c = scCode c `elem` codes
+    hasCode c = codeNo c `elem` codes
+
+toStatus = liftM (either id (const NoProblems)) . runExceptT
 
 main = do
     args <- getArgs
@@ -303,32 +327,34 @@ statusToCode status =
         SupportFailure -> ExitFailure 4
         RuntimeException -> ExitFailure 2
 
-process :: [Flag] -> [FilePath] -> ErrorT Status IO ()
+process :: [Flag] -> [FilePath] -> ExceptT Status IO ()
 process flags files = do
-    options <- foldM (flip parseOption) defaultAnalysisOptions flags
+    options <- foldM (flip parseOption) emptyCheckSpec flags
     verifyFiles files
     let format = fromMaybe "tty" $ getOption flags "format"
+    formatter <-
         case Map.lookup format formats of
             Nothing -> do
-            liftIO $ do
                 printErr $ "Unknown format " ++ format
                 printErr "Supported formats:"
                 mapM_ (printErr . write) $ Map.keys formats
                 throwError SupportFailure
               where write s = "  " ++ s
-        Just f -> ErrorT $ liftM Left $ f options files
+            Just f -> ExceptT $ fmap Right $ return f
+    let sys = ioInterface (const False)
+    formatter sys options files
 
 parseOption flag options =
     case flag of
         Flag "shell" str ->
             fromMaybe (die $ "Unknown shell: " ++ str) $ do
                 shell <- shellForExecutable str
-                    return $ return options { optionShellType = Just shell }
+                return $ return options { csShellTypeOverride = Just shell }
 
         Flag "exclude" str -> do
             new <- mapM parseNum $ split ',' str
-            let old = optionExcludes options
+            let old = csExcludedWarnings options
-            return options { optionExcludes = new ++ old }
+            return options { csExcludedWarnings = new ++ old }
 
         Flag "version" _ -> do
             liftIO printVersion
@@ -337,19 +363,39 @@ parseOption flag options =
         _ -> return options
   where
     die s = do
-        liftIO $ printErr s
+        printErr s
         throwError SupportFailure
     parseNum ('S':'C':str) = parseNum str
     parseNum num = do
         unless (all isDigit num) $ do
-            liftIO . printErr $ "Bad exclusion: " ++ num
+            printErr $ "Bad exclusion: " ++ num
             throwError SyntaxFailure
         return (Prelude.read num :: Integer)
 
+ioInterface filter = do
+    SystemInterface {
+        siReadFile = get
+    }
+  where
+    get file = do
+        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
+    return contents
+
 verifyFiles files =
     when (null files) $ do
-        liftIO $ printErr "No files specified.\n"
+        printErr "No files specified.\n"
-        liftIO $ printErr $ usageInfo header options
+        printErr $ usageInfo header options
         throwError SyntaxFailure
 
 printVersion = do

test/shellcheck.hs

@@ -2,15 +2,17 @@ module Main where
 
 import Control.Monad
 import System.Exit
-import qualified ShellCheck.Simple
+import qualified ShellCheck.Checker
 import qualified ShellCheck.Analytics
 import qualified ShellCheck.Parser
 
 main = do
     putStrLn "Running ShellCheck tests..."
-    results <- sequence [ShellCheck.Simple.runTests,
+    results <- sequence [
+        ShellCheck.Checker.runTests,
         ShellCheck.Analytics.runTests,
-                         ShellCheck.Parser.runTests]
+        ShellCheck.Parser.runTests
-    if and results then exitSuccess
+      ]
+    if and results
+      then exitSuccess
       else exitFailure
-