module Control.ERNet.Foundations.Event.JavaScript
(
constructJS
)
where
import Control.ERNet.Foundations.Protocol
import Control.ERNet.Foundations.Event
import Data.Number.ER.ShowHTML
import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.Maybe
import Data.List
--{-|
---}
constructJS ::
[ERNetEvent] ->
String
constructJS events =
unlines [getChildrenJS, getRowJS]
where
processes = mkProcs events
getChildrenJS =
"function getChildren(q){\nvar c = new Array();\nswitch(q){\n" ++
(unlines $ map getChildrenCase processes) ++
"\n};\nreturn c;\n}\n"
getChildrenCase (toN, toName, fromN, fromName, qry, ans, childrenNs) =
"case " ++ show toN ++ ":" ++ (showSetCs childrenNs) ++ "break;"
getRowJS =
"function getRow(q){switch(q){\n" ++
(unlines $ map getRowCase processes) ++
"\n}\n}\n"
getRowCase (toN, toName, fromN, fromName, qry, ans, childrenNs) =
"case " ++ show toN ++ ": return " ++
"ndRef(" ++ show fromN ++ ",\"" ++ fromName ++ "\") + " ++
"\'<td> == <b>Query: </b>" ++ showHTML qry ++ " ==> <br/>" ++
" <== <b>Ans: </b>" ++ showHTML ans ++ " == </td>\' + " ++
"ndRef(" ++ show toN ++ ",\"" ++ toName ++ "\");"
showSetCs ns =
concat $ map showSetC $ zip [0..] ns
where
showSetC (i,n) = "c[" ++ show i ++ "] = " ++ show n ++ ";"
mkProcs events =
catMaybes $ map processEvent events
where
processEvent (ERNetEvAnsReceived time qryId from fromQryId to ans qry) =
Just $
(toN, to ++ "." ++ show qryId,
fromN, from ++ "." ++ show fromQryId,
QueryAnyProt qry, AnswerAnyProt ans,
Set.toAscList $ Map.findWithDefault Set.empty toN from2tos)
where
toN = getProcN to qryId
fromN = getProcN from fromQryId
processEvent _ = Nothing
getProcN name qryId =
case Map.lookup (name, qryId) nameid2n of
Just n -> n
Nothing -> error $ "getProcN failed for " ++ show (name, qryId)
nameid2n =
Map.fromList $ zip nameids [1..]
where
nameids = nub $ concat $ map getNameId events
getNameId (ERNetEvQryMade time qryId from fromQryId to qry) =
[(from, fromQryId), (to, qryId)]
getNameId _ = []
from2tos =
foldl addEvent (Map.empty) events
addEvent m (ERNetEvAnsReceived time qryId from fromQryId to ans qry) =
Map.insertWith Set.union fromN (Set.singleton toN) m
where
toN = getProcN to qryId
fromN = getProcN from fromQryId
addEvent m _ = m