-- | This component handles all WS operations.
-- | This includes telling when a connection is established or closed, and notify a message has been received.
module App.WS where

import Prelude (Unit, bind, discard, pure, show, void, when
               , ($), (&&), (<$>), (<>), (>>=), (>=>), (<<<), map, (=<<))

import Control.Monad.Rec.Class (forever)
import Control.Monad.Except (runExcept)
import Data.Array as A
import Data.ArrayBuffer.Types (ArrayBuffer)
import Data.Bifunctor (lmap)
import Data.Either (Either(..))
import Data.Maybe (Maybe(..), isJust, isNothing)
import Data.String as String
import Data.Tuple (Tuple(..))
import Effect.Aff as Aff
import Effect.Aff (Milliseconds(..))
import Effect.Aff.Class (class MonadAff)
import Effect (Effect)
import Foreign as F
import Halogen as H
import Halogen.HTML as HH
import Halogen.HTML.Events as HE
import Halogen.HTML.Properties as HP
import Halogen.Query.Event as HQE
import Halogen.Subscription as HS
import Web.Socket.BinaryType (BinaryType(ArrayBuffer))
import Web.Socket.Event.CloseEvent as WSCE
import Web.Socket.Event.EventTypes as WSET
import Web.Socket.Event.MessageEvent as WSME
import Web.Socket.ReadyState (ReadyState(Connecting, Open, Closing, Closed))
import Web.Socket.WebSocket as WS

import App.Type.LogMessage

keepalive = 30000.0 :: Number

-- Input is the WS url.
type Input = String

-- | The component can perform 4 actions: log messages, notify that a message has been received,
-- | notify when a connection has been established or when it has been closed.
data Output
-- | MessageReceived (Tuple URL message)
  = MessageReceived (Tuple String ArrayBuffer)  -- Provide a received message to the parent.
  | WSJustConnected                             -- Inform the parent the connection is up.
  | WSJustClosed                                -- Inform the parent the connection is down.
  | Log LogMessage
  | KeepAlive                                   -- Ask the parent to handle a keep-alive message.

-- | The component can receive a single action from other components: sending a message throught the websocket.
data Query a = ToSend ArrayBuffer a

type Slot = H.Slot Query Output

-- | `timer` triggers a `Tick` action every `keepalive` ms.
timer :: forall m a. MonadAff m => a -> m (HS.Emitter a)
timer val = do
  { emitter, listener } <- H.liftEffect HS.create
  _ <- H.liftAff $ Aff.forkAff $ forever do
    Aff.delay $ Milliseconds keepalive
    H.liftEffect $ HS.notify listener val
  pure emitter

data Action
  -- | `Initialize` opens the connection (URL is received as an `input` of this component).
  = Initialize

  -- | The component provides a log each time a message failed to be parsed.
  | WebSocketParseError String

  -- | The component shows buttons when the connection is dropped for some reason.
  -- | To reconnect, the button is clicked, and the `ConnectWebSocket` action is performed.
  | ConnectWebSocket

  -- | `SendMessage` effectively sends a message through the ws connection.
  | SendMessage ArrayBuffer

  -- | `Finalize` is the action performed once the component is destroyed, ending the connection.
  | Finalize

  -- | Tick: keep alive WS connections.
  | Tick

  -- | Every received websocket message and notification is handled in `HandleWebSocket`.
  | HandleWebSocket (WebSocketEvent WebSocketMessageType)

-- | The type `WSInfo` helps handle a websocket.
-- | `WSInfo` is composed of an URL, an actual socket and a boolean
-- | to inform if the connection has to be re-established.
type WSInfo
  = { url        :: String
    , connection :: Maybe WS.WebSocket
    , reconnect  :: Boolean
    }

-- | The state of this component only is composed of the websocket.
type State = { wsInfo :: WSInfo }

component :: forall m. MonadAff m => H.Component Query Input Output m
component =
  H.mkComponent
    { initialState
    , render
    , eval: H.mkEval $ H.defaultEval
        { initialize = Just Initialize
        , handleAction = handleAction
        , handleQuery  = handleQuery
        , finalize = Just Finalize
        }
    }

initialState :: Input -> State
initialState url =
  { wsInfo: { url: url
            , connection: Nothing
            , reconnect: false
            }
  }

-- | The component shows a string when the connection is established, or a button when the connection has closed.
render :: forall m. State -> H.ComponentHTML Action () m
render { wsInfo }
    = HH.div_ [ renderReconnectButton (isNothing wsInfo.connection && wsInfo.reconnect) ]
    where
      renderFootnote :: String -> H.ComponentHTML Action () m
      renderFootnote txt =
        HH.div [ HP.style "margin-bottom: 0.125rem; color: grey;" ] [ HH.small_ [ HH.text txt ] ]

      renderReconnectButton :: Boolean -> H.ComponentHTML Action () m
      renderReconnectButton cond =
        if cond
        then
          HH.p_
            [ HH.button
              [ HP.type_ HP.ButtonButton
              , HE.onClick \_ -> ConnectWebSocket
              ]
              [ HH.text "Reconnect?" ]
            ]
        else
          HH.p_
            [ renderFootnote $
                "NOTE: A 'Reconnect?' button will appear if the connection drops (for URL: '"
                <>
                wsInfo.url
                <>
                "')"
            ]

handleAction :: forall m. MonadAff m => Action -> H.HalogenM State Action () Output m Unit
handleAction action = do
  { wsInfo } <- H.get
  case action of
    Initialize -> do
      _ <- H.subscribe =<< timer Tick
      handleAction ConnectWebSocket

    Tick -> H.raise KeepAlive

    Finalize -> do
      -- H.raise $ Log $ SystemLog $ "Closing websocket for '" <> wsInfo.url <> "'"
      case wsInfo.connection of
        Nothing -> H.raise $ Log $ SystemLog "No socket? How is that even possible?"
        Just socket -> H.liftEffect $ WS.close socket

    WebSocketParseError error ->
      H.raise $ Log $ SystemLog $ renderError (UnknownError error)

    ConnectWebSocket -> do
      -- H.raise $ Log $ SystemLog $ "Connecting to \"" <> wsInfo.url <>  "\"..."
      webSocket <- H.liftEffect $ WS.create wsInfo.url []
      H.liftEffect $ WS.setBinaryType webSocket ArrayBuffer
      H.modify_ _ { wsInfo { connection = Just webSocket } }
      void $ H.subscribe (HandleWebSocket <$> webSocketEmitter webSocket)

    SendMessage array_buffer_to_send -> do
      case wsInfo.connection of
        Nothing -> H.raise $ Log $ UnableToSend $ "Websocket is down!"
        Just webSocket -> H.liftEffect $ do
          sendArrayBuffer webSocket array_buffer_to_send

    HandleWebSocket wsEvent -> do
      case wsEvent of
        WebSocketMessage received_message -> do
          H.raise $ MessageReceived $ Tuple wsInfo.url received_message.message

        WebSocketOpen -> do
          H.raise $ WSJustConnected

        WebSocketClose { code, reason, wasClean } -> do
          H.raise $ Log $ SystemLog $ renderCloseMessage code wasClean reason
          maybeCurrentConnection <- H.gets _.wsInfo.connection
          when (isJust maybeCurrentConnection) do
            H.modify_ _ { wsInfo { connection = Nothing, reconnect = true } }
          H.raise $ WSJustClosed

        WebSocketError errorType -> do
          H.raise $ Log $ SystemLog $ renderError errorType
          H.raise $ WSJustClosed

  where
  renderCloseMessage
    :: Int
    -> Boolean
    -> String
    -> String
  renderCloseMessage code wasClean = case _ of
      ""     -> baseCloseMessage
      reason -> baseCloseMessage <> "Reason: " <> reason
    where
    baseCloseMessage :: String
    baseCloseMessage =
      String.joinWith " "
        [ "Connection to WebSocket closed"
        , "[ CODE:" , show code , "|" , if wasClean then "CLEAN" else "DIRTY" , "]"
        ]

handleQuery :: forall a m. MonadAff m => Query a -> H.HalogenM State Action () Output m (Maybe a)
handleQuery = case _ of
  ToSend message a -> do
    send_message message
    pure (Just a)

send_message :: forall m. MonadAff m => ArrayBuffer -> H.HalogenM State Action () Output m Unit
send_message message = do
    { wsInfo } <- H.get
    case wsInfo.connection of
      Nothing -> H.raise $ Log $ UnableToSend "Not connected to server."
      Just webSocket -> do
        H.liftEffect (WS.readyState webSocket) >>= case _ of
          Connecting -> H.raise $ Log $ UnableToSend "Still connecting to server."
          Closing    -> H.raise $ Log $ UnableToSend "Connection to server is closing."
          Closed     -> do
            H.raise $ Log $ UnableToSend "Connection to server has been closed."
            H.modify_ _ { wsInfo { connection = Nothing, reconnect = true } }
          Open -> H.liftEffect $ sendArrayBuffer webSocket message
--------------------------------------------------------------------------------
-- WebSocket mess.
--------------------------------------------------------------------------------

data WebSocketEvent :: Type -> Type
data WebSocketEvent msg
  = WebSocketMessage { message :: msg, origin :: String, lastEventId :: String }
  | WebSocketOpen
  | WebSocketClose { code :: Int, reason :: String, wasClean :: Boolean }
  | WebSocketError ErrorType

webSocketEmitter :: WS.WebSocket -> HS.Emitter (WebSocketEvent WebSocketMessageType)
webSocketEmitter socket = do

  HS.makeEmitter \push -> do

    openId <- HS.subscribe openEmitter push
    errorId <- HS.subscribe errorEmitter push
    closeId <- HS.subscribe closeEmitter push
    messageId <- HS.subscribe messageEmitter push

    pure do
      HS.unsubscribe openId
      HS.unsubscribe errorId
      HS.unsubscribe closeId
      HS.unsubscribe messageId

  where
  target = WS.toEventTarget socket

  openEmitter :: HS.Emitter (WebSocketEvent WebSocketMessageType)
  openEmitter =
    HQE.eventListener WSET.onOpen target \_ ->
      Just WebSocketOpen

  errorEmitter :: HS.Emitter (WebSocketEvent WebSocketMessageType)
  errorEmitter =
    HQE.eventListener WSET.onError target \_ ->
      Just (WebSocketError UnknownWebSocketError)

  closeEmitter :: HS.Emitter (WebSocketEvent WebSocketMessageType)
  closeEmitter =
    HQE.eventListener WSET.onClose target \event ->
      WSCE.fromEvent event >>= \closeEvent ->
        Just $ WebSocketClose  { code: WSCE.code closeEvent
                               , reason: WSCE.reason closeEvent
                               , wasClean: WSCE.wasClean closeEvent
                               }

  messageEmitter :: HS.Emitter (WebSocketEvent WebSocketMessageType)
  messageEmitter = HQE.eventListener WSET.onMessage target (WSME.fromEvent >=> decodeMessageEvent)

decodeMessageEvent :: WSME.MessageEvent -> Maybe (WebSocketEvent WebSocketMessageType)
decodeMessageEvent = \msgEvent -> do
  let
    foreign' :: F.Foreign
    foreign' = WSME.data_ msgEvent
  case foreignToArrayBuffer foreign' of
    Left errs -> pure $ WebSocketError $ UnknownError errs
    Right arrayBuffer -> pure $ WebSocketMessage { message: arrayBuffer
                                                 , origin: WSME.origin msgEvent
                                                 , lastEventId: WSME.lastEventId msgEvent }

---------------------------
-- Errors
---------------------------

data ErrorType
  = UnknownError String
  | UnknownWebSocketError

renderError :: ErrorType -> String
renderError = case _ of
  UnknownError str ->
    "Unknown error: " <> str
  UnknownWebSocketError ->
    "Unknown 'error' event has been fired by WebSocket event listener"

--------------------------------------------------------------------------------
-- WebSocket message type
--------------------------------------------------------------------------------

type WebSocketMessageType = ArrayBuffer

sendArrayBuffer :: WS.WebSocket -> ArrayBuffer -> Effect Unit
sendArrayBuffer = WS.sendArrayBuffer

foreignToArrayBuffer :: F.Foreign -> Either String ArrayBuffer
foreignToArrayBuffer
  = lmap renderForeignErrors
  <<< runExcept
  <<< F.unsafeReadTagged "ArrayBuffer"
  where
  renderForeignErrors :: F.MultipleErrors -> String
  renderForeignErrors =
    String.joinWith "; " <<< A.fromFoldable <<< map F.renderForeignError