{-# LANGUAGE ScopedTypeVariables #-}

module Zero.EventSource
  (
    Options(..)

  , newEventSource
  , closeEventSource
  , onMessage
  ) where

import           GHC.Generics (Generic)
import           GHCJS.Types (JSVal, IsJSVal)
import           GHCJS.Marshal (FromJSVal(..))
import           GHCJS.Foreign.Callback (Callback, asyncCallback1)
import           Control.Monad.IO.Class (liftIO)
import           Control.Monad (void)
import qualified Data.ByteString.Lazy.Char8 as L8
import           Data.ByteString.Lazy.Char8 (ByteString)
import qualified Data.Text as T
import           Data.Text (Text)
import qualified Data.JSString as JSS
import           Data.JSString (JSString)
import           Data.Typeable
import           Data.Aeson
import           Data.Map (Map)
import           Reflex.Dom.Core hiding (Value, Error)
import           Zero.GHCJS (toJSVal_aeson)

------------------------------------------------------------------------------

newtype EventSource = EventSource JSVal
  deriving (Typeable)

instance IsJSVal EventSource

data ESEvent = ESEvent
  { ese_data :: Text
  } deriving (Show, Generic)

instance FromJSON ESEvent where
  parseJSON = withObject "ESEvent" $ \v -> ESEvent
    <$> v .: "data"

data Options = Options
  { o_headers :: Map Text Text
  } deriving (Show, Generic)

instance ToJSON Options where
  toJSON (Options headers) =
    object [ "headers" .= headers ]

------------------------------------------------------------------------------

newEventSource :: MonadWidget t m => Event t (Text, Options) -> m (Event t EventSource)
newEventSource e = do
  performEvent $ ffor e $ \(url, opt) -> liftIO $ do
    v <- toJSVal_aeson opt
    js_newEventSource (JSS.pack $ T.unpack url) v

closeEventSource :: MonadWidget t m => Event t (Maybe EventSource) -> m (Event t ())
closeEventSource e = do
  performEvent $ ffor e $ \mEventSource ->
    case mEventSource of
      Just eventSource ->
        liftIO $ js_closeEventSource eventSource
      Nothing ->
        error "error: No event source was found"

onEvent :: EventSource -> (ByteString -> IO ()) -> IO ()
onEvent eventSource cb = do
  cb' <- asyncCallback1 cb''
  js_onmessage eventSource cb'
  where
    cb'' v = do
      s <- js_eventData v
      cb (L8.pack (JSS.unpack s))

onMessage :: MonadWidget t m => Event t EventSource -> m (Event t ByteString)
onMessage e = do
  performEventAsync $ ffor e $ \eventSource cb ->
    void $ liftIO . onEvent eventSource $ liftIO . cb

foreign import javascript unsafe "$r = new EventSourcePolyfill($1,$2);"
  js_newEventSource :: JSString -> JSVal -> IO EventSource

foreign import javascript unsafe "($1).close();"
  js_closeEventSource :: EventSource -> IO ()

foreign import javascript unsafe "($1).addEventListener('message',$2);"
  js_onmessage :: EventSource -> (Callback (JSVal -> IO ())) -> IO ()

foreign import javascript unsafe "$r = ($1).data;"
  js_eventData :: JSVal -> IO JSString

foreign import javascript unsafe "console.log($1);"
  js_log :: JSString -> IO ()

foreign import javascript unsafe "console.log($1);"
  js_logv :: JSVal -> IO ()

