Some cleanup to make room for future improvements.

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 options root = runList options root treeChecks
+runAnalytics :: AnalysisSpec -> AnalysisResult
+runAnalytics options = AnalysisResult {
+        arComments = 
+            nub . filterByAnnotation (asScript options) $
+                runList options treeChecks
+    }
 
-runList options root list = notes
+runList :: AnalysisSpec -> [Parameters -> Token -> [TokenComment]]
+    -> [TokenComment]
+runList spec list = notes
     where
+        root = asScript spec
         params = Parameters {
-                shellType = fromMaybe (determineShell root) $ optionShellType options,
-                shellTypeSpecified = isJust $ optionShellType options,
+                shellType = fromMaybe (determineShell root) $ asShellType spec,
+                shellTypeSpecified = isJust $ asShellType spec,
                 parentMap = getParentTree root,
-                variableFlow = getVariableFlow (shellType params) (parentMap params) 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
+        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 (Note id  _ _ _) = id
+    idFor (TokenComment 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]
-makeNote severity id code note = addNote $ Note id severity code note
-warn = makeNote WarningC
-err = makeNote ErrorC
-info = makeNote InfoC
-style = makeNote StyleC
+makeComment :: Severity -> Id -> Code -> String -> TokenComment
+makeComment severity id code note =
+    TokenComment id $ Comment severity code note
+
+addComment note = tell [note]
+
+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 f s = checkTree f s == Just True
+verifyTree :: (Parameters -> Token -> [TokenComment]) -> String -> Bool
+verifyTree f s = producesComments f s == Just True
 
-verifyNotTree :: (Parameters -> Token -> [Note]) -> String -> Bool
-verifyNotTree f s = checkTree f s == Just False
+verifyNotTree :: (Parameters -> Token -> [TokenComment]) -> String -> Bool
+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
-            addNote $ note exceptId
+            addComment $ note newId
+            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 Text.Parsec
+import ShellCheck.Interface
+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
-    (id, _, _) <- getState
-    return id
+getLastId = lastId <$> getState
 
 getNextIdAt sourcepos = do
-    (id, map, notes) <- getState
-    let newId = incId id
-    let newMap = Map.insert newId sourcepos map
-    putState (newId, newMap, notes)
+    state <- getState
+    let newId = incId (lastId state)
+    let newMap = Map.insert newId sourcepos (positionMap state)
+    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
-    (id, map, parsenotes) <- getState
-    putState (id, f map, parsenotes)
-
-getMap = do
-    (_, map, _) <- getState
-    return map
-
-getParseNotes = do
-    (_, _, notes) <- getState
-    return notes
+getMap = positionMap <$> getState
+getParseNotes = parseNotes <$> getState
 
 addParseNote n = do
     irrelevant <- shouldIgnoreCode (codeForParseNote n)
     unless irrelevant $ do
-        (a, b, notes) <- getState
-        putState (a, b, n:notes)
+        state <- getState
+        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 =
-    Ms.modify (\(list, _) -> (list, c))
-
-getCurrentContexts = do
-    (_, context) <- Ms.get
-    return context
+setCurrentContexts c = Ms.modify (\state -> state { contextStack = c })
+getCurrentContexts = contextStack <$> Ms.get
 
 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
-isOk p s = fst cs && (null . snd $ cs) where cs = checkString p s
+isWarning p s = parsesCleanly p s == Just False
+isOk p s =      parsesCleanly p s == Just True
 
-checkString parser string =
-    case rp (parser >> eof >> getState) "-" string of
-        (Right (tree, map, notes), (problems, _)) -> (True, notes ++ problems)
-        (Left _, (n, _)) -> (False, n)
+parsesCleanly parser string = runIdentity $ do
+    (res, sys) <- runParser (mockedSystemInterface [])
+                    (parser >> eof >> getState) "-" string
+    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 =
-    case rp (parseWithNotes readScript) filename contents of
-        (Right (script, map, notes), (parsenotes, _)) ->
-            ParseResult (Just (script, map)) (nub . sortNotes . excludeNotes $ notes ++ parsenotes)
-        (Left err, (p, context)) ->
-            ParseResult Nothing
-                (nub . sortNotes . excludeNotes $ p ++ notesForContext context ++ [makeErrorFor err])
+runParser :: Monad m =>
+    SystemInterface m ->
+    SCParser m v ->
+    String ->
+    String ->
+    m (Either ParseError v, SystemState)
+
+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
-