{-# OPTIONS_GHC -F -pgmF htfpp #-}
{-# OPTIONS_HADDOCK prune #-}
{-# LANGUAGE TemplateHaskell #-}

module Striot.VizGraph ( streamGraphToDot
                       , displayGraph
                       , displayGraph'
                       , displayGraphKitty
                       , displayGraphDebug
                       , displayPartitionedGraph
                       , jacksonGraphToDot
                       , partitionedGraphToDot
                       , subGraphToPartition
                       , writeGraph

                       , htf_thisModulesTests) where

import Striot.StreamGraph
import Striot.CompileIoT
import Striot.Jackson
import Algebra.Graph
import Algebra.Graph.Export.Dot
import Data.String
import Test.Framework
import Data.List (intercalate)
import Data.List.Split
import Language.Haskell.TH

import System.Process
import System.IO (openTempFile, hPutStr, hGetContents, hClose)

------------------------------------------------------------------------------
-- main functions

streamGraphToDot :: StreamGraph -> String
streamGraphToDot :: Graph StreamVertex -> String
streamGraphToDot = Style StreamVertex String -> Graph StreamVertex -> String
forall s a g.
(IsString s, Monoid s, Ord a, ToGraph g, ToVertex g ~ a) =>
Style a s -> g -> s
export Style StreamVertex String
myStyle

-- | display a graph using GraphViz and "display" from ImageMagick
displayGraph :: StreamGraph -> IO ()
displayGraph :: Graph StreamVertex -> IO ()
displayGraph = (Graph StreamVertex -> String) -> Graph StreamVertex -> IO ()
forall {t}. (t -> String) -> t -> IO ()
displayGraph' Graph StreamVertex -> String
streamGraphToDot

-- | display a graph by applying a provided converter to the supplied
-- StreamGraph
displayGraph' :: (t -> String) -> t -> IO ()
displayGraph' t -> String
toDot t
g = do
    (Just Handle
hin,Just Handle
hout,Maybe Handle
_, ProcessHandle
_) <- CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess (String -> [String] -> CreateProcess
proc String
"dot" [String
"-Tpng"])
      { std_out :: StdStream
std_out = StdStream
CreatePipe, std_in :: StdStream
std_in = StdStream
CreatePipe }
    (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
_ <- CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess (String -> [String] -> CreateProcess
proc String
"display" []){ std_in :: StdStream
std_in = Handle -> StdStream
UseHandle Handle
hout }

    Handle -> String -> IO ()
hPutStr Handle
hin (t -> String
toDot t
g)
    Handle -> IO ()
hClose Handle
hin

-- | display a graph inline in the Kitty terminal emulator
displayGraphKitty :: StreamGraph -> IO ()
displayGraphKitty :: Graph StreamVertex -> IO ()
displayGraphKitty Graph StreamVertex
g = do
    (Just Handle
hin, Just Handle
hout, Maybe Handle
_, ProcessHandle
_)   <- CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess (String -> [String] -> CreateProcess
proc String
"dot" [String
"-Tpng"])
      { std_out :: StdStream
std_out = StdStream
CreatePipe, std_in :: StdStream
std_in = StdStream
CreatePipe }
    (Maybe Handle
_, Just Handle
hout2, Maybe Handle
_, ProcessHandle
_) <- CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess (String -> [String] -> CreateProcess
proc String
"base64" [String
"-w0"])
      { std_in :: StdStream
std_in = Handle -> StdStream
UseHandle Handle
hout , std_out :: StdStream
std_out = StdStream
CreatePipe }

    Handle -> String -> IO ()
hPutStr Handle
hin (Graph StreamVertex -> String
streamGraphToDot Graph StreamVertex
g)
    Handle -> IO ()
hClose Handle
hin
    String
foo <- Handle -> IO String
hGetContents Handle
hout2
    let bar :: [String]
bar = Int -> String -> [String]
forall e. Int -> [e] -> [[e]]
chunksOf Int
4096 String
foo
    (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\String
c -> String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"\ESC_Gf=100,a=T,m=1;" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\ESC\\") ([String] -> [String]
forall a. [a] -> [a]
init [String]
bar)
    String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"\ESC_Gf=100,a=T,m=0;" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ([String] -> String
forall a. [a] -> a
last [String]
bar) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\ESC\\"

-- | display a debug graph using GraphViz and ImageMagick
displayGraphDebug :: Graph StreamVertex -> IO ()
displayGraphDebug = (Graph StreamVertex -> String) -> Graph StreamVertex -> IO ()
forall {t}. (t -> String) -> t -> IO ()
displayGraph' (Style StreamVertex String -> Graph StreamVertex -> String
forall s a g.
(IsString s, Monoid s, Ord a, ToGraph g, ToVertex g ~ a) =>
Style a s -> g -> s
export Style StreamVertex String
debugStyle :: StreamGraph -> String)
debugStyle :: Style StreamVertex String
debugStyle        = Style StreamVertex String
myStyle { vertexAttributes :: StreamVertex -> [Attribute String]
vertexAttributes = (\StreamVertex
v -> [String
"label"String -> String -> Attribute String
forall s. s -> s -> Attribute s
:=(String -> String
doubleQuotes (String -> String)
-> (StreamVertex -> String) -> StreamVertex -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
escape (String -> String)
-> (StreamVertex -> String) -> StreamVertex -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamVertex -> String
forall a. Show a => a -> String
show) StreamVertex
v]) }
    where doubleQuotes :: String -> String
doubleQuotes String
v = String
"\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\""

-- | display a `PartitionedGraph` using GraphViz and "display" from ImageMagick
displayPartitionedGraph :: PartitionedGraph -> IO ()
displayPartitionedGraph :: PartitionedGraph -> IO ()
displayPartitionedGraph = (PartitionedGraph -> String) -> PartitionedGraph -> IO ()
forall {t}. (t -> String) -> t -> IO ()
displayGraph' PartitionedGraph -> String
partitionedGraphToDot

-- | Convert a `StreamGraph` into a GraphViz representation, including
-- parameters derived from queueing theory/Jackson
jacksonGraphToDot :: StreamGraph -> String
jacksonGraphToDot :: Graph StreamVertex -> String
jacksonGraphToDot Graph StreamVertex
graph = let
    jackson :: [(Int, OperatorInfo)]
jackson = (OperatorInfo -> (Int, OperatorInfo))
-> [OperatorInfo] -> [(Int, OperatorInfo)]
forall a b. (a -> b) -> [a] -> [b]
map (\OperatorInfo
oi -> (OperatorInfo -> Int
opId OperatorInfo
oi, OperatorInfo
oi)) (Graph StreamVertex -> [OperatorInfo]
calcAllSg Graph StreamVertex
graph) -- (Int, [OperatorInfo])

    style :: Style StreamVertex String
style = Style StreamVertex String
myStyle
      { edgeAttributes :: StreamVertex -> StreamVertex -> [Attribute String]
edgeAttributes   = (\StreamVertex
i StreamVertex
_ -> [ String
"label" String -> String -> Attribute String
forall s. s -> s -> Attribute s
:= [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
"<<SUP>"
                                                        , Double -> String
forall a. Show a => a -> String
show (Graph StreamVertex -> Int -> Double
outputRate Graph StreamVertex
graph (StreamVertex -> Int
vertexId StreamVertex
i))
                                                        , String
"</SUP>/<SUB>s</SUB> <I>:: "
                                                        , StreamVertex -> String
outtype StreamVertex
i
                                                        , String
"</I>>" ]])

      , vertexAttributes :: StreamVertex -> [Attribute String]
vertexAttributes = (\StreamVertex
v -> [ String
"label"     String -> String -> Attribute String
forall s. s -> s -> Attribute s
:=((String
"<"String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String)
-> (StreamVertex -> String) -> StreamVertex -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String -> String
forall a. [a] -> [a] -> [a]
++String
">") (String -> String)
-> (StreamVertex -> String) -> StreamVertex -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamVertex -> String
show') StreamVertex
v
                                  , String
"xlabel"    String -> String -> Attribute String
forall s. s -> s -> Attribute s
:= StreamVertex -> String
srvRate StreamVertex
v
                                  , String
"fontsize"String -> String -> Attribute String
forall s. s -> s -> Attribute s
:=String
"18"
                                  , String
"fillcolor" String -> String -> Attribute String
forall s. s -> s -> Attribute s
:= if   StreamVertex -> Bool
overUt StreamVertex
v
                                                   then String
"\"#ffcccc\""
                                                   else String
"\"#ffffff\"" ])
      }

    arr :: StreamVertex -> String
arr StreamVertex
v = case Int -> [(Int, OperatorInfo)] -> Maybe OperatorInfo
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (StreamVertex -> Int
vertexId StreamVertex
v) [(Int, OperatorInfo)]
jackson of
        Maybe OperatorInfo
Nothing -> String
"?"
        Just OperatorInfo
oi -> Double -> String
forall a. Show a => a -> String
show (OperatorInfo -> Double
arrRate OperatorInfo
oi) -- This is invalid for merge/join where arrrate is combined not from one node

    srvRate :: StreamVertex -> String
srvRate StreamVertex
v = case StreamVertex -> Double
Striot.StreamGraph.serviceTime StreamVertex
v of
        Double
0 -> String
"<>" -- effectively undefined/not useful
        Double
t -> String -> String
wrap (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show (Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
t)
        where wrap :: String -> String
wrap String
s = String
"<<SUP>"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
sString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"</SUP>/<SUB>s</SUB>>"

    overUt :: StreamVertex -> Bool
overUt StreamVertex
v = case Int -> [(Int, OperatorInfo)] -> Maybe OperatorInfo
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (StreamVertex -> Int
vertexId StreamVertex
v) [(Int, OperatorInfo)]
jackson of
        Maybe OperatorInfo
Nothing -> Bool
False
        Just OperatorInfo
oi -> OperatorInfo -> Double
util OperatorInfo
oi Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
1

    in Style StreamVertex String -> Graph StreamVertex -> String
forall s a g.
(IsString s, Monoid s, Ord a, ToGraph g, ToVertex g ~ a) =>
Style a s -> g -> s
export Style StreamVertex String
style Graph StreamVertex
graph

-- | Convert `PartitionedGraph` into a GraphViz representation,
-- with each sub-graph separately delineated,
-- encoded in a `String`.
partitionedGraphToDot :: PartitionedGraph -> String
partitionedGraphToDot :: PartitionedGraph -> String
partitionedGraphToDot pgs :: PartitionedGraph
pgs@([Graph StreamVertex]
ps,Graph StreamVertex
cuts) = let
    graph :: Graph StreamVertex
graph = [Graph StreamVertex] -> Graph StreamVertex
forall a. [Graph a] -> Graph a
overlays (Graph StreamVertex
cutsGraph StreamVertex -> [Graph StreamVertex] -> [Graph StreamVertex]
forall a. a -> [a] -> [a]
:[Graph StreamVertex]
ps)
    pre :: [String]
pre   = ((Graph StreamVertex, Int) -> String)
-> [(Graph StreamVertex, Int)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((Graph StreamVertex -> Int -> String)
-> (Graph StreamVertex, Int) -> String
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Graph StreamVertex -> Int -> String
subGraphToPartition) ([Graph StreamVertex] -> [Int] -> [(Graph StreamVertex, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Graph StreamVertex]
ps [Int
1..])
    style :: Style StreamVertex String
style = Style StreamVertex String
myStyle
      { preamble :: [String]
preamble = [String]
pre }
    in Style StreamVertex String -> Graph StreamVertex -> String
forall s a g.
(IsString s, Monoid s, Ord a, ToGraph g, ToVertex g ~ a) =>
Style a s -> g -> s
export Style StreamVertex String
style Graph StreamVertex
graph

-- | generate a GraphViz subgraph definition (encoded into a `String`)c
-- corresponding to a StreamGraph and an Int representing a label.
--
-- We place the Partition label at the bottom and offset it with some
-- whitespace to reduce the likelyhood of the label being overdrawn by
-- edges or edge labels.
subGraphToPartition :: StreamGraph -> Int -> String
subGraphToPartition :: Graph StreamVertex -> Int -> String
subGraphToPartition Graph StreamVertex
sg Int
i = let
    n :: String
n = Int -> String
forall a. Show a => a -> String
show Int
i
    ids :: String
ids = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (StreamVertex -> String) -> [StreamVertex] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> String
forall a. Show a => a -> String
show(Int -> String) -> (StreamVertex -> Int) -> StreamVertex -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.StreamVertex -> Int
vertexId) (Graph StreamVertex -> [StreamVertex]
forall a. Ord a => Graph a -> [a]
vertexList Graph StreamVertex
sg)
    in String
"  subgraph cluster"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
nString -> String -> String
forall a. [a] -> [a] -> [a]
++String
" {\n\
    \    color=\"#888888\"\n\
    \    style=\"rounded,dashed\"\n\
    \    labelloc=b\n\
    \    labeljust=r\n\
    \    label=\"Node "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
nString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\"\n\
    \    "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
idsString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\n\
    \  }\n"

-- | Render a graph to a PNG using GraphViz and write it out to the supplied
-- path.
writeGraph :: (t -> String) -> t -> String -> IO ()
writeGraph t -> String
toDot t
g String
path = do
    (Just Handle
hin, Maybe Handle
_, Maybe Handle
_, ProcessHandle
_) <- CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess (String -> [String] -> CreateProcess
proc String
"dot" [String
"-Tpng", String
"-o", String
path])
      { std_in :: StdStream
std_in = StdStream
CreatePipe }
    Handle -> String -> IO ()
hPutStr Handle
hin (t -> String
toDot t
g)
    Handle -> IO ()
hClose Handle
hin

------------------------------------------------------------------------------
-- utility functions

show' :: StreamVertex -> String
show' :: StreamVertex -> String
show' StreamVertex
v = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"<br />\n" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ ((StreamOperator -> String
printOp (StreamOperator -> String)
-> (StreamVertex -> StreamOperator) -> StreamVertex -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamVertex -> StreamOperator
operator) StreamVertex
v)
                          String -> [String] -> [String]
forall a. a -> [a] -> [a]
: ((Q Exp -> String) -> [Q Exp] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String
paren (String -> String) -> (Q Exp -> String) -> Q Exp -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
cleanParam (String -> String) -> (Q Exp -> String) -> Q Exp -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Q Exp -> String
showParam) ([Q Exp] -> [String])
-> (StreamVertex -> [Q Exp]) -> StreamVertex -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamVertex -> [Q Exp]
parameters) StreamVertex
v

printOp :: StreamOperator -> String
printOp :: StreamOperator -> String
printOp (Filter Double
_)        = String
"streamFilter"
printOp (FilterAcc Double
_)     = String
"streamFilterAcc"
printOp (Source Double
_)        = String
"streamSource"
printOp StreamOperator
x                 = String
"stream" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (StreamOperator -> String
forall a. Show a => a -> String
show StreamOperator
x)

paren :: String -> String
paren :: String -> String
paren String
s = Char
'(' Char -> String -> String
forall a. a -> [a] -> [a]
: (String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")")

prop_paren_prefix :: String -> Bool
prop_paren_prefix String
s = String -> Char
forall a. [a] -> a
head (String -> String
paren String
s) Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'('
prop_paren_suffix :: String -> Bool
prop_paren_suffix String
s = String -> Char
forall a. [a] -> a
last (String -> String
paren String
s) Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
')'

-- escape HTML brackets
cleanParam :: String -> String
cleanParam :: String -> String
cleanParam [] = []
cleanParam (Char
x:String
s) | Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'<'  = String
"&lt;"  String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
cleanParam String
s
                 | Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'>'  = String
"&gt;"  String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
cleanParam String
s
                 | Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'&'  = String
"&amp;" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
cleanParam String
s
                 | Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' = String
"<br />\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
cleanParam String
s
                 | Bool
otherwise = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
cleanParam String
s

test_cleanParam_1 :: IO ()
test_cleanParam_1 = String -> String -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
assertEqual String
"no escaping"          (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String
cleanParam String
"no escaping"
test_cleanParam_2 :: IO ()
test_cleanParam_2 = String -> String -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
assertEqual String
"opening &lt; chevron" (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String
cleanParam String
"opening < chevron"
test_cleanParam_3 :: IO ()
test_cleanParam_3 = String -> String -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
assertEqual String
"closing &gt; chevron" (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String
cleanParam String
"closing > chevron"
test_cleanParam_4 :: IO ()
test_cleanParam_4 = String -> String -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
assertEqual String
"ampersand &amp; amp"  (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String
cleanParam String
"ampersand & amp"

myStyle :: Style StreamVertex String
myStyle :: Style StreamVertex String
myStyle = Style :: forall a s.
s
-> [s]
-> [Attribute s]
-> [Attribute s]
-> [Attribute s]
-> (a -> s)
-> (a -> [Attribute s])
-> (a -> a -> [Attribute s])
-> Quoting
-> Style a s
Style
    { graphName :: String
graphName               = String
forall a. Monoid a => a
mempty
    , preamble :: [String]
preamble                = [String]
forall a. Monoid a => a
mempty
    , graphAttributes :: [Attribute String]
graphAttributes         = [String
"bgcolor"String -> String -> Attribute String
forall s. s -> s -> Attribute s
:=String
"white",String
"ratio"String -> String -> Attribute String
forall s. s -> s -> Attribute s
:=String
"compress"]
    , defaultVertexAttributes :: [Attribute String]
defaultVertexAttributes = [String
"shape" String -> String -> Attribute String
forall s. s -> s -> Attribute s
:= String
"box",String
"fillcolor"String -> String -> Attribute String
forall s. s -> s -> Attribute s
:=String
"white",String
"style"String -> String -> Attribute String
forall s. s -> s -> Attribute s
:=String
"filled"]
    , defaultEdgeAttributes :: [Attribute String]
defaultEdgeAttributes   = [String
"weight"String -> String -> Attribute String
forall s. s -> s -> Attribute s
:=String
"10",String
"color"String -> String -> Attribute String
forall s. s -> s -> Attribute s
:=String
"black",String
"fontcolor"String -> String -> Attribute String
forall s. s -> s -> Attribute s
:=String
"black",String
"fontsize"String -> String -> Attribute String
forall s. s -> s -> Attribute s
:=String
"18"]
    , vertexName :: StreamVertex -> String
vertexName              = Int -> String
forall a. Show a => a -> String
show (Int -> String) -> (StreamVertex -> Int) -> StreamVertex -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamVertex -> Int
vertexId
    , vertexAttributes :: StreamVertex -> [Attribute String]
vertexAttributes        = (\StreamVertex
v -> [ String
"label"String -> String -> Attribute String
forall s. s -> s -> Attribute s
:=((String
"<"String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String)
-> (StreamVertex -> String) -> StreamVertex -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String -> String
forall a. [a] -> [a] -> [a]
++String
">") (String -> String)
-> (StreamVertex -> String) -> StreamVertex -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamVertex -> String
show') StreamVertex
v
                                       , String
"fontsize"String -> String -> Attribute String
forall s. s -> s -> Attribute s
:=String
"18"
                                       , String
"shape"String -> String -> Attribute String
forall s. s -> s -> Attribute s
:=String
"box"])
    -- without forcing shape=box, the nodes end up ellipses in PartitionedGraphs
    , edgeAttributes :: StreamVertex -> StreamVertex -> [Attribute String]
edgeAttributes          = (\StreamVertex
_ StreamVertex
o -> [String
"label"String -> String -> Attribute String
forall s. s -> s -> Attribute s
:=(String
"\" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ StreamVertex -> String
intype StreamVertex
o String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\"")])
    , attributeQuoting :: Quoting
attributeQuoting        = Quoting
NoQuotes
    }

-- escape a string, suitable for inclusion inside a double-quoted string in a .dot file
escape :: String -> String
escape [] = []
escape (Char
x:String
xs) = case Char
x of
    Char
'"'  -> Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
'"' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
escape String
xs
    Char
'\\' -> Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
escape String
xs
    Char
_    -> Char
x        Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
escape String
xs

test_escape_1 :: IO ()
test_escape_1 = String -> String -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
assertEqual String
"no escaping"            (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String
escape (String
"no escaping")
test_escape_2 :: IO ()
test_escape_2 = String -> String -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
assertEqual String
"escaped \\\" quote"     (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String
escape (String
"escaped \" quote")
test_escape_3 :: IO ()
test_escape_3 = String -> String -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
assertEqual String
"escaped \\\\ backslash" (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String
escape (String
"escaped \\ backslash")

------------------------------------------------------------------------------
-- test data
pgs   = createPartitions mergeEx [[1,2],[3,4],[5,6]]
pgs'  = createPartitions expandEx [[1,2],[5],[6]]

source x = [| do
    let x' = $(litE (StringL x))
    threadDelay (1000*1000)
    putStrLn "sending '"++x'++"'"
    return x'
    |]

v1 = StreamVertex 1 (Source 1) [source "foo"]    "String" "String" 0
v2 = StreamVertex 2 Map    [[| id |]]        "String" "String" 1
v3 = StreamVertex 3 (Source 1) [source "bar"]    "String" "String" 2
v4 = StreamVertex 4 Map    [[| id |]]        "String" "String" 3
v5 = StreamVertex 5 Merge  []                "[String]" "String" 4
v6 = StreamVertex 6 Sink   [[| mapM_ print|]] "String" "IO ()" 5
mergeEx :: StreamGraph
mergeEx = overlay (path [v3, v4, v5]) (path [v1, v2, v5, v6])

v7 = StreamVertex  1 (Source 1) [[| sourceOfRandomTweets |]] "String" "String" 0
v8 = StreamVertex  2 Map    [[| filter (('#'==).head) . words |]] "String" "[String]" 1
v9 = StreamVertex  5 Expand [] "[String]" "String" 2
v10 = StreamVertex 6 Sink   [[|mapM_ print|]] "String" "IO ()" 3
expandEx :: StreamGraph
expandEx = path [v7, v8, v9, v10]