Merge branch 'ngzhian-opqaque-interface'

shellcheck.hs

@@ -74,7 +74,7 @@ data Options = Options {
 defaultOptions = Options {
     checkSpec = emptyCheckSpec,
     externalSources = False,
-    formatterOptions = FormatterOptions {
+    formatterOptions = newFormatterOptions {
         foColorOption = ColorAuto
     },
     minSeverity = StyleC

src/ShellCheck/Analyzer.hs

@@ -30,7 +30,7 @@ import qualified ShellCheck.Checks.ShellSupport
 
 -- TODO: Clean up the cruft this is layered on
 analyzeScript :: AnalysisSpec -> AnalysisResult
-analyzeScript spec = AnalysisResult {
+analyzeScript spec = newAnalysisResult {
     arComments =
         filterByAnnotation spec params . nub $
             runAnalytics spec

src/ShellCheck/AnalyzerLib.hs

@@ -109,12 +109,11 @@ data DataSource =
 
 data VariableState = Dead Token String | Alive deriving (Show)
 
-defaultSpec root = AnalysisSpec {
-    asScript = root,
+defaultSpec root = spec {
     asShellType = Nothing,
     asCheckSourced = False,
     asExecutionMode = Executed
-}
+} where spec = newAnalysisSpec root
 
 pScript s =
   let
@@ -134,7 +133,14 @@ producesComments c s = do
 
 makeComment :: Severity -> Id -> Code -> String -> TokenComment
 makeComment severity id code note =
-    TokenComment id $ Comment severity code note
+    newTokenComment {
+        tcId = id,
+        tcComment = newComment {
+            cSeverity = severity,
+            cCode = code,
+            cMessage = note
+        }
+    }
 
 addComment note = tell [note]
 
@@ -811,10 +817,9 @@ filterByAnnotation asSpec params =
     filter (not . shouldIgnore)
   where
     token = asScript asSpec
-    idFor (TokenComment id _) = id
     shouldIgnore note =
         any (shouldIgnoreFor (getCode note)) $
-            getPath parents (T_Bang $ idFor note)
+            getPath parents (T_Bang $ tcId note)
     shouldIgnoreFor num (T_Annotation _ anns _) =
         any hasNum anns
       where
@@ -823,7 +828,7 @@ filterByAnnotation asSpec params =
     shouldIgnoreFor _ T_Include {} = not $ asCheckSourced asSpec
     shouldIgnoreFor _ _ = False
     parents = parentMap params
-    getCode (TokenComment _ (Comment _ c _)) = c
+    getCode = cCode . tcComment
 
 -- Is this a ${#anything}, to get string length or array count?
 isCountingReference (T_DollarBraced id token) =

src/ShellCheck/Checker.hs

@@ -37,16 +37,20 @@ import Control.Monad
 
 import Test.QuickCheck.All
 
-tokenToPosition startMap (TokenComment id c) = fromMaybe fail $ do
-    span <- Map.lookup id startMap
-    return $ PositionedComment (fst span) (snd span) c
+tokenToPosition startMap t = fromMaybe fail $ do
+    span <- Map.lookup (tcId t) startMap
+    return $ newPositionedComment {
+        pcStartPos = fst span,
+        pcEndPos = snd span,
+        pcComment = tcComment t
+    }
   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 {
+    return emptyCheckResult {
         crFilename = csFilename spec,
         crComments = results
     }
@@ -67,28 +71,38 @@ checkScript sys spec = do
         return . nub . sortMessages . filter shouldInclude $
             (parseMessages ++ map translator analysisMessages)
 
-    shouldInclude (PositionedComment _ _ (Comment severity code _)) =
-        severity <= csMinSeverity spec &&
-        code `notElem` csExcludedWarnings spec
+    shouldInclude pc =
+        let code     = cCode (pcComment pc)
+            severity = cSeverity (pcComment pc)
+        in
+            code `notElem` csExcludedWarnings spec &&
+            severity <= csMinSeverity spec
 
     sortMessages = sortBy (comparing order)
-    order (PositionedComment pos _ (Comment severity code message)) =
-        (posFile pos, posLine pos, posColumn pos, severity, code, message)
-    getPosition (PositionedComment pos _ _) = pos
+    order pc =
+        let pos = pcStartPos pc
+            comment = pcComment pc in
+        (posFile pos,
+         posLine pos,
+         posColumn pos,
+         cSeverity comment,
+         cCode comment,
+         cMessage comment)
+    getPosition = pcStartPos
 
     analysisSpec root =
-        AnalysisSpec {
+        as {
             asScript = root,
             asShellType = csShellTypeOverride spec,
             asCheckSourced = csCheckSourced spec,
             asExecutionMode = Executed
-         }
+         } where as = newAnalysisSpec root
 
 getErrors sys spec =
     sort . map getCode . crComments $
         runIdentity (checkScript sys spec)
   where
-    getCode (PositionedComment _ _ (Comment _ code _)) = code
+    getCode = cCode . pcComment
 
 check = checkWithIncludes []
 

src/ShellCheck/Formatter/Format.hs

@@ -30,17 +30,17 @@ data Formatter = Formatter {
     footer :: IO ()
 }
 
-sourceFile (PositionedComment pos _ _) = posFile pos
-lineNo (PositionedComment pos _ _) = posLine pos
-endLineNo (PositionedComment _ end _) = posLine end
-colNo  (PositionedComment pos _ _) = posColumn pos
-endColNo  (PositionedComment _ end _) = posColumn end
-codeNo (PositionedComment _ _ (Comment _ code _)) = code
-messageText (PositionedComment _ _ (Comment _ _ t)) = t
+sourceFile = posFile . pcStartPos
+lineNo = posLine . pcStartPos
+endLineNo = posLine . pcEndPos
+colNo  = posColumn . pcStartPos
+endColNo = posColumn . pcEndPos
+codeNo = cCode . pcComment
+messageText = cMessage . pcComment
 
 severityText :: PositionedComment -> String
-severityText (PositionedComment _ _ (Comment c _ _)) =
-    case c of
+severityText pc =
+    case cSeverity (pcComment pc) of
         ErrorC   -> "error"
         WarningC -> "warning"
         InfoC    -> "info"
@@ -51,11 +51,14 @@ makeNonVirtual comments contents =
     map fix comments
   where
     ls = lines contents
-    fix c@(PositionedComment start end comment) = PositionedComment start {
+    fix c = c {
+        pcStartPos = (pcStartPos c) {
             posColumn = realignColumn lineNo colNo c
-    } end {
+        }
+      , pcEndPos = (pcEndPos c) {
             posColumn = realignColumn endLineNo endColNo c
-    } comment
+        }
+    }
     realignColumn lineNo colNo c =
       if lineNo c > 0 && lineNo c <= fromIntegral (length ls)
       then real (ls !! fromIntegral (lineNo c - 1)) 0 0 (colNo c)

src/ShellCheck/Formatter/JSON.hs

@@ -40,7 +40,10 @@ format = do
     }
 
 instance ToJSON (PositionedComment) where
-  toJSON comment@(PositionedComment start end (Comment level code string)) =
+  toJSON comment =
+    let start = pcStartPos comment
+        end = pcEndPos comment
+        c = pcComment comment in
     object [
       "file" .= posFile start,
       "line" .= posLine start,
@@ -48,11 +51,14 @@ instance ToJSON (PositionedComment) where
       "column" .= posColumn start,
       "endColumn" .= posColumn end,
       "level" .= severityText comment,
-      "code" .= code,
-      "message" .= string
+      "code" .= cCode c,
+      "message" .= cMessage c
     ]
 
-  toEncoding comment@(PositionedComment start end (Comment level code string)) =
+  toEncoding comment =
+    let start = pcStartPos comment
+        end = pcEndPos comment
+        c = pcComment comment in
     pairs (
          "file" .= posFile start
       <> "line" .= posLine start
@@ -60,8 +66,8 @@ instance ToJSON (PositionedComment) where
       <> "column" .= posColumn start
       <> "endColumn" .= posColumn end
       <> "level" .= severityText comment
-      <> "code" .= code
-      <> "message" .= string
+      <> "code" .= cCode c
+      <> "message" .= cMessage c
     )
 
 outputError file msg = hPutStrLn stderr $ file ++ ": " ++ msg

src/ShellCheck/Interface.hs

@@ -17,7 +17,39 @@
     You should have received a copy of the GNU General Public License
     along with this program.  If not, see <https://www.gnu.org/licenses/>.
 -}
-module ShellCheck.Interface where
+module ShellCheck.Interface
+    (
+    SystemInterface(..)
+    , CheckSpec(csFilename, csScript, csCheckSourced, csExcludedWarnings, csShellTypeOverride, csMinSeverity)
+    , CheckResult(crFilename, crComments)
+    , ParseSpec(psFilename, psScript, psCheckSourced, psShellTypeOverride)
+    , ParseResult(prComments, prTokenPositions, prRoot)
+    , AnalysisSpec(asScript, asShellType, asExecutionMode, asCheckSourced)
+    , AnalysisResult(arComments)
+    , FormatterOptions(foColorOption)
+    , Shell(Ksh, Sh, Bash, Dash)
+    , ExecutionMode(Executed, Sourced)
+    , ErrorMessage
+    , Code
+    , Severity(ErrorC, WarningC, InfoC, StyleC)
+    , Position(posFile, posLine, posColumn)
+    , Comment(cSeverity, cCode, cMessage)
+    , PositionedComment(pcStartPos , pcEndPos , pcComment)
+    , ColorOption(ColorAuto, ColorAlways, ColorNever)
+    , TokenComment(tcId, tcComment)
+    , emptyCheckResult
+    , newParseResult
+    , newAnalysisSpec
+    , newAnalysisResult
+    , newFormatterOptions
+    , newPosition
+    , newTokenComment
+    , mockedSystemInterface
+    , newParseSpec
+    , emptyCheckSpec
+    , newPositionedComment
+    , newComment
+    ) where
 
 import ShellCheck.AST
 import Control.Monad.Identity
@@ -44,6 +76,12 @@ data CheckResult = CheckResult {
     crComments :: [PositionedComment]
 } deriving (Show, Eq)
 
+emptyCheckResult :: CheckResult
+emptyCheckResult = CheckResult {
+    crFilename = "",
+    crComments = []
+}
+
 emptyCheckSpec :: CheckSpec
 emptyCheckSpec = CheckSpec {
     csFilename = "",
@@ -76,6 +114,13 @@ data ParseResult = ParseResult {
     prRoot :: Maybe Token
 } deriving (Show, Eq)
 
+newParseResult :: ParseResult
+newParseResult = ParseResult {
+    prComments = [],
+    prTokenPositions = Map.empty,
+    prRoot = Nothing
+}
+
 -- Analyzer input and output
 data AnalysisSpec = AnalysisSpec {
     asScript :: Token,
@@ -84,16 +129,30 @@ data AnalysisSpec = AnalysisSpec {
     asCheckSourced :: Bool
 }
 
+newAnalysisSpec token = AnalysisSpec {
+    asScript = token,
+    asShellType = Nothing,
+    asExecutionMode = Executed,
+    asCheckSourced = False
+}
+
 newtype AnalysisResult = AnalysisResult {
     arComments :: [TokenComment]
 }
 
+newAnalysisResult = AnalysisResult {
+    arComments = []
+}
 
 -- Formatter options
 newtype FormatterOptions = FormatterOptions {
     foColorOption :: ColorOption
 }
 
+newFormatterOptions = FormatterOptions {
+    foColorOption = ColorAuto
+}
+
 
 -- Supporting data types
 data Shell = Ksh | Sh | Bash | Dash deriving (Show, Eq)
@@ -109,9 +168,48 @@ data Position = Position {
     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 Position Comment deriving (Show, Eq)
-data TokenComment = TokenComment Id Comment deriving (Show, Eq)
+newPosition :: Position
+newPosition = Position {
+    posFile   = "",
+    posLine   = 1,
+    posColumn = 1
+}
+
+data Comment = Comment {
+    cSeverity :: Severity,
+    cCode     :: Code,
+    cMessage  :: String
+} deriving (Show, Eq)
+
+newComment :: Comment
+newComment = Comment {
+    cSeverity = StyleC,
+    cCode     = 0,
+    cMessage  = ""
+}
+
+data PositionedComment = PositionedComment {
+    pcStartPos :: Position,
+    pcEndPos   :: Position,
+    pcComment  :: Comment
+} deriving (Show, Eq)
+
+newPositionedComment :: PositionedComment
+newPositionedComment = PositionedComment {
+    pcStartPos = newPosition,
+    pcEndPos   = newPosition,
+    pcComment  = newComment
+}
+
+data TokenComment = TokenComment {
+    tcId :: Id,
+    tcComment :: Comment
+} deriving (Show, Eq)
+
+newTokenComment = TokenComment {
+    tcId = Id 0,
+    tcComment = newComment
+}
 
 data ColorOption =
     ColorAuto

src/ShellCheck/Parser.hs

@@ -3051,11 +3051,11 @@ debugParseScript string =
     result {
         -- Remove the noisiest parts
         prTokenPositions = Map.fromList [
-            (Id 0, (Position {
+            (Id 0, (newPosition {
                 posFile = "removed for clarity",
                 posLine = -1,
                 posColumn = -1
-            }, Position {
+            }, newPosition {
                 posFile = "removed for clarity",
                 posLine = -1,
                 posColumn = -1
@@ -3144,14 +3144,14 @@ parseShell env name contents = do
     (result, state) <- runParser env (parseWithNotes readScript) name contents
     case result of
         Right (script, userstate) ->
-            return ParseResult {
+            return newParseResult {
                 prComments = map toPositionedComment $ nub $ parseNotes userstate ++ parseProblems state,
                 prTokenPositions = Map.map startEndPosToPos (positionMap userstate),
                 prRoot = Just $
                     reattachHereDocs script (hereDocMap userstate)
             }
         Left err ->
-            return ParseResult {
+            return newParseResult {
                 prComments =
                     map toPositionedComment $
                         notesForContext (contextStack state)
@@ -3218,10 +3218,18 @@ reattachHereDocs root map =
 
 toPositionedComment :: ParseNote -> PositionedComment
 toPositionedComment (ParseNote start end severity code message) =
-    PositionedComment (posToPos start) (posToPos end) $ Comment severity code message
+    newPositionedComment {
+        pcStartPos = (posToPos start)
+      , pcEndPos = (posToPos end)
+      , pcComment = newComment {
+          cSeverity = severity
+        , cCode = code
+        , cMessage = message
+      }
+    }
 
 posToPos :: SourcePos -> Position
-posToPos sp = Position {
+posToPos sp = newPosition {
     posFile = sourceName sp,
     posLine = fromIntegral $ sourceLine sp,
     posColumn = fromIntegral $ sourceColumn sp