module ShellCheck.Debug () where
import ShellCheck.Analyzer
import ShellCheck.AST
import ShellCheck.CFG
import ShellCheck.Checker
import ShellCheck.CFGAnalysis as CF
import ShellCheck.Interface
import ShellCheck.Parser
import ShellCheck.Prelude
import Control.Monad
import Control.Monad.Identity
import Control.Monad.RWS
import Control.Monad.Writer
import Data.Graph.Inductive.Graph as G
import Data.List
import Data.Maybe
import qualified Data.Map as M
import qualified Data.Set as S
shellcheckString :: String -> CheckResult
shellcheckString :: String -> CheckResult
shellcheckString String
scriptString =
forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
Monad m =>
SystemInterface m -> CheckSpec -> m CheckResult
checkScript SystemInterface Identity
dummySystemInterface CheckSpec
checkSpec
where
checkSpec :: CheckSpec
checkSpec :: CheckSpec
checkSpec = CheckSpec
emptyCheckSpec {
csScript :: String
csScript = String
scriptString
}
dummySystemInterface :: SystemInterface Identity
dummySystemInterface :: SystemInterface Identity
dummySystemInterface = [(String, String)] -> SystemInterface Identity
mockedSystemInterface [
(String
"lib/mylib1.sh", String
"foo=$(cat $1 | wc -l)"),
(String
"lib/mylib2.sh", String
"bar=42")
]
cfgParams :: CFGParameters
cfgParams :: CFGParameters
cfgParams = CFGParameters {
cfLastpipe :: Bool
cfLastpipe = Bool
False,
cfPipefail :: Bool
cfPipefail = Bool
False
}
exampleScript :: String
exampleScript :: String
exampleScript = [String] -> String
unlines [
String
"#!/bin/sh",
String
"count=0",
String
"for file in *",
String
"do",
String
" (( count++ ))",
String
"done",
String
"echo $count"
]
parseScriptString :: String -> ParseResult
parseScriptString :: String -> ParseResult
parseScriptString String
scriptString =
forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
Monad m =>
SystemInterface m -> ParseSpec -> m ParseResult
parseScript SystemInterface Identity
dummySystemInterface ParseSpec
parseSpec
where
parseSpec :: ParseSpec
parseSpec :: ParseSpec
parseSpec = ParseSpec
newParseSpec {
psFilename :: String
psFilename = String
"myscript",
psScript :: String
psScript = String
scriptString
}
stringToAst :: String -> Token
stringToAst :: String -> Token
stringToAst String
scriptString =
case Maybe Token
maybeRoot of
Just Token
root -> Token
root
Maybe Token
Nothing -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Script failed to parse: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show [PositionedComment]
parserWarnings
where
parseResult :: ParseResult
parseResult :: ParseResult
parseResult = String -> ParseResult
parseScriptString String
scriptString
maybeRoot :: Maybe Token
maybeRoot :: Maybe Token
maybeRoot = ParseResult -> Maybe Token
prRoot ParseResult
parseResult
parserWarnings :: [PositionedComment]
parserWarnings :: [PositionedComment]
parserWarnings = ParseResult -> [PositionedComment]
prComments ParseResult
parseResult
astToCfgResult :: Token -> CFGResult
astToCfgResult :: Token -> CFGResult
astToCfgResult = CFGParameters -> Token -> CFGResult
buildGraph CFGParameters
cfgParams
astToDfa :: Token -> CFGAnalysis
astToDfa :: Token -> CFGAnalysis
astToDfa = CFGParameters -> Token -> CFGAnalysis
analyzeControlFlow CFGParameters
cfgParams
astToCfg :: Token -> CFGraph
astToCfg :: Token -> CFGraph
astToCfg = CFGResult -> CFGraph
cfGraph forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token -> CFGResult
astToCfgResult
stringToCfg :: String -> CFGraph
stringToCfg :: String -> CFGraph
stringToCfg = Token -> CFGraph
astToCfg forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Token
stringToAst
stringToDfa :: String -> CFGAnalysis
stringToDfa :: String -> CFGAnalysis
stringToDfa = Token -> CFGAnalysis
astToDfa forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Token
stringToAst
cfgToGraphViz :: CFGraph -> String
cfgToGraphViz :: CFGraph -> String
cfgToGraphViz = (LNode CFNode -> String) -> CFGraph -> String
cfgToGraphVizWith forall a. Show a => a -> String
show
stringToCfgViz :: String -> String
stringToCfgViz :: String -> String
stringToCfgViz = CFGraph -> String
cfgToGraphViz forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> CFGraph
stringToCfg
stringToDfaViz :: String -> String
stringToDfaViz :: String -> String
stringToDfaViz = CFGAnalysis -> String
dfaToGraphViz forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> CFGAnalysis
stringToDfa
stringToDetailedCfgViz :: String -> String
stringToDetailedCfgViz :: String -> String
stringToDetailedCfgViz String
scriptString = (LNode CFNode -> String) -> CFGraph -> String
cfgToGraphVizWith forall {a}. Show a => (Int, a) -> String
nodeLabel CFGraph
graph
where
ast :: Token
ast :: Token
ast = String -> Token
stringToAst String
scriptString
cfgResult :: CFGResult
cfgResult :: CFGResult
cfgResult = Token -> CFGResult
astToCfgResult Token
ast
graph :: CFGraph
graph :: CFGraph
graph = CFGResult -> CFGraph
cfGraph CFGResult
cfgResult
idToToken :: M.Map Id Token
idToToken :: Map Id Token
idToToken = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ forall w a. Writer w a -> w
execWriter forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
Monad m =>
(Token -> m ()) -> Token -> m Token
doAnalysis (\Token
c -> forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [(Token -> Id
getId Token
c, Token
c)]) Token
ast
idToNode :: M.Map Id (Node, Node)
idToNode :: Map Id (Int, Int)
idToNode = CFGResult -> Map Id (Int, Int)
cfIdToRange CFGResult
cfgResult
nodeToStartIds :: M.Map Node (S.Set Id)
nodeToStartIds :: Map Int (Set Id)
nodeToStartIds =
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith forall a. Ord a => Set a -> Set a -> Set a
S.union forall a b. (a -> b) -> a -> b
$
forall a b. (a -> b) -> [a] -> [b]
map (\(Id
id, (Int
start, Int
_)) -> (Int
start, forall a. a -> Set a
S.singleton Id
id)) forall a b. (a -> b) -> a -> b
$
forall k a. Map k a -> [(k, a)]
M.toList Map Id (Int, Int)
idToNode
nodeToEndIds :: M.Map Node (S.Set Id)
nodeToEndIds :: Map Int (Set Id)
nodeToEndIds =
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith forall a. Ord a => Set a -> Set a -> Set a
S.union forall a b. (a -> b) -> a -> b
$
forall a b. (a -> b) -> [a] -> [b]
map (\(Id
id, (Int
_, Int
end)) -> (Int
end, forall a. a -> Set a
S.singleton Id
id)) forall a b. (a -> b) -> a -> b
$
forall k a. Map k a -> [(k, a)]
M.toList Map Id (Int, Int)
idToNode
formatId :: Id -> String
formatId :: Id -> String
formatId Id
id = forall a. a -> Maybe a -> a
fromMaybe (String
"Unknown " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Id
id) forall a b. (a -> b) -> a -> b
$ do
(OuterToken Id
_ InnerToken Token
token) <- forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Id
id Map Id Token
idToToken
String
firstWord <- String -> [String]
words (forall a. Show a => a -> String
show InnerToken Token
token) forall {a}. [a] -> Int -> Maybe a
!!! Int
0
(Char
_ : String
tokenName) <- forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
/= Char
'_') String
firstWord
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String
tokenName forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Id
id
formatGroup :: S.Set Id -> String
formatGroup :: Set Id -> String
formatGroup Set Id
set = forall a. [a] -> [[a]] -> [a]
intercalate String
", " forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Id -> String
formatId forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
S.toList Set Id
set
nodeLabel :: (Int, a) -> String
nodeLabel (Int
node, a
label) = [String] -> String
unlines [
forall a. Show a => a -> String
show Int
node forall a. [a] -> [a] -> [a]
++ String
". " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
label,
String
"Begin: " forall a. [a] -> [a] -> [a]
++ Set Id -> String
formatGroup (forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault forall a. Set a
S.empty Int
node Map Int (Set Id)
nodeToStartIds),
String
"End: " forall a. [a] -> [a] -> [a]
++ Set Id -> String
formatGroup (forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault forall a. Set a
S.empty Int
node Map Int (Set Id)
nodeToEndIds)
]
dfaToGraphViz :: CF.CFGAnalysis -> String
dfaToGraphViz :: CFGAnalysis -> String
dfaToGraphViz CFGAnalysis
analysis = (LNode CFNode -> String) -> CFGraph -> String
cfgToGraphVizWith forall {a}. Show a => (Int, a) -> String
label forall a b. (a -> b) -> a -> b
$ CFGAnalysis -> CFGraph
CF.graph CFGAnalysis
analysis
where
label :: (Int, b) -> String
label (Int
node, b
label) =
let
desc :: String
desc = forall a. Show a => a -> String
show Int
node forall a. [a] -> [a] -> [a]
++ String
". " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show b
label
in
forall a. a -> Maybe a -> a
fromMaybe (String
"No DFA available\n\n" forall a. [a] -> [a] -> [a]
++ String
desc) forall a b. (a -> b) -> a -> b
$ do
(ProgramState
pre, ProgramState
post) <- forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Int
node forall a b. (a -> b) -> a -> b
$ CFGAnalysis -> Map Int (ProgramState, ProgramState)
CF.nodeToData CFGAnalysis
analysis
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [
String
"Precondition: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ProgramState
pre,
String
"",
String
desc,
String
"",
String
"Postcondition: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ProgramState
post
]
cfgToGraphVizWith :: (LNode CFNode -> String) -> CFGraph -> String
cfgToGraphVizWith :: (LNode CFNode -> String) -> CFGraph -> String
cfgToGraphVizWith LNode CFNode -> String
nodeLabel CFGraph
graph = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
String
"digraph {\n",
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap LNode CFNode -> String
dumpNode (forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LNode a]
labNodes CFGraph
graph),
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {a} {a}. (Show a, Show a) => (a, a, CFEdge) -> String
dumpLink (forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LEdge b]
labEdges CFGraph
graph),
CFGraph -> String
tagVizEntries CFGraph
graph,
String
"}\n"
]
where
dumpNode :: LNode CFNode -> String
dumpNode l :: LNode CFNode
l@(Int
node, CFNode
label) = forall a. Show a => a -> String
show Int
node forall a. [a] -> [a] -> [a]
++ String
" [label=" forall a. [a] -> [a] -> [a]
++ String -> String
quoteViz (LNode CFNode -> String
nodeLabel LNode CFNode
l) forall a. [a] -> [a] -> [a]
++ String
"]\n"
dumpLink :: (a, a, CFEdge) -> String
dumpLink (a
from, a
to, CFEdge
typ) = forall a. Show a => a -> String
show a
from forall a. [a] -> [a] -> [a]
++ String
" -> " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
to forall a. [a] -> [a] -> [a]
++ String
" [style=" forall a. [a] -> [a] -> [a]
++ String -> String
quoteViz (CFEdge -> String
edgeStyle CFEdge
typ) forall a. [a] -> [a] -> [a]
++ String
"]\n"
edgeStyle :: CFEdge -> String
edgeStyle CFEdge
CFEFlow = String
"solid"
edgeStyle CFEdge
CFEExit = String
"bold"
edgeStyle CFEdge
CFEFalseFlow = String
"dotted"
quoteViz :: String -> String
quoteViz String
str = String
"\"" forall a. [a] -> [a] -> [a]
++ String -> String
escapeViz String
str forall a. [a] -> [a] -> [a]
++ String
"\""
escapeViz :: String -> String
escapeViz [] = []
escapeViz (Char
c:String
rest) =
case Char
c of
Char
'\"' -> Char
'\\' forall a. a -> [a] -> [a]
: Char
'\"' forall a. a -> [a] -> [a]
: String -> String
escapeViz String
rest
Char
'\n' -> Char
'\\' forall a. a -> [a] -> [a]
: Char
'l' forall a. a -> [a] -> [a]
: String -> String
escapeViz String
rest
Char
'\\' -> Char
'\\' forall a. a -> [a] -> [a]
: Char
'\\' forall a. a -> [a] -> [a]
: String -> String
escapeViz String
rest
Char
_ -> Char
c forall a. a -> [a] -> [a]
: String -> String
escapeViz String
rest
astToGraphViz :: Token -> String
astToGraphViz :: Token -> String
astToGraphViz Token
token = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
String
"digraph {\n",
Token -> String
formatTree Token
token,
String
"}\n"
]
where
formatTree :: Token -> String
formatTree :: Token -> String
formatTree Token
t = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall r w s a. RWS r w s a -> r -> s -> (s, w)
execRWS (forall (m :: * -> *).
Monad m =>
(Token -> m ()) -> (Token -> m ()) -> Token -> m Token
doStackAnalysis Token -> RWS () String [Int] ()
push Token -> RWS () String [Int] ()
pop Token
t) () []
push :: Token -> RWS () String [Int] ()
push :: Token -> RWS () String [Int] ()
push (OuterToken (Id Int
n) InnerToken Token
inner) = do
[Int]
stack <- forall s (m :: * -> *). MonadState s m => m s
get
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Int
n forall a. a -> [a] -> [a]
: [Int]
stack)
case [Int]
stack of
[] -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
(Int
top:[Int]
_) -> forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int
top forall a. [a] -> [a] -> [a]
++ String
" -> " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n forall a. [a] -> [a] -> [a]
++ String
"\n"
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int
n forall a. [a] -> [a] -> [a]
++ String
" [label=" forall a. [a] -> [a] -> [a]
++ String -> String
quoteViz (forall a. Show a => a -> String
show Int
n forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ forall a. Int -> [a] -> [a]
take Int
32 (forall a. Show a => a -> String
show InnerToken Token
inner)) forall a. [a] -> [a] -> [a]
++ String
"]\n"
pop :: Token -> RWS () String [Int] ()
pop :: Token -> RWS () String [Int] ()
pop Token
_ = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a. [a] -> [a]
tail
tagVizEntries :: CFGraph -> String
tagVizEntries :: CFGraph -> String
tagVizEntries CFGraph
graph = String
"{ rank=same " forall a. [a] -> [a] -> [a]
++ String
rank forall a. [a] -> [a] -> [a]
++ String
" }"
where
entries :: [(Int, String)]
entries = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall {a}. (a, CFNode) -> Maybe (a, String)
find forall a b. (a -> b) -> a -> b
$ forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LNode a]
labNodes CFGraph
graph
find :: (a, CFNode) -> Maybe (a, String)
find (a
node, CFEntryPoint String
name) = forall (m :: * -> *) a. Monad m => a -> m a
return (a
node, String
name)
find (a, CFNode)
_ = forall a. Maybe a
Nothing
rank :: String
rank = [String] -> String
unwords forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(Int
c, String
_) -> forall a. Show a => a -> String
show Int
c) [(Int, String)]
entries