{-|
    Module      :  Control.ERNet.Foundations.Event.JavaScript
    Description :  communication events
    Copyright   :  (c) Michal Konecny
    License     :  BSD3

    Maintainer  :  mik@konecny.aow.cz
    Stability   :  experimental
    Portability :  portable

    Functions that produce a javascipt representation of the
    message dependence graph contained in a set of network events.
-}
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

--{-|
--    Analyse the log and encode the reaction graph of all queries\/answers
--    as javascript functions. Write these functions out into a file called
--    \"thenet.js\".
---}
--outputJS :: 
--    LogTV -> 
--    IO ()
--outputJS logTV =
--    do
--    events <- getCompletedLog logTV
----    mapM putStrLn $ map show $ mkProcs events 
--    writeFile "thenet.js" $ constructJS events
    
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 ++ " ==&gt; <br/>" ++
        " &lt;== <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