{-# LANGUAGE GADTs, QuasiQuotes, TupleSections, ScopedTypeVariables, NoMonomorphismRestriction, FlexibleInstances, EmptyDataDecls, MultiParamTypeClasses #-}
{- |
Module      :  Network.JMacroRPC.Panels
Copyright   :  (c) Gershom Bazerman, 2012
License     :  BSD 3 Clause
Maintainer  :  gershomb@gmail.com
Stability   :  experimental

The Panels library provides continuation-style compositional web
development with no scaling hassle. On the server side, Panels are
entirely stateless, storing no client-specific state. This also means
that requests can be sharded to multiple servers without worrying
about replication of large session objects (authentication choices are
another issue entirely).

Code is written with a set of combinators over `Panel`s,
which package up display and behavior simultaneously. Panels, inspired
by FRP, can provide `Signal`s, which are sampleable, `Event`s, which are
discrete and can trigger updates, and `Sink`s which can be bound to
Signals (behaving similarly to FRP wormholes). Semantics, by virtue of
client-server interaction, are necessarily evented rather than
continuous.

Panels, which are built using this library, can then be displayed using one of a number of servers as backends. New backends can be created with the `panelToPageGen` function.

Example usage:

> testPanel :: (Monad m, Functor m) => Panel m
> testPanel =    para "This is an example"
>           <> plainHTML Blaze.br
>           <> inDiv [
>                   select ("default",1::Int) [("another",2)] $ \ evt selSignal selPanel ->
>                   selPanel <>
>                    (onEvent evt $
>                     withSample selSignal $ \ selChoice ->
>                     select (show selChoice, selChoice) 
>                         [(show $ selChoice + 1, selChoice + 1)] $ \ _evt selSignal2 selPanel2 ->
>                     button "click me" $ \ buttonEvt buttonPanel ->
>                     onEvent buttonEvt $
>                     withSample selSignal2 $ \ selChoice2 ->
>                     (selPanel2 <> buttonPanel <> plainHTML Blaze.br
>                      <> (para $ "you chose: " ++ show (selChoice, selChoice2))))
>              ]

The above code displays two dropdown menus and a button. The first dropdown determines the contents of the second. On clicking the button, the text updates with choices from both the first and second dropdowns.

See the source of `calcPanel` for an example of mixed client/server updates with more complicated stateful interaction.

-}
module Network.JMacroRPC.Panels (
  -- * Base Types
  JS, Hask, PanelPath,
  Event, Signal, Sink,

  -- * The PState Monad Transformer
  PanelState, PState, newIdent, descended,

  -- * Page Slices and Panels
  PageSlice(..), Panel(..), 

  -- * Base Type Combinators
  pureSig, 
  zipSinks,
  contramapJs,

  -- * Building Panels
  plainHTML,
  onHtml,
  joinWith,
  buildInput,
  inDiv,
  para,
  mkTable,

  -- * Interacting with signals, sinks, and events
  withSample,
  sampleSigJs, 
  onEvent,
  tellSink,
  bindSigSink,
  sampleIO,
  bindEventIO,

  -- * Derived panels and inputs.
  button, select, selectInput, textPane, newVar,

  -- * Running Panels
  panelPrelude,
  panelToPageGen,

  -- * Examples
  calcPanel

)
where
import Control.Monad.State
import Control.Arrow((***))
import qualified Data.Set as S
import qualified Data.Map as M
import Data.Attoparsec.ByteString.Lazy(parse,Result(..))
import Data.Functor.Contravariant
import Data.Map(Map)
import Data.Set(Set)
import Data.Maybe
import Language.Javascript.JMacro
import Text.Blaze.Html5(Html)
import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5 as H5
import Text.Blaze.Html5((!),toValue)
import qualified Text.Blaze.Html5.Attributes as H
import Control.Applicative
import Data.Monoid
import Data.List(intercalate)
import Data.String
import Data.Aeson
import Data.Aeson.Parser
import qualified Data.Text.Encoding as T
import qualified Data.Text.Lazy as T
import qualified Data.ByteString.Lazy.Char8 as BS
import qualified Data.ByteString.Char8 as B
import qualified Text.Blaze.Html.Renderer.Pretty as P
import qualified Text.Blaze.Html.Renderer.Text as T
import Data.List.Split

import Network.JMacroRPC.Base

-- | Type tag for Sinks and Signals that can be run in pure JavaScript.
data JS
-- | Type tag for Sinks and Signals that require server-side interaction.
data Hask

-- | Unique label for any given panel in a control structure.
type PanelPath = [Int]

printPath :: PanelPath -> String
printPath = intercalate "_" . map show . reverse

-- | Conceptually, an Event is something that can trigger an update.
-- We can join two events (which gives us "or" semantics), and we can
-- trigger on an event. That's it. 
-- In reality, an event is composed of the panelpaths to it's sources.
data Event = Event [PanelPath]

instance Monoid Event where
    mempty = Event []
    mappend (Event x) (Event y) = Event (x <> y)

-- This isn't a real functor because fmap id isn't always id.
-- Note that monad breaks inspectability of ids.

-- | A Signal can contain information drawn from client-side inputs. Signals are tagged as JS, Hask, or parametric. A signal of type JS can be read from purely on the client side, with no round trip. A signal of type Hask forms an applicative functor, so we can build server-side values with complex computed behaviours.
-- Note that @Signal Hask@ actually bends the applicative functor laws in that @fmap id@ on a signal that can be calculated directly in JS can send it to a signal that cannot be. This is a flaw, and it will be fixed.
data Signal typ a where
    PureSig :: a -> Signal typ a
    OneSig :: FromJSON a => PanelPath -> Signal typ a
    MultiSig :: Signal typ1 a -> Signal typ2 b -> ((a,b) -> c) -> Signal Hask c

-- TODO, IO Signals?

instance Functor (Signal Hask) where
    fmap f (PureSig x) = PureSig $ f x
    fmap f (OneSig p) = MultiSig (OneSig p) (PureSig ()) (f . fst)
    fmap f (MultiSig x y g) = MultiSig x y (f . g)

instance Applicative (Signal Hask) where
    pure x = PureSig x
    (PureSig f) <*> x = fmap f x
    f <*> (PureSig y) = fmap ($ y) f
    f <*> x = MultiSig f x (uncurry ($))

-- | Since only some Signals are applicative functors, pureSig provides a @pure@ operation over all Signals.
pureSig :: a -> Signal typ a
pureSig = PureSig


-- | Sinks likewise are tagged as JS, Hask, or parametric. A sink of type JS can be written to purely on the client side, with no round trip. A sink of type Hask is a contravariant functor.
data Sink typ m a where 
    ServerSink :: (a -> PState m [JStat]) -> Sink Hask m a
    PureSink   :: ToJExpr a => JExpr -> Sink typ m a

liftSink :: Monad m => Sink typ m a -> Sink Hask m a 
liftSink (PureSink js) = ServerSink $ \x -> return [ [jmacro|`(js)` `(x)`|] ]
liftSink (ServerSink f) = ServerSink f

runSink :: Monad m => Sink typ m a -> a -> PState m [JStat]
runSink (ServerSink f) = f
runSink x@(PureSink _) = runSink (liftSink x)

instance Monad m => Contravariant (Sink Hask m) where
    contramap f (ServerSink g) = ServerSink (g . f)
    contramap f x = contramap f (liftSink x)

-- | A JavaScript funcion can be contravariantly mapped over a Sink JS
contramapJs :: ToJExpr a => JExpr -> Sink JS m b -> Sink JS m a
contramapJs f (PureSink g) = PureSink [jmacroE|\x -> `(g)` (`(f)` x)|]

-- TODO zipsinks over JS sinks too -- use liftsink

-- | We can zip sinks up to combine them.
zipSinks :: Monad  m => Sink Hask m a -> Sink Hask m b -> Sink Hask m (a,b)
zipSinks (ServerSink f) (ServerSink g) = ServerSink (\(x,y) -> liftM2 (<>) (f x) (g y))
zipSinks s t = zipSinks (liftSink s) (liftSink t)


extractIds :: Signal typ a -> [PanelPath]
extractIds (PureSig _) = []
extractIds (OneSig p) = [p]
extractIds (MultiSig x y _) = extractIds x <> extractIds y

-- TODO add req environment + maybe refactor the clean/hacked envs

-- | A PanelState contains environment information used to render Panels.
data PanelState = PanelState {
      ps_path :: PanelPath,
      ps_env :: Map String BS.ByteString, -- including stale parentpaths
      ps_env_clean :: Map String BS.ByteString, -- including only fresh parentpaths
      ps_events :: Set String,
      ps_listener :: Maybe (String, Map String BS.ByteString) --the variable and local env for it if we're in an update context
    } deriving (Show)

-- | The PState Monad Transformer provides access o the PanelState.
type PState m a = StateT PanelState m a

readSignal :: (Functor m, Monad m) => Signal typ a -> PState m a
readSignal x = case x of
    PureSig v -> return v
    OneSig p -> mbParse p . M.lookup (printPath p) . ps_env <$> get
    MultiSig sa sb f -> fmap f $ liftA2 (,) (readSignal sa) (readSignal sb)
  where mbParse p Nothing = error $ "no value in env for: " ++ printPath p
        mbParse _ (Just v) = case parse value v of
                             Done _ jv -> case fromJSON jv of
                                           Success a -> a
                                           -- This is an ad hoc case to fall back on string decoding. blah.
                                           _ -> case fromJSON (String $ T.decodeUtf8 $ B.concat $ BS.toChunks v) of
                                                  Success a -> a
                                                  _ -> error $ "unable to parse: " ++ show v


                             _ -> case fromJSON (String $ T.decodeUtf8 $ B.concat $ BS.toChunks v) of
                                           Success a -> a
                                           _ -> error $ "unable to parse string: " ++ show v

setEnv :: (Functor m, Monad m, ToJSON a) => PanelPath -> a -> PState m ()
setEnv i x = modify (\ps -> ps {ps_env = go (ps_env ps)})
    where go = M.insert (printPath i) (encode x)

incrPath :: PanelPath -> PanelPath
incrPath (x:xs) = x + 1 : xs
incrPath [] = []

-- | We can get a fresh identifier out of a panel state.
newIdent :: (Monad m, Functor m) => PState m PanelPath
newIdent = do
    i <- ps_path <$> get
    modify (\s -> s {ps_path = incrPath i})
    return i

-- | And we can get an identifier out before descending into a "local" 
-- environment whose identifiers don't affect the main supply. Hence if
-- a local environment alters its pattern of consumption, identifiers
-- in the outer environment will remain stable.
descended :: (Monad m, Functor m) => (PanelPath -> PState m a) -> PState m a
descended f = do
  i <- ps_path <$> get
  modify (\s -> s {ps_path = 0 : i})
  res <- f i
  modify (\s -> s {ps_path = incrPath i})
  return res

-- | A PageSlice is a pair of Html and JavaScript. When a Panel is rendered,
-- all JavaScript ends up joined together in the head of the page, and all HTML below it. PageSlices are naturally Monoidal, just as Html is.
data PageSlice = PS {
      htmlP :: Html,
      jsP   :: [JStat]
    }

instance Monoid PageSlice where
    mempty = PS mempty mempty
    mappend (PS h j) (PS h' j') = PS (h <> h') (j <> j')

-- | A Panel is the pair of an action to produce a PageSlice and
-- an action to produce a list of locations with updated PageSlices.
-- The former is used to draw the initial page, and the latter to
-- modify it in response to events. Panels are also naturally Monoidal.
data Panel m = Panel {
      drawP   :: PState m PageSlice,
      updateP :: PState m [(PanelPath, PageSlice)]
    }

instance Monad m => Monoid (Panel m) where
    mempty = Panel (return mempty) (return mempty)
    mappend (Panel d u) (Panel d' u') = Panel (liftM2 (<>) d d') (liftM2 (<>) u u')

runPanelDraw :: (Monad m, Functor m) => Map String BS.ByteString -> Set String -> Panel m -> m PageSlice
runPanelDraw m s p = drawP p `evalStateT` startState
    where startState = PanelState [0] m m s Nothing

runPanelUpdateSlice :: (Monad m, Functor m) => (String, Map String BS.ByteString) -> Map String BS.ByteString -> Set String -> Panel m -> m [(PanelPath,PageSlice)]
runPanelUpdateSlice (slice, parentData) m s p = updateP p `evalStateT` startState
    where startState = PanelState [0] (M.union parentData m) m s (Just (slice, parentData))

runPanelUpdateMany :: (Monad m, Functor m) => Map String BS.ByteString -> Map String (Map String BS.ByteString) -> Set String -> Panel m -> m [(PanelPath,PageSlice)]
runPanelUpdateMany m listenerData s p = concat <$> mapM go (M.toList listenerData)
    where go listenerPair = runPanelUpdateSlice listenerPair m s p

-- | We can lift any Html into a Panel trivially.
plainHTML :: (Monad m, Functor m) => Html -> Panel m
plainHTML h = Panel (return $ PS h []) (return [])

onHtmlPS :: (Html -> Html) -> PageSlice -> PageSlice
onHtmlPS f (PS h j) = PS (f h) j

-- | Similarly, we can map over any Html inside a panel (although the behavior may be odd on panels with internal update semantics).
onHtml :: (Monad m, Functor m) => (Html -> Html) -> Panel m -> Panel m
onHtml f (Panel d u) = Panel (fmap (onHtmlPS f) d) u

joinWithPS :: ([Html] -> Html) -> [PageSlice] -> PageSlice
joinWithPS f ps = PS (f $ map htmlP ps) (concatMap jsP ps)

-- | Given a function to join Html sections, we can fuse a list of panels into a single pannel by lifting that function.
joinWith :: (Monad m, Functor m) => ([Html] -> Html) -> [Panel m] -> Panel m
joinWith f xs = Panel (joinWithPS f <$> mapM drawP xs) (concat <$> mapM updateP xs)

-- | Given an arbitrary Signal, and a continuation accepting a value of the underlying type of the signal, yield a simple Panel.
withSample :: (FromJSON a, Monad m, Functor m) => Signal typ a -> (a -> Panel m) -> Panel m
withSample sig k = Panel onDraw onUpdate
    where onDraw = descended $ \i -> setDependenciesSig (printPath i) (extractIds sig) <$> ((drawP . k <=< readSignal) sig)

          onUpdate = descended $ const $ (updateP . k <=< readSignal) sig

setDependenciesSig :: String -> [PanelPath] -> PageSlice -> PageSlice
setDependenciesSig pathI depList (PS h j) = PS
              ((H.div ! H.id (toValue pathI) ! H.name (toValue "inp")) h)
              (map (\d -> [jmacro|signalDepends(`(pathI)`,`(printPath d)`);|]) depList ++ j)

-- TODO, allow JS signals to not just be .val(), but have arbitrary "getter" actions.

-- | Given a Signal JS, produce a JavaScript expression that samples the value of the signal.
sampleSigJs :: ToJSON a => Signal JS a -> JExpr
sampleSigJs (OneSig ip) = [jmacroE|$("#"+`(ip)`).val()|]
sampleSigJs (PureSig x) = [jmacroE|`(toJSON x)`|]

-- | Given an Event, and a Panel, update the Panel each time the event fires.
onEvent :: (Monad m, Functor m) => Event -> Panel m -> Panel m
onEvent (Event depList) p = Panel onDraw onUpdate
    where onDraw = descended $ \i -> do
                     let ip = printPath i
                     setDependenciesEvt ip <$> drawP p

          setDependenciesEvt pathI (PS h j) = PS
              ((H.div ! H.id (toValue pathI) ! H.name (toValue "evt")) h)
              (map (\d -> [jmacro|eventDepends(`(pathI)`,`(printPath d)`);|]) depList ++ j)

          onUpdate = descended $ \i -> do
            let ip = printPath i
            events <- ps_events <$> get
            listener <- fmap fst . ps_listener <$> get
            let shouldUpdate = case listener of
                                 Just l -> l == ip
                                 Nothing -> any (`S.member` events) (map printPath depList)
            if shouldUpdate
               then do
                 parentDeps <- fromMaybe M.empty . fmap snd . ps_listener <$> get
                 setCleanState
                 (\x -> [(i,x)]) . setDependenciesUpd parentDeps ip <$> drawP p
               else updateP p

          setCleanState = modify (\ps -> ps {ps_env = ps_env_clean ps})

          setDependenciesUpd parentData pathI (PS h j) = PS
              ((H.div ! H.id (toValue pathI) ! H.name (toValue "evt")) h)
              (map (\d -> [jmacro|eventDependsPD(`(pathI)`,`(printPath d)`,`(M.map BS.unpack $ parentData)`);|]) depList ++ j)

-- TODO SWITCH FUNCTION

-- | Feed a value to a Sink.
tellSink :: (Functor m, Monad m) => Sink typ m a -> a -> Panel m
tellSink i x = Panel (do
                        l <- ps_listener <$> get
                        case l of
                          -- we're updating
                          Just _ -> PS mempty <$> runSink i x
                          -- we're not
                          Nothing -> return mempty
                      )
                     (return [])


-- | Given an event, a signal, and a sink, on each firing of the event, feed the sink the current sampled value of the signal. If the Signal and Sink are both in JS, this can happen entirely on the client side.
bindSigSink :: (Monad m, Functor m, FromJSON a, ToJSON a) => Event -> Signal typ1 a -> Sink typ2 m a -> Panel m
bindSigSink (Event depList) (PureSig a) (PureSink js) = Panel draw (newIdent >> return [])
    where draw = newIdent >>= \i -> return $ PS mempty (map (\eid -> [jmacro|clientEventDepends `(printPath i)` `(printPath eid)` (\ -> `(js)` `(toJSON a)`);|]) depList)
          
bindSigSink (Event depList) (OneSig sid) (PureSink js) = Panel draw (newIdent >> return []) 
    where draw = newIdent >>= \i -> return $ PS mempty (map (\eid -> [jmacro|clientEventDepends `(printPath i)` `(printPath eid)` (\ -> `(js)` $("#"+`(sid)`).val());|]) depList)

bindSigSink ev sig sink = onEvent ev . withSample sig $ \i -> tellSink sink i

-- | This is a general purpose function for constructing Panels that provide signals and events, and optionally sinks. It takes a function from an identifier path to an intial value of a signal, optional sinks into the signal, and a panel "controlling" the signal. From this it yields a continuation function from the event and signal associated wih the panel, the optional sinks, and the signal "control" panel to a new panel to the new panel iself. 
-- Usage of this function is best understood by viewing the source of inputs built using it.
buildInput :: (FromJSON a, ToJSON a, Monad m, Functor m) =>
              (PanelPath -> (a, sinks, Panel m)) -- ^ given a path, construct a so-located panel with an intial value and possibly some Sinks.
              -> (Event -> Signal typ a -> sinks -> Panel m -> Panel m) -- ^ given a so-constructed panel, event, and signal, declare what panel to produce.
              -> Panel m -- ^ result panel
buildInput mkInput k = Panel onDraw onUpdate
    where onDraw   = newIdent >>= \i -> do
                      let (initial, inputs, control) = mkInput i
                          e = Event [i]
                          s = OneSig i
                          p = k e s inputs control
                      setEnv i initial
                      descended $ \ i' -> setDependenciesSig (printPath i') [i] <$> drawP p
          onUpdate = newIdent >>= \i ->
                      let (_, inputs, control) = mkInput i
                          e = Event [i]
                          s = OneSig i
                          p = k e s inputs control
                      in descended $ const $ updateP p

-- NB descending and setting dependencies here is pessimistic w/r/t dependencies. But to be 'exact' we need all deps to propigate up even if guarded by if and case statements -- this means not using real if and case statements.
-- Nonetheless we at least only deliver potential deps and not *all* deps in completely orthogonal areas.
-- Not pessimistic is just avoiding the use of descended and setDependencies

-- | Takes an initial value and a continuation taking an event and the button itself, yields a panel.
button :: (Monad m, Functor m) => String -> (Event -> Panel m -> Panel m) -> Panel m
button txt k = buildInput mkButton kont
    where kont e _s _i p = k e p
          mkButton i = (
                         (),
                         (),
                         Panel (return $ PS htmlBit jsBit) (return [])
                        )
              where htmlBit = H.button ! H.id (toValue ip) $ fromString txt
                    jsBit = [[jmacro|registerButton(`(ip)`);|]]
                    ip = printPath i

-- | Takes an intial (label, value) pair, a list of pairs of labeled values, and a continuation, building a Panel with a dropdown selector.
select :: (Monad m, Functor m, ToJSON a, FromJSON a) => (String, a) -> [(String, a)] -> (Event -> Signal typ a -> Panel m -> Panel m) -> Panel m
select defOpt options k = buildInput mkSelect kont
    where kont evt sig _sink p = k evt sig p
          mkSelect i = (
                        snd defOpt,
                        (),
                        Panel (return $ PS htmlBit jsBit) (return [])
                       )
              where htmlBit = H.select ! H.id (toValue ip) $ mconcat $ map mkOption (defOpt : options)
                    mkOption (n,v) = H.option ! H.value (toValue . BS.unpack $ encode v) $ (fromString n)
                    jsBit = [[jmacro|registerSelect(`(ip)`);|]]
                    ip = printPath i


--TODO freezeUpdates combinator. renders section fixed -- e.g. one requiring IO or whatever.

--TODO rename to sampleIO

-- | Perform an action in the underlying monad and feed the result to a panel. Synchronous.
-- Note that this action will occur on every update, even when guarded by an onEvent.
sampleIO :: (Monad m) => m a -> (a -> Panel m) -> Panel m
sampleIO act k = Panel onDraw onUpdate
    where onDraw = drawP . k =<< lift act
          onUpdate = updateP . k =<< lift act

-- | Execute an IO action when triggered by an event. This action only occurs when the event fires.
-- @bindEventIO e act = onEvent e $ Panel (return mempty) (lift act >> return mempty)@
bindEventIO :: (Monad m, Functor m) => Event -> m () -> Panel m
bindEventIO e act = onEvent e $ Panel (return mempty) (lift act >> return mempty)
              

-- | a wrapper around select that immediately samples from the yielded signal. @selectInput defOpt opts k = select defOpt opts $ \e sig p -> withSample sig $ \i -> k e i p@

selectInput :: (Monad m, Functor m, FromJSON a, ToJSON a) => (String, a) -> [(String,a)] -> (Event -> a -> Panel m -> Panel m) -> Panel m
selectInput defOpt opts k = select defOpt opts $ \e sig p -> withSample sig $ \i -> k e i p


-- TODO make letters more uniform for argument types

-- | A basic text input box. This box provides a Sink as well as a Signal, so it's contents can be controlled from elsewhere in the Panel.
textPane :: (Monad m, Functor m) => String -> (Event -> Signal typ String -> Sink typ m String -> Panel m -> Panel m) -> Panel m
textPane initial kont = buildInput mkInput kont
    where mkInput i = (
                        initial,
                        input,
                        Panel (return $ PS htmlBit jsBit) (return [])
                       )
              where htmlBit = H.input ! H.id (toValue ip) ! H.value (toValue initial)
                    jsBit = [[jmacro|registerInput(`(ip)`);|]]
                    ip = printPath i
                    input = PureSink [jmacroE|\x -> $("#"+`(ip)`).val(x)|]

-- | A hidden input Panel that can be used as a mutable store, akin to an IORef or MVar.
newVar :: (Monad m, Functor m, ToJSON a, FromJSON a, ToJExpr a) => a -> (Event -> Signal typ a -> Sink typ m a -> Panel m -> Panel m) -> Panel m
newVar initial kont = buildInput mkInput kont
    where mkInput i = (
                        initial,
                        input,
                        Panel (return $ PS htmlBit jsBit) (return [])
                       )
              where htmlBit = H.input ! H.hidden (toValue True) ! H.id (toValue ip) ! H.value (toValue . BS.unpack $ encode initial)
                    jsBit = [[jmacro|registerInput(`(ip)`);|]]
                    ip = printPath i
                    input =  PureSink [jmacroE|\x -> $("#"+`(ip)`).val(JSON.stringify(x))|]


-- lifted html combinator toys

-- | Put a bunch of panels into a single div element.
-- @inDiv = onHtml H.div . mconcat@
inDiv :: (Monad m, Functor m) => [Panel m] -> Panel m
inDiv = onHtml H.div . mconcat

-- | Put some text into a p element. 
-- @para  = plainHTML . H.p . fromString@
para :: (Monad m, Functor m) => String -> Panel m
para  = plainHTML . H.p . fromString

-- | Align a list of panels into a table with rows of the specified width.
-- @mkTable n xs = onHtml H.table . mconcat . map row $ chunksOf n xs
--     where row ys = onHtml H.tr . mconcat $ map (onHtml H.td) ys@
mkTable :: (Monad m, Functor m) => Int -> [Panel m] -> Panel m
mkTable n xs = onHtml H.table . mconcat . map row $ chunksOf n xs
    where row ys = onHtml H.tr . mconcat $ map (onHtml H.td) ys

-- | JavaScript code for the reactive runtime system.
panelPrelude :: JStat
panelPrelude = [jmacro|

   fun setInsert set val { set[val] = true; return set; }

   fun setInsertMany set newset {
         for(var n in newset) {
           set[n] = true;
         }
         return set;
   }

   fun setDeleteMany set newset {
         for(var n in newset) {
           delete set[n];
         }
         return set;
   }

   fun nullSet set {
        for(k in set) {
          return false;
        }
        return true;
   }

   fun setToList set {
        var lst = [];
        for(k in set) {
            lst.push(k);
        }
        return lst;
   }


   fun insertMapSet ms k v {
        if(typeof ms[k] == "undefined") {
             ms[k] = {}
        }
        setInsert(ms[k],v);
        return ms;
   }

   fun insertMapMap ms k k1 v {
        if(typeof ms[k] == "undefined") {
             ms[k] = {}
        }
        ms[k][k1] = v;
        return ms;
   }


   // Map IDPath (Set IDPath)
   // :: Map Event DependentSections
   var !eventToDepsMap = {};

   // Map Section DataRequired
   // signalMap :: Map IDPath (Set IDPath)
   var !sectToSigsMap = {};

   // Map IDPath (Set IDPath)
   var !listenerToParentDataMap = {};

   // Map IDPath (Map IDPath (() -> IO ()))
   var !eventToClientDepsMap = {};
                                  
   // IDPath -> Set IDPath
   fun subsetIDMapFromPfx pfx mp {
          var pfl = pfx.length;
          var res = {};
          for (var idp in mp) {
             if(idp.slice(0,pfl) == pfx) {
                 setInsertMany res mp[idp];
             }
          }
          return res;
   }


   // -- TODO we don't need to iterate over the whole mp, just parent keys.
   // -- Given a path, if any prefix of the path matches a key
   // -- then add the elements of that key.
   // IDPath -> Set IDPath
   fun parentsIDMapFromPfx pfx mp {
          var res = {};
          for (var idp in mp) {
             if(pfx.slice(0,idp.length) == idp) {
                 setInsertMany res mp[idp];
             }
          }
          return res;
   }

   fun signalDepends listenerId signalId -> insertMapSet sectToSigsMap  listenerId signalId;

   // -- Initial write, put fresh map
   fun eventDepends    listenerId eventID {
         insertMapSet eventToDepsMap eventID listenerId;
         var parentDeps = parentsIDMapFromPfx listenerId sectToSigsMap;
         var parentMap = {};
         for(var p in parentDeps) {
            parentMap[p] = $("#"+p).val();
         }
         listenerToParentDataMap[listenerId] = parentMap;
   }

   // -- Subsequent writes, put
   fun eventDependsPD  listenerId eventId parentData {
         insertMapSet eventToDepsMap eventId listenerId;
         listenerToParentDataMap[listenerId] = parentData;
   }

   fun clientEventDepends listenerId eventId js {
       insertMapMap eventToClientDepsMap eventId listenerId js;
   }

   fun invalidateRegion(uid) {
          var pfl = uid.length;
          var subSects = {};
          setInsert subSects uid;
          for(var sect in sectToSigsMap) {
                if(sect.slice(0,pfl) == uid) {
                     setInsert subSects sect;
                     delete sectToSigsMap[sect];
                }
          }
          // -- it *should* be true that there are no listners that are not subs? If not, there's this
          for(var sect in sectToSigsMap) {
             setDeleteMany sectToSigsMap[sect] subSects;
          }
          // -- each uid + all subs no longer provide events
          var subEvts = {};
          setInsert subEvts uid;
          for(var evt in eventToDepsMap) {
             if(evt.slice(0,pfl) == uid) {
                setInsert subEvts evt;
                delete eventToDepsMap[evt];
             }
          }
          // -- each uid + all subs can no longer be dependencies *of* events
          for(var evt in eventToDepsMap) {
             setDeleteMany eventToDepsMap[evt] subEvts;
          }

          // -- each listener no longer needs its parent data
          for(var listener in listenerToParentDataMap) {
             if(listener.slice(0,pfl) == uid) {
                 delete listener listenerToParentDataMap;
             }
          }
          
          // -- each client listener goes away
          for(var evt in eventToClientDepsMap) {
             if(evt.slice(0,pfl) == uid) {
               eventToClientDepsMap[evt] = {};
             }
             for(var listener in eventToClientDepsMap[evt]) {
                if(listener.slice(0,pfl) == uid) {
                   delete listener eventToClientDepsMap[evt];
                 }
             }
          }
   }

   fun executeUpdate(ups) {
        for(var i in ups) {
          var [uid,[upane,ujs]] = ups[i];

          // -- Invalidate Deps
          invalidateRegion(uid);

          // -- Insert new Html
          $("#"+uid).html(upane);
          // -- Perform new JS
          eval(ujs);
        }
   }

   fun registerButton b -> $("#"+b).data("isButton",true);
   fun registerSelect s -> $("#"+s).data("isSelect",true);
   fun registerInput  s -> $("#"+s).data("isTextInput",true);

   fun fireEvent uid {
      console.log("fireevent",uid);
      // -- A set of everything depending on the event.
      var deps = eventToDepsMap[uid];
      var depsExist = false;

      // -- The set of data trails leading to each dep
      var depDataMap = {};

      // -- The set of everything that things depending on the event or their children need in order to generate. Also the things their parents may pull.
      var sectData = {};
      for (var dep in deps) {
           depsExist = true;
           setInsertMany sectData (subsetIDMapFromPfx  dep sectToSigsMap);
           setInsertMany sectData (parentsIDMapFromPfx dep sectToSigsMap);
           depDataMap[dep] = listenerToParentDataMap[dep];
      }

      // -- Clientside handlers
      var clientDeps = eventToClientDepsMap[uid] == null ? {} : eventToClientDepsMap[uid];
      console.log("clientDeps",clientDeps);
      for (var cdep in clientDeps) {
            console.log("cdep",clientDeps[cdep]);
            clientDeps[cdep]();
      }

      var envMap = {};
      for(var s in sectData) {
         envMap[s] = $("#"+s).val();
      }

      if(depsExist) {
         executeUpdate (updateEvent(envMap,depDataMap,[uid]));
      }
   }

   fun handleButton e {
     var tg = $(e.target);
     if(tg.data("isButton")) {
         fireEvent(tg.attr("id"));
     }
   }
   $("html").on("click", "button", handleButton);

   fun handleSelect e {
     var tg = $(e.target);
     if(tg.data("isSelect")) {
         fireEvent(tg.attr("id"));
     }
   }
   $("html").on("change", "select", handleSelect);

   fun handleInput e {
     var tg = $(e.target);
     if(tg.data("isTextInput")) {
         fireEvent(tg.attr("id"));
     }
   }
   $("html").on("change", "input", handleInput);

 |]


type UpdateList = [(String, (String,String))]

-- TODO NOW. fix other modules to use simplified panelToPageGen

-- | General function used to create backends for different servers and frameworks.
panelToPageGen :: forall m resp. (Monad m, Functor m, ToJsonRPC (m (Either String UpdateList)) m) =>
                  ([JsonRPC m ()] -> m resp) -- ^ A function which serves stateless JsonRPCs.
                  -> (T.Text -> m resp) -- ^ A function which renders Text to a server response.
                  -> String -- ^ A page title.
                  -> Panel m  -- ^ The panel to server 
                  -> (m resp, m resp) -- ^ Two page handlers --  one for handling updates (POSTs), and the second for rendering the initial page (GETs).
panelToPageGen serveRpcs returnResponse title p = (updateHandler, drawHandler)
    where drawHandler = do
            dp <- runPanelDraw M.empty S.empty $ p
            returnResponse $ T.renderHtml $ H.html $ do
                          H.head $ do
                            H5.title (fromString title)
                            H.script ! H.src (toValue "https://ajax.googleapis.com/ajax/libs/jquery/1.8.1/jquery.min.js") $ mempty
                            H.script . fromString . show . renderJs $ invokeRPCLib `mappend` rpcDecls `mappend` panelPrelude
                            H.script . fromString . show . renderJs . wrapJQuery . jsP $ dp
                          H.body . htmlP $ dp

          wrapJQuery jm = [jmacroE|$(\ {`(jm)`;})|]

          updateHandler = serveRpcs allRPCs

          allRPCs = [updateRPC]
          rpcDecls = mconcat $ map jsonRPCToDecl allRPCs

          updateFun :: Map String BS.ByteString -> Map String (Map String BS.ByteString) -> Set String -> m (Either String UpdateList)
          updateFun envMap listenerData eventSet = do
                 slices <- runPanelUpdateMany envMap listenerData eventSet p
                 return $ Right $ map (printPath *** renderPS) $ slices

          renderPS ps = (P.renderHtml . htmlP $ ps,
                        show . renderJs . mconcat . jsP $ ps)

          updateRPC :: JsonRPC m ()
          updateRPC = toJsonRPC "updateEvent" $ \envMap depDataMap eventSet -> updateFun envMap depDataMap eventSet


-- TODO more interesting control with inputs, like a dial or something.


--TODO define function composition combinator


-- | Example panel that displays a calculator.
calcPanel :: (Monad m, Functor m) => Panel m
calcPanel = textPane "0" $ \_ displaysig displayInp displaypane ->
            newVar "0"   $ \_ storesig storeInp storepane ->
            newVar ""    $ \_ cmdstoresig cmdstoreInp cmdstorepane ->
            let
                trimJs = [jmacroE|\x {for(var i = 0; i<x.length;i++) {
                                               if(x[i] != '0') { return x.substring(i,x.length)}
                                      }
                                      return 0;}|]
                addDisplayInp = contramapJs [jmacroE|\x -> `(trimJs)` (`(sampleSigJs displaysig)` + x)|] displayInp
                numButton  val = button val $ \ e b -> b <> bindSigSink e (pureSig val) addDisplayInp
                opButton   val = button val $ \ e b -> b <> bindSigSink e (pureSig val) cmdstoreInp
                                                         <> bindSigSink e displaysig storeInp
                                                         <> bindSigSink e (pureSig "0") displayInp
                clearButton = button "c" $ \ e b -> b <>
                                                    bindSigSink e (pureSig "0") storeInp <>
                                                    bindSigSink e (pureSig "0") displayInp <>
                                                    bindSigSink e (pureSig "")  cmdstoreInp
                equalButton = button "=" $ \ e b -> b <> onEvent e 
                              (withSample cmdstoresig $ \cmdstoreval ->
                               withSample displaysig  $ \dispval -> 
                               withSample storesig    $ \storeval ->
                               let execOp op = tellSink displayInp (show $ (read storeval :: Int) `op` (read dispval :: Int))
                               in case cmdstoreval of
                                    "+" -> execOp (+)
                                    "-" -> execOp (flip subtract)
                                    "*" -> execOp (*)
                                    "/" -> execOp (div)
                                    _   -> mempty)
                buttonPane = mkTable 3 $ map (numButton . show) ([(1::Int)..9] ++ [0]) ++ map opButton ["+","-","*","/"] ++ [equalButton,clearButton]
            in
            inDiv [displaypane <> storepane <> cmdstorepane,
                    buttonPane
                  ]

--TODO arbitrary typeclass driven pane manipulation?