content: {-# LANGUAGE OverloadedStrings #-}
  module React.Interpret (reactNodeToJSAny, setProp') where
  
  import Control.Applicative
  import Control.Monad
  import qualified Data.Aeson as Aeson
  import qualified Data.HashMap.Strict as H
  import Data.List
  import Data.Maybe
  import Data.Text (Text)
  
  import React.GHCJS
  import React.Imports
  import React.Registry
  import React.Types
  
  -- This module handles the translation of 'ReactNode's into javascript. The
  -- difficulty is in handling the complexity that arises from keeping state in
  -- Haskell rather than in JS. This means we can't just blindly call ToJSRef
  -- (which would be very convenient).
  --
  -- The raison d'etre of this module is 'reactNodeToJSAny', which delegates to
  -- helpers for each type of react node.
  --
  -- Most interesting code is in 'componentToJSAny'.
  -- * It deals with the current event handler, which is passed down through
  --   'reactNodeToJSAny' and all of its special cases.
  -- * It also sets the props and handler in the component registry.
  
  
  data Attr = Attr Text JSON
  
  
  reactNodeToJSAny :: (sig -> IO ()) -> Int -> ReactNode sig -> IO JSAny
  reactNodeToJSAny sigHandler componentId (ComponentElement elem) =
      componentToJSAny sigHandler elem
  reactNodeToJSAny sigHandler componentId (DomElement elem)       =
      domToJSAny sigHandler componentId elem
  
  -- This isn't entirely fair to foreign (exported) classes. We've set them up
  -- with our createClass machinery, so they expect to have a componentId, but we
  -- give them none...
  -- reactNodeToJSAny _ _ (ForeignElement elem)                   =
  --     return $ castRef elem
  
  reactNodeToJSAny sigHandler componentId (ForeignClass cls props children) = do
      -- pass the handler and component id on to the children - their events will
      -- just be handled by the parent class.
      children' <- reactNodeToJSAny sigHandler componentId children
      props' <- toJSRef props
      js_foreignParent cls props' children'
  
  reactNodeToJSAny sigHandler _           (NodeText str)          =
      castRef <$> toJSRef (toJSString str)
  reactNodeToJSAny sigHandler componentId (NodeSequence seq)      = do
      jsNodes <- mapM (reactNodeToJSAny sigHandler componentId) seq
      castRef <$> toArray jsNodes
  reactNodeToJSAny sigHandler componentId (LocalNode f node)      =
      -- Convert from 'sig -> IO ()' to 'insig -> IO ()'
      let sigHandler' = sigHandler . f
      in reactNodeToJSAny sigHandler' componentId node
  
  
  jsName :: EvtType -> JSString
  jsName BlurEvt = "onBlur"
  jsName FocusEvt = "onFocus"
  jsName ChangeEvt = "onChange"
  jsName KeyDownEvt = "onKeyDown"
  jsName KeyPressEvt = "onKeyPress"
  jsName KeyUpEvt = "onKeyUp"
  jsName ClickEvt = "onClick"
  jsName DoubleClickEvt = "onDoubleClick"
  jsName MouseEnterEvt = "onMouseEnter"
  jsName MouseLeaveEvt = "onMouseLeave"
  
  
  unHandler :: (s -> IO ())
            -> EventHandler s
            -> (RawEvent -> Maybe (IO ()), EvtType)
  unHandler act (EventHandler handle ty) = (\e -> act <$> handle e, ty)
  
  
  makeHandler :: Int
              -- ^ component id
              -> JSAny
              -- ^ object to set this attribute on
              -> (RawEvent -> Maybe (IO ()), EvtType)
              -- ^ handler
              -> IO ()
  makeHandler componentId obj (handle, evtTy) = do
      handle' <- handlerToJs handle
      js_set_handler componentId (jsName evtTy) handle' obj
  
  
  -- | Make a javascript callback to synchronously execute the handler
  handlerToJs :: (RawEvent -> Maybe (IO ()))
              -> IO (JSFun (RawEvent -> IO ()))
  handlerToJs handle = syncCallback1 AlwaysRetain True $
      fromMaybe (return ()) . handle
  
  
  attrsToJson :: [Attr] -> JSON
  attrsToJson = Aeson.toJSON . H.fromList . map unAttr where
      unAttr (Attr name json) = (name, json)
  
  
  separateAttrs :: [AttrOrHandler sig] -> ([Attr], [EventHandler sig])
  separateAttrs attrHandlers = (map makeA as, map makeH hs) where
      (as, hs) = partition isAttr attrHandlers
  
      isAttr :: AttrOrHandler sig -> Bool
      isAttr (StaticAttr _ _) = True
      isAttr _ = False
  
      makeA :: AttrOrHandler sig -> Attr
      makeA (StaticAttr t j) = Attr t j
  
      makeH :: AttrOrHandler sig -> EventHandler sig
      makeH (Handler h) = h
  
  
  attrHandlerToJSAny :: (sig -> IO ()) -> Int -> [AttrOrHandler sig] -> IO JSAny
  attrHandlerToJSAny sigHandler componentId attrHandlers = do
      let (attrs, handlers) = separateAttrs attrHandlers
      starter <- castRef <$> toJSRef (attrsToJson attrs)
  
      forM_ handlers $ makeHandler componentId starter . unHandler sigHandler
      return starter
  
  
  -- Helper for componentToJSAny and domToJSAny
  setMaybeKey :: Maybe JSString -> JSAny -> IO ()
  setMaybeKey maybeKey attrsObj = when (isJust maybeKey) $ do
      let Just key = maybeKey
      setProp' "key" key attrsObj
  
  
  setProp' :: ToJSRef a => String -> a -> JSAny -> IO ()
  setProp' key prop obj = do
      propRef <- toJSRef prop
      setProp key propRef obj
  
  
  -- foreignElementToJSAny :: Int -> IO JSAny -> IO JSAny
  -- foreignElementToJSAny componentId
  
  -- foreignClassToJSAny :: Int -> ExportedClass -> IO JSAny
  -- foreignClassToJSAny componentId cls = do
  
  
  componentToJSAny :: (sig -> IO ()) -> ReactComponentElement sig -> IO JSAny
  componentToJSAny
      sigHandler
      (ReactComponentElement ty children maybeKey ref props) = do
  
          let registry = classStateRegistry ty
          componentId <- allocProps registry props
  
          -- handle internal signals, maybe call external signal handler
  
          -- Register a handler! This transitions the class to its new state and
          -- outputs a signal if appropriate.
          let sigHandler' insig = do
                  RegistryStuff _ state _ <-
                      lookupRegistry registry componentId
                  let (state', maybeExSig) = classTransition ty (state, insig)
                  setState registry state' componentId
  
                  case maybeExSig of
                      Just exSig -> sigHandler exSig
                      Nothing -> return ()
  
          setHandler registry sigHandler' componentId
  
          attrsObj <- newObj
  
          setMaybeKey maybeKey attrsObj
          setProp' "ref" ref attrsObj
          setProp' "componentId" componentId attrsObj
  
          let ty' = classForeign ty
          children' <- reactNodeToJSAny sigHandler' componentId children
  
          castRef <$> js_react_createElement_Class ty' attrsObj children'
  
  
  domToJSAny :: (sig -> IO ()) -> Int -> ReactDOMElement sig -> IO JSAny
  domToJSAny sigHandler componentId (ReactDOMElement ty props children maybeKey ref) = do
      attrsObj <- attrHandlerToJSAny sigHandler componentId props
  
      setMaybeKey maybeKey attrsObj
      setProp' "ref" ref attrsObj
  
      children' <- reactNodeToJSAny sigHandler componentId children
  
      castRef <$> js_react_createElement_DOM ty attrsObj children'
  