{-

This file contains useful functions for debugging and developing ShellCheck.

To invoke them interactively, run:

    cabal repl

At the ghci prompt, enter:

    :load ShellCheck.Debug

You can now invoke the functions. Here are some examples:

    shellcheckString "echo $1"
    stringToAst "(( x+1 ))"
    stringToCfg "if foo; then bar; else baz; fi"
    writeFile "/tmp/test.dot" $ stringToCfgViz "while foo; do bar; done"

The latter file can be rendered to png with GraphViz:

    dot -Tpng /tmp/test.dot > /tmp/test.png

To run all unit tests in a module:

    ShellCheck.Parser.runTests
    ShellCheck.Analytics.runTests

To run a specific test:

    :load ShellCheck.Analytics
    prop_checkUuoc3

If you make code changes, reload in seconds at any time with:

    :r

===========================================================================

Crash course in printf debugging in Haskell:

    import Debug.Trace

    greet 0 = return ()
    -- Print when a function is invoked
    greet n | trace ("calling greet " ++ show n) False = undefined
    greet n = do
        putStrLn "Enter name"
        name <- getLine
        -- Print at some point in any monadic function
        traceM $ "user entered " ++ name
        putStrLn $ "Hello " ++ name
        -- Print a value before passing it on
        greet $ traceShowId (n - 1)


===========================================================================

If you want to invoke `ghci` directly, such as on `shellcheck.hs`, to
debug all of ShellCheck including I/O, you may see an error like this:

    src/ShellCheck/Data.hs:5:1: error:
        Could not load module ‘Paths_ShellCheck’
    it is a hidden module in the package ‘ShellCheck-0.8.0’

This can easily be circumvented by running `./setgitversion` or manually
editing src/ShellCheck/Data.hs to replace the auto-deduced version number
with a constant string as indicated.

Afterwards, you can run the ShellCheck tool, as if from the shell, with:

    $ ghci shellcheck.hs
    ghci> runMain ["-x", "file.sh"]

-}

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


-- Run all of ShellCheck (minus output formatters)
shellcheckString :: String -> CheckResult
shellcheckString :: String -> CheckResult
shellcheckString String
scriptString =
    Identity CheckResult -> CheckResult
forall a. Identity a -> a
runIdentity (Identity CheckResult -> CheckResult)
-> Identity CheckResult -> CheckResult
forall a b. (a -> b) -> a -> b
$ SystemInterface Identity -> CheckSpec -> Identity CheckResult
forall (m :: * -> *).
Monad m =>
SystemInterface m -> CheckSpec -> m CheckResult
checkScript SystemInterface Identity
dummySystemInterface CheckSpec
checkSpec
  where
    checkSpec :: CheckSpec
    checkSpec :: CheckSpec
checkSpec = CheckSpec
emptyCheckSpec {
        csScript = scriptString
    }

dummySystemInterface :: SystemInterface Identity
dummySystemInterface :: SystemInterface Identity
dummySystemInterface = [(String, String)] -> SystemInterface Identity
mockedSystemInterface [
    -- A tiny, fake filesystem for sourced files
    (String
"lib/mylib1.sh", String
"foo=$(cat $1 | wc -l)"),
    (String
"lib/mylib2.sh", String
"bar=42")
    ]

-- Parameters used when generating Control Flow Graphs
cfgParams :: CFGParameters
cfgParams :: CFGParameters
cfgParams = CFGParameters {
    cfLastpipe :: Bool
cfLastpipe = Bool
False,
    cfPipefail :: Bool
cfPipefail = Bool
False
}

-- An example script to play with
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"
    ]

-- Parse the script string into ShellCheck's ParseResult
parseScriptString :: String -> ParseResult
parseScriptString :: String -> ParseResult
parseScriptString String
scriptString =
    Identity ParseResult -> ParseResult
forall a. Identity a -> a
runIdentity (Identity ParseResult -> ParseResult)
-> Identity ParseResult -> ParseResult
forall a b. (a -> b) -> a -> b
$ SystemInterface Identity -> ParseSpec -> Identity ParseResult
forall (m :: * -> *).
Monad m =>
SystemInterface m -> ParseSpec -> m ParseResult
parseScript SystemInterface Identity
dummySystemInterface ParseSpec
parseSpec
  where
    parseSpec :: ParseSpec
    parseSpec :: ParseSpec
parseSpec = ParseSpec
newParseSpec {
        psFilename = "myscript",
        psScript = scriptString
    }


-- Parse the script string into an Abstract Syntax Tree
stringToAst :: String -> Token
stringToAst :: String -> Token
stringToAst String
scriptString =
    case Maybe Token
maybeRoot of
        Just Token
root -> Token
root
        Maybe Token
Nothing -> String -> Token
forall a. HasCallStack => String -> a
error (String -> Token) -> String -> Token
forall a b. (a -> b) -> a -> b
$ String
"Script failed to parse: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [PositionedComment] -> String
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 (CFGResult -> CFGraph) -> (Token -> CFGResult) -> Token -> CFGraph
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token -> CFGResult
astToCfgResult

stringToCfg :: String -> CFGraph
stringToCfg :: String -> CFGraph
stringToCfg = Token -> CFGraph
astToCfg (Token -> CFGraph) -> (String -> Token) -> String -> CFGraph
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Token
stringToAst

stringToDfa :: String -> CFGAnalysis
stringToDfa :: String -> CFGAnalysis
stringToDfa = Token -> CFGAnalysis
astToDfa (Token -> CFGAnalysis)
-> (String -> Token) -> String -> CFGAnalysis
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 LNode CFNode -> String
forall a. Show a => a -> String
show

stringToCfgViz :: String -> String
stringToCfgViz :: String -> String
stringToCfgViz = CFGraph -> String
cfgToGraphViz (CFGraph -> String) -> (String -> CFGraph) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> CFGraph
stringToCfg

stringToDfaViz :: String -> String
stringToDfaViz :: String -> String
stringToDfaViz = CFGAnalysis -> String
dfaToGraphViz (CFGAnalysis -> String)
-> (String -> CFGAnalysis) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> CFGAnalysis
stringToDfa

-- Dump a Control Flow Graph as GraphViz with extended information
stringToDetailedCfgViz :: String -> String
stringToDetailedCfgViz :: String -> String
stringToDetailedCfgViz String
scriptString = (LNode CFNode -> String) -> CFGraph -> String
cfgToGraphVizWith LNode CFNode -> String
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 = [(Id, Token)] -> Map Id Token
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Id, Token)] -> Map Id Token) -> [(Id, Token)] -> Map Id Token
forall a b. (a -> b) -> a -> b
$ Writer [(Id, Token)] Token -> [(Id, Token)]
forall w a. Writer w a -> w
execWriter (Writer [(Id, Token)] Token -> [(Id, Token)])
-> Writer [(Id, Token)] Token -> [(Id, Token)]
forall a b. (a -> b) -> a -> b
$ (Token -> WriterT [(Id, Token)] Identity ())
-> Token -> Writer [(Id, Token)] Token
forall (m :: * -> *).
Monad m =>
(Token -> m ()) -> Token -> m Token
doAnalysis (\Token
c -> [(Id, Token)] -> WriterT [(Id, Token)] Identity ()
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 =
        (Set Id -> Set Id -> Set Id) -> [(Int, Set Id)] -> Map Int (Set Id)
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith Set Id -> Set Id -> Set Id
forall a. Ord a => Set a -> Set a -> Set a
S.union ([(Int, Set Id)] -> Map Int (Set Id))
-> [(Int, Set Id)] -> Map Int (Set Id)
forall a b. (a -> b) -> a -> b
$
            ((Id, (Int, Int)) -> (Int, Set Id))
-> [(Id, (Int, Int))] -> [(Int, Set Id)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Id
id, (Int
start, Int
_)) -> (Int
start, Id -> Set Id
forall a. a -> Set a
S.singleton Id
id)) ([(Id, (Int, Int))] -> [(Int, Set Id)])
-> [(Id, (Int, Int))] -> [(Int, Set Id)]
forall a b. (a -> b) -> a -> b
$
                Map Id (Int, Int) -> [(Id, (Int, Int))]
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 =
        (Set Id -> Set Id -> Set Id) -> [(Int, Set Id)] -> Map Int (Set Id)
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith Set Id -> Set Id -> Set Id
forall a. Ord a => Set a -> Set a -> Set a
S.union ([(Int, Set Id)] -> Map Int (Set Id))
-> [(Int, Set Id)] -> Map Int (Set Id)
forall a b. (a -> b) -> a -> b
$
            ((Id, (Int, Int)) -> (Int, Set Id))
-> [(Id, (Int, Int))] -> [(Int, Set Id)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Id
id, (Int
_, Int
end)) -> (Int
end, Id -> Set Id
forall a. a -> Set a
S.singleton Id
id)) ([(Id, (Int, Int))] -> [(Int, Set Id)])
-> [(Id, (Int, Int))] -> [(Int, Set Id)]
forall a b. (a -> b) -> a -> b
$
                Map Id (Int, Int) -> [(Id, (Int, Int))]
forall k a. Map k a -> [(k, a)]
M.toList Map Id (Int, Int)
idToNode

    formatId :: Id -> String
    formatId :: Id -> String
formatId Id
id = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe (String
"Unknown " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Id -> String
forall a. Show a => a -> String
show Id
id) (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ do
        (OuterToken Id
_ InnerToken Token
token) <- Id -> Map Id Token -> Maybe 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 (InnerToken Token -> String
forall a. Show a => a -> String
show InnerToken Token
token) [String] -> Int -> Maybe String
forall {a}. [a] -> Int -> Maybe a
!!! Int
0
        -- Strip off "Inner_"
        (Char
_ : String
tokenName) <- String -> Maybe String
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'_') String
firstWord
        String -> Maybe String
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
tokenName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Id -> String
forall a. Show a => a -> String
show Id
id

    formatGroup :: S.Set Id -> String
    formatGroup :: Set Id -> String
formatGroup Set Id
set = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (Id -> String) -> [Id] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Id -> String
formatId ([Id] -> [String]) -> [Id] -> [String]
forall a b. (a -> b) -> a -> b
$ Set Id -> [Id]
forall a. Set a -> [a]
S.toList Set Id
set

    nodeLabel :: (Int, a) -> String
nodeLabel (Int
node, a
label) = [String] -> String
unlines [
        Int -> String
forall a. Show a => a -> String
show Int
node String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
". " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
label,
        String
"Begin: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Set Id -> String
formatGroup (Set Id -> Int -> Map Int (Set Id) -> Set Id
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault Set Id
forall a. Set a
S.empty Int
node Map Int (Set Id)
nodeToStartIds),
        String
"End: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Set Id -> String
formatGroup (Set Id -> Int -> Map Int (Set Id) -> Set Id
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault Set Id
forall a. Set a
S.empty Int
node Map Int (Set Id)
nodeToEndIds)
        ]


-- Dump a Control Flow Graph with Data Flow Analysis as GraphViz
dfaToGraphViz :: CF.CFGAnalysis -> String
dfaToGraphViz :: CFGAnalysis -> String
dfaToGraphViz CFGAnalysis
analysis = (LNode CFNode -> String) -> CFGraph -> String
cfgToGraphVizWith LNode CFNode -> String
forall {a}. Show a => (Int, a) -> String
label (CFGraph -> String) -> CFGraph -> String
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 = Int -> String
forall a. Show a => a -> String
show Int
node String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
". " String -> String -> String
forall a. [a] -> [a] -> [a]
++ b -> String
forall a. Show a => a -> String
show b
label
        in
            String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe (String
"No DFA available\n\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
desc) (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ do
                (ProgramState
pre, ProgramState
post) <- Int
-> Map Int (ProgramState, ProgramState)
-> Maybe (ProgramState, ProgramState)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Int
node (Map Int (ProgramState, ProgramState)
 -> Maybe (ProgramState, ProgramState))
-> Map Int (ProgramState, ProgramState)
-> Maybe (ProgramState, ProgramState)
forall a b. (a -> b) -> a -> b
$ CFGAnalysis -> Map Int (ProgramState, ProgramState)
CF.nodeToData CFGAnalysis
analysis
                String -> Maybe String
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [
                    String
"Precondition: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ProgramState -> String
forall a. Show a => a -> String
show ProgramState
pre,
                    String
"",
                    String
desc,
                    String
"",
                    String
"Postcondition: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ProgramState -> String
forall a. Show a => a -> String
show ProgramState
post
                    ]


-- Dump an Control Flow Graph to GraphViz with a given node formatter
cfgToGraphVizWith :: (LNode CFNode -> String) -> CFGraph -> String
cfgToGraphVizWith :: (LNode CFNode -> String) -> CFGraph -> String
cfgToGraphVizWith LNode CFNode -> String
nodeLabel CFGraph
graph = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
    String
"digraph {\n",
    (LNode CFNode -> String) -> [LNode CFNode] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap LNode CFNode -> String
dumpNode (CFGraph -> [LNode CFNode]
forall a b. Gr a b -> [LNode a]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LNode a]
labNodes CFGraph
graph),
    ((Int, Int, CFEdge) -> String) -> [(Int, Int, CFEdge)] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int, Int, CFEdge) -> String
forall {a} {a}. (Show a, Show a) => (a, a, CFEdge) -> String
dumpLink (CFGraph -> [(Int, Int, CFEdge)]
forall a b. Gr a b -> [LEdge b]
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) = Int -> String
forall a. Show a => a -> String
show Int
node String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" [label=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
quoteViz (LNode CFNode -> String
nodeLabel LNode CFNode
l) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]\n"
    dumpLink :: (a, a, CFEdge) -> String
dumpLink (a
from, a
to, CFEdge
typ) = a -> String
forall a. Show a => a -> String
show a
from String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" -> " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
to String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" [style=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
quoteViz (CFEdge -> String
edgeStyle CFEdge
typ)  String -> String -> String
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
"\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
escapeViz String
str String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\""
escapeViz :: String -> String
escapeViz [] = []
escapeViz (Char
c:String
rest) =
    case Char
c of
        Char
'\"' -> Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'\"' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
escapeViz String
rest
        Char
'\n' -> Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'l' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
escapeViz String
rest
        Char
'\\' -> Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
escapeViz String
rest
        Char
_ -> Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
escapeViz String
rest


-- Dump an Abstract Syntax Tree (or branch thereof) to GraphViz format
astToGraphViz :: Token -> String
astToGraphViz :: Token -> String
astToGraphViz Token
token = [String] -> String
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 = ([Int], String) -> String
forall a b. (a, b) -> b
snd (([Int], String) -> String) -> ([Int], String) -> String
forall a b. (a -> b) -> a -> b
$ RWS () String [Int] Token -> () -> [Int] -> ([Int], String)
forall r w s a. RWS r w s a -> r -> s -> (s, w)
execRWS ((Token -> RWST () String [Int] Identity ())
-> (Token -> RWST () String [Int] Identity ())
-> Token
-> RWS () String [Int] Token
forall (m :: * -> *).
Monad m =>
(Token -> m ()) -> (Token -> m ()) -> Token -> m Token
doStackAnalysis Token -> RWST () String [Int] Identity ()
push Token -> RWST () String [Int] Identity ()
pop Token
t) () []

    push :: Token -> RWS () String [Int] ()
    push :: Token -> RWST () String [Int] Identity ()
push (OuterToken (Id Int
n) InnerToken Token
inner) = do
        [Int]
stack <- RWST () String [Int] Identity [Int]
forall s (m :: * -> *). MonadState s m => m s
get
        [Int] -> RWST () String [Int] Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Int
n Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
stack)
        case [Int]
stack of
            [] -> () -> RWST () String [Int] Identity ()
forall a. a -> RWST () String [Int] Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            (Int
top:[Int]
_) -> String -> RWST () String [Int] Identity ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (String -> RWST () String [Int] Identity ())
-> String -> RWST () String [Int] Identity ()
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
top String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" -> " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"
        String -> RWST () String [Int] Identity ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (String -> RWST () String [Int] Identity ())
-> String -> RWST () String [Int] Identity ()
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" [label=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
quoteViz (Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
32 (InnerToken Token -> String
forall a. Show a => a -> String
show InnerToken Token
inner)) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]\n"

    pop :: Token -> RWS () String [Int] ()
    pop :: Token -> RWST () String [Int] Identity ()
pop Token
_ = ([Int] -> [Int]) -> RWST () String [Int] Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify [Int] -> [Int]
forall a. HasCallStack => [a] -> [a]
tail


-- For each entry point, set the rank so that they'll align in the graph
tagVizEntries :: CFGraph -> String
tagVizEntries :: CFGraph -> String
tagVizEntries CFGraph
graph = String
"{ rank=same " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
rank String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" }"
  where
    entries :: [(Int, String)]
entries = (LNode CFNode -> Maybe (Int, String))
-> [LNode CFNode] -> [(Int, String)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe LNode CFNode -> Maybe (Int, String)
forall {a}. (a, CFNode) -> Maybe (a, String)
find ([LNode CFNode] -> [(Int, String)])
-> [LNode CFNode] -> [(Int, String)]
forall a b. (a -> b) -> a -> b
$ CFGraph -> [LNode CFNode]
forall a b. Gr a b -> [LNode a]
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) = (a, String) -> Maybe (a, String)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
node, String
name)
    find (a, CFNode)
_ = Maybe (a, String)
forall a. Maybe a
Nothing
    rank :: String
rank = [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ ((Int, String) -> String) -> [(Int, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
c, String
_) -> Int -> String
forall a. Show a => a -> String
show Int
c) [(Int, String)]
entries