|
definition:
|
printState :: IOptions -> State -> IO ()
printState opts st = do
when (verb > 2) $ putStr $ unlines
[ "RAW GRAPH : " ++ show (graph st)
, "TASKS : " ++ show tsks
]
when (showAllExps opts) $ putStr $ unlines $
"ALL EXPRESSIONS:" : map (showGraphExp (graph st)) (rootsOfState st)
when (verb == 1) $ case tsks of
[] -> putStrLn "NO TASK"
tsk:_ -> putStr $ unlines $
[ "CURRENT EXPR: " ++ showGraphExp (graph st) (rootOfTask tsk) ]
when (verb > 1) $
case tsks of
[] -> putStrLn "NO TASK"
tsk@(Task ctrl _ fp) : _ -> putStr $ unlines $
[ "CURRENT TASK:"
, "MAIN EXPR : " ++ showGraphExp (graph st) (rootOfTask tsk) ] ++
if verb > 2 then [ "CONTROL : " ++ showControl ctrl
, "FINGER PRINT: " ++ show fp ]
else []
when (withGraph opts > 0 ||
not (null (optOutput (icOptions opts)))) $ showStateGraph
when (waitTime opts > 0 && not (optInteractive (icOptions opts))) $
sleep (waitTime opts)
when (verb > 1) $ putStrLn ""
where
verb = optVerb (icOptions opts)
tsks = tasks st
showControl (CNode nid) = "NODE: " ++ show nid
showControl (IBlockEnv b e) = "BLOCK: " ++ show b ++
"\n ENV: " ++ show e
-- Visualize the graph contained in the current state as a dot graph.
showStateGraph = do
let ndcolors =
(if null tsks then id
else markCurrent (currentNodeOfTask (head tsks)))
(map (\ (i,t) -> (rootOfTask t,
[("color",if i==1 then "red" else "blue")]))
(zip [1..] tsks)) ++
map (\n -> (n,[("color","green"),("style","filled")])) (results st)
viewDot Nothing (stepNum opts)
(graphToDot (graph st) ndcolors (withGraph opts > 2)
(withGraph opts > 1))
where
markCurrent cn [] = [(cn, yellowFill)]
markCurrent cn ((nid,nas) : ncs)
| nid == cn = (nid, nas ++ yellowFill) : ncs
| otherwise = (nid, nas): markCurrent cn ncs
yellowFill = [("fillcolor","yellow"),("style","filled")]
|