Make any variable a valid selection in the open card

{-
Copyright 2016 SlamData, Inc.

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

    http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
-}

module SlamData.Workspace.Card.Open.Eval
  ( evalOpen
  ) where

import SlamData.Prelude

import Control.Monad.Writer.Class (class MonadTell)
import Data.Functor.Mu (Mu)
import Data.Json.Extended as EJ
import Data.Lens ((^?), (?~), (.~))
import Data.List as L
import Data.Path.Pathy as Path
import Data.StrMap as SM
import Matryoshka as M
import SlamData.FileSystem.Resource as R
import SlamData.Quasar.Class (class QuasarDSL)
import SlamData.Quasar.FS as QFS
import SlamData.Quasar.Query as QQ
import SlamData.Workspace.Card.Error as CE
import SlamData.Workspace.Card.Eval.Monad as CEM
import SlamData.Workspace.Card.Open.Model as Open
import SlamData.Workspace.Card.Port as Port
import SlamData.Workspace.Card.Port.VarMap as VM
import SqlSquared as Sql
import Utils.SqlSquared (all)

evalOpen
  ∷ ∀ m
  . MonadThrow CE.CardError m
  ⇒ MonadTell CEM.CardLog m
  ⇒ MonadAsk CEM.CardEnv m
  ⇒ QuasarDSL m
  ⇒ Open.Model
  → Port.DataMap
  → m Port.Out
evalOpen model varMap = case model of
  Nothing → CE.throwOpenError CE.OpenNoResourceSelected
  Just (Open.Resource res) → do
    filePath ← maybe (CE.throwOpenError CE.OpenNoFileSelected) pure $ res ^? R._filePath
    checkPath filePath >>= case _ of
      Nothing → do
        CEM.addSource filePath
        pure (Port.resourceOut (Port.Path filePath))
      Just err → CE.throwOpenError err
  Just (Open.Variable (VM.Var var)) → do
    res ← CEM.temporaryOutputResource
    let
      sql =
        case SM.lookup var varMap of
          Just (Right v) → do
            -- If the var is an ident, use `SELECT * FROM :ident`
            -- If the var is an literal, use `SELECT :literal AS varName`
            -- If the var is any other expr, use it directly
            case unwrapParens (unwrap v) of
              Sql.Ident _ →
                Sql.buildSelect
                  $ all
                  ∘ (Sql._relations ?~ Sql.VariRelation { vari: var, alias: Nothing })
              Sql.Literal _ →
                Sql.buildSelect
                  $ Sql._projections .~ pure (Sql.projection (unwrap v) # Sql.as var)
              Sql.SetLiteral _ →
                Sql.buildSelect
                  $ Sql._projections .~ pure (Sql.projection (unwrap v) # Sql.as var)
              _ →
                unwrap v
          _ →
            -- This case should be impossible - if we selected a var in the
            -- card, the var should exist during eval
            Sql.set L.Nil
      varMap' =
        map (Sql.print ∘ unwrap) $ Port.flattenResources varMap
      backendPath =
        fromMaybe Path.rootDir $ Path.parentDir res
    CE.liftQ $ QQ.viewQuery res sql varMap'
    pure $ Port.resourceOut $ Port.View res (Sql.print sql) varMap

  where
  unwrapParens ∷ Sql.Sql → Sql.SqlF EJ.EJsonF (Mu (Sql.SqlF EJ.EJsonF))
  unwrapParens expr =
    case M.project expr of
      Sql.Parens expr' → unwrapParens expr'
      expr' → expr'

  checkPath filePath =
    CE.liftQ $ QFS.messageIfFileNotFound filePath $ CE.OpenFileNotFound (Path.printPath filePath)

{-
Copyright 2016 SlamData, Inc.

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

    http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
-}

module SlamData.Workspace.Card.Open.Eval
  ( evalOpen
  ) where

import SlamData.Prelude

import Control.Monad.Writer.Class (class MonadTell)
import Data.Lens ((^?), (?~))
import Data.Path.Pathy as Path
import SlamData.FileSystem.Resource as R
import SlamData.Quasar.Class (class QuasarDSL)
import SlamData.Quasar.FS as QFS
import SlamData.Quasar.Query as QQ
import SlamData.Workspace.Card.Error as CE
import SlamData.Workspace.Card.Eval.Monad as CEM
import SlamData.Workspace.Card.Open.Model as Open
import SlamData.Workspace.Card.Port as Port
import SlamData.Workspace.Card.Port.VarMap as VM
import SqlSquared as Sql
import Utils.SqlSquared (all)

evalOpen
  ∷ ∀ m
  . MonadThrow CE.CardError m
  ⇒ MonadTell CEM.CardLog m
  ⇒ MonadAsk CEM.CardEnv m
  ⇒ QuasarDSL m
  ⇒ Open.Model
  → Port.DataMap
  → m Port.Out
evalOpen model varMap = case model of
  Nothing → CE.throwOpenError CE.OpenNoResourceSelected
  Just (Open.Resource res) → do
    filePath ← maybe (CE.throwOpenError CE.OpenNoFileSelected) pure $ res ^? R._filePath
    checkPath filePath >>= case _ of
      Nothing → do
        CEM.addSource filePath
        pure (Port.resourceOut (Port.Path filePath))
      Just err → CE.throwOpenError err
  Just (Open.Variable (VM.Var var)) → do
    res ← CEM.temporaryOutputResource
    let
      sql =
        Sql.buildSelect
          $ all
          ∘ (Sql._relations ?~ Sql.VariRelation { vari: var, alias: Nothing })
      varMap' =
        map (Sql.print ∘ unwrap) $ Port.flattenResources varMap
      backendPath =
        fromMaybe Path.rootDir $ Path.parentDir res

    CE.liftQ $ QQ.viewQuery res sql varMap'
    pure $ Port.resourceOut $ Port.View res (Sql.print sql) varMap

  where
  checkPath filePath =
    CE.liftQ $ QFS.messageIfFileNotFound filePath $ CE.OpenFileNotFound (Path.printPath filePath)


Added size method to Subscriptions

Added size method to Subscriptions

module Servant.Subscriber.Subscriptions (
    Subscriptions
  , makeSubscriptions
  , diffSubscriptions
  , toList
  ) where

import Prelude

import Data.StrMap as StrMap
import Data.StrMap.ST as SM
import Control.Monad.Eff (Eff)
import Control.Monad.ST (ST)
import Data.Function.Uncurried (runFn4)
import Data.Generic (gShow)
import Data.List (List(Nil, Cons))
import Data.Monoid (class Monoid)
import Data.StrMap (StrMap, foldM)
import Data.StrMap.ST (STStrMap)
import Servant.Subscriber.Internal (_lookup, mutate, ToUserType, Subscription)
import Servant.Subscriber.Request (HttpRequest)

newtype Subscriptions a = Subscriptions (StrMap (Subscription a))

makeSubscriptions :: forall a. HttpRequest -> ToUserType a -> Subscriptions a
makeSubscriptions req' parser = Subscriptions $ StrMap.singleton (gShow req')
    {
      req : req'
    , parseResponses : Cons parser Nil
    }

toList :: forall a. Subscriptions a -> List (Subscription a)
toList (Subscriptions a) = StrMap.values a

-- | Number of subscriptions
size :: forall a. Subscriptions a -> Number
size (Subscriptions m) = StrMap.size m

mergeParsers :: forall a. Subscription a -> Subscription a -> Subscription a
mergeParsers subA subB = subA {
    parseResponses = subA.parseResponses <> subB.parseResponses
  }

mergeStrMap :: forall a. StrMap (Subscription a) -> StrMap (Subscription a) -> StrMap (Subscription a)
mergeStrMap m1 m2 = mutate (\s1 -> foldM (\s2 k v2 -> SM.poke s2 k (runFn4 _lookup v2 (\v1 -> mergeParsers v1 v2) k m2)) s1 m1) m2

instance semigroupSubscriptions :: Semigroup (Subscriptions a) where
  append (Subscriptions a) (Subscriptions b) = Subscriptions $ mergeStrMap a b

instance monoidSubscriptions :: Monoid (Subscriptions a) where
  mempty = Subscriptions $ StrMap.empty

instance functorSubscriptions :: Functor Subscriptions where
  map f (Subscriptions a) = Subscriptions $ map (mapSubscription f) a

-- | Calculates the items which are in the first map but not in the second.
--   In other words: All elements present in the second map will be removed from the first.
diffSubscriptions :: forall a. Subscriptions a -> Subscriptions a -> Subscriptions a
diffSubscriptions (Subscriptions a) (Subscriptions b) = Subscriptions $ diffMaps a b

-- | Calculates the items which are in the first map but not in the second.
--   In other words: All elements present in the second map will be removed from the first.
diffMaps :: forall a. StrMap a -> StrMap a -> StrMap a
diffMaps a b = (mutate (\a' -> StrMap.foldM deleteItem a' b)) a
  where
    deleteItem :: forall x h r. STStrMap h x -> String -> x -> Eff (st :: ST h | r) (STStrMap h x)
    deleteItem m key _ = SM.delete m key

mapSubscription :: forall a b. (a -> b) -> Subscription a -> Subscription b
mapSubscription f orig = orig {  parseResponses  = map (map f) <$> orig.parseResponses }

module Servant.Subscriber.Subscriptions (
    Subscriptions
  , makeSubscriptions
  , diffSubscriptions
  , toList
  ) where

import Prelude

import Data.StrMap as StrMap
import Data.StrMap.ST as SM
import Control.Monad.Eff (Eff)
import Control.Monad.ST (ST)
import Data.Function.Uncurried (runFn4)
import Data.Generic (gShow)
import Data.List (List(Nil, Cons))
import Data.Monoid (class Monoid)
import Data.StrMap (StrMap, foldM)
import Data.StrMap.ST (STStrMap)
import Servant.Subscriber.Internal (_lookup, mutate, ToUserType, Subscription)
import Servant.Subscriber.Request (HttpRequest)

newtype Subscriptions a = Subscriptions (StrMap (Subscription a))

makeSubscriptions :: forall a. HttpRequest -> ToUserType a -> Subscriptions a
makeSubscriptions req' parser = Subscriptions $ StrMap.singleton (gShow req')
    {
      req : req'
    , parseResponses : Cons parser Nil
    }

toList :: forall a. Subscriptions a -> List (Subscription a)
toList (Subscriptions a) = StrMap.values a

mergeParsers :: forall a. Subscription a -> Subscription a -> Subscription a
mergeParsers subA subB = subA {
    parseResponses = subA.parseResponses <> subB.parseResponses
  }

mergeStrMap :: forall a. StrMap (Subscription a) -> StrMap (Subscription a) -> StrMap (Subscription a)
mergeStrMap m1 m2 = mutate (\s1 -> foldM (\s2 k v2 -> SM.poke s2 k (runFn4 _lookup v2 (\v1 -> mergeParsers v1 v2) k m2)) s1 m1) m2

instance semigroupSubscriptions :: Semigroup (Subscriptions a) where
  append (Subscriptions a) (Subscriptions b) = Subscriptions $ mergeStrMap a b

instance monoidSubscriptions :: Monoid (Subscriptions a) where
  mempty = Subscriptions $ StrMap.empty

instance functorSubscriptions :: Functor Subscriptions where
  map f (Subscriptions a) = Subscriptions $ map (mapSubscription f) a

-- | Calculates the items which are in the first map but not in the second.
--   In other words: All elements present in the second map will be removed from the first.
diffSubscriptions :: forall a. Subscriptions a -> Subscriptions a -> Subscriptions a
diffSubscriptions (Subscriptions a) (Subscriptions b) = Subscriptions $ diffMaps a b

-- | Calculates the items which are in the first map but not in the second.
--   In other words: All elements present in the second map will be removed from the first.
diffMaps :: forall a. StrMap a -> StrMap a -> StrMap a
diffMaps a b = (mutate (\a' -> StrMap.foldM deleteItem a' b)) a
  where
    deleteItem :: forall x h r. STStrMap h x -> String -> x -> Eff (st :: ST h | r) (STStrMap h x)
    deleteItem m key _ = SM.delete m key

mapSubscription :: forall a b. (a -> b) -> Subscription a -> Subscription b
mapSubscription f orig = orig {  parseResponses  = map (map f) <$> orig.parseResponses }


Leave notes

Leave notes

module Language.Docopt.Parser.Usage (
    usageParser
  , run
  , parse
  , module U
  ) where

import Prelude
import Debug.Trace
import Control.Lazy (defer)
import Control.MonadPlus (guard)
import Control.Monad.Trans (lift)
import Control.Monad.State (get)
import Control.Alt ((<|>))
import Control.Apply ((*>), (<*))
import Data.Foldable (intercalate)
import Data.List (List(..), many, some, (:), toList, concat, singleton
                  , modifyAt, length)
import Text.Parsing.Parser             as P
import Text.Parsing.Parser.Combinators as P
import Text.Parsing.Parser.Pos         as P
import Text.Parsing.Parser.String      as P
import Data.List as L
import Data.String (fromChar)
import Data.String as Str
import Data.Either (Either(..))
import Data.Tuple (Tuple(..))
import Data.Maybe (Maybe(..), maybe)
import Data.Array as A
import Control.Bind ((=<<))

import Language.Docopt.Parser.Base
import Language.Docopt.Parser.Common
import Language.Docopt.Parser.State
import Language.Docopt.Parser.Usage.Usage
import Language.Docopt.Parser.Usage.Argument
import Language.Docopt.Parser.Usage.Usage  as U
import Language.Docopt.Parser.Lexer        as L
import Language.Docopt.Parser.Usage.Option as O

-- | L.TokenParser to parse the usage section
-- |
-- | This parser is tricky because it has to solve the following problems:
-- |    * What is the program name?
-- |    * Disambiguate between a usage and random text.
-- |    * Disambiguate between a usage and a line-wrapped usage.
-- |
-- | Hence, the following approach is employed:
-- |    * The parser expects a valid program name as first token
-- |    * The parser marks the indent of the first program name
-- |    * Tokens past the identation mark are considered to be part of the
-- |      previous usage pattern.
-- |    * Tokens before the identation mark are NOT considered interesting and
-- |      are IGNORED.
-- |    * A token at the identation mark starts a new usage pattern parse.
-- |
usageParser :: L.TokenParser (List Usage)
usageParser = do

  -- Calculate and mark the original program indentation.
  -- XXX: This needs an update to check if the parser moved onto a new line
  --      after consuming the "program". This happens when the program takes
  --      no input and causes all sorts of trouble.
  name <- program
  col' <- getCol
  let startCol = col' - (Str.length name) - 1
  markIndent' startCol $ do
    Cons
    <$> (usageLine name)
    <*> many do
          P.try do
            program
            usageLine name

  where

    usageLine :: String -> L.TokenParser Usage
    usageLine name = Usage name <$> do
      xs <- (many $ P.try $ moreIndented *> elem) `P.sepBy1` L.vbar
      eoa <- P.choice [
        P.try $ do
          moreIndented *> L.doubleDash
          return $ Just EOA
      , (do
          L.eof <|> (P.lookAhead $ lessIndented <|> sameIndent)
          return Nothing
        )
        -- XXX: We could show the last token that failed to be consumed, here
        P.<?> "start of next usage line or end of usage section"
      ]

      -- Push the EOA onto the last branch (the most right branch)
      return $ maybe xs id do
        e <- eoa
        modifyAt
          (length xs - 1)
          (\as -> as ++ (singleton e))
          xs

    elem :: L.TokenParser Argument
    elem = defer \_ -> do
      P.choice $ P.try <$>
        [ option
        , positional
        , command
        , group
        , reference
        , stdin
        ] P.<?> "Option, Positional, Command, Group or Reference"

    stdin :: L.TokenParser Argument
    stdin = L.dash *> return Stdin

    longOption :: L.TokenParser Argument
    longOption = Option <$> do
      { name: name, arg: arg } <- L.lopt
      O.lopt' name arg <$> repetition

    shortOption :: L.TokenParser Argument
    shortOption = OptionStack <$> do
      { flag: flag, stack: stack, arg: arg } <- L.sopt
      O.sopt' flag stack arg <$> repetition

    option :: L.TokenParser Argument
    option = longOption <|> shortOption

    reference :: L.TokenParser Argument
    reference = Reference <$> L.reference

    positional :: L.TokenParser Argument
    positional = Positional
      <$> (L.angleName <|> L.shoutName)
      <*> repetition

    command :: L.TokenParser Argument
    command = do
      cmd <- Command <$> L.name
      P.notFollowedBy L.tripleDot -- Commands may not repeat!
      pure cmd

    group :: L.TokenParser Argument
    group = defer \_ -> P.choice
      [ reqGroup
      , optGroup ]

    optGroup :: L.TokenParser Argument
    optGroup = defer \_ -> Group true
      <$> (P.between
            (indented *> L.lsquare)
            (L.rsquare)
            ((some elem) `P.sepBy1` L.vbar))
      <*> repetition

    reqGroup :: L.TokenParser Argument
    reqGroup = defer \_ -> Group false
      <$> (P.between
            (indented *> L.lparen)
            (L.rparen)
            ((some elem) `P.sepBy1` L.vbar))
      <*> repetition

    repetition :: L.TokenParser Boolean
    repetition = P.choice
      [ P.try $ indented *> L.tripleDot *> pure true
      , pure false ]

    program :: L.TokenParser String
    program = (L.name <|> L.word) P.<?> "Program Name"

parse :: (List L.PositionedToken) -> Either P.ParseError (List Usage)
parse = flip L.runTokenParser usageParser

run :: String -> Either P.ParseError (List Usage)
run x = parse =<< L.lexUsage x

module Language.Docopt.Parser.Usage (
    usageParser
  , run
  , parse
  , module U
  ) where

import Prelude
import Debug.Trace
import Control.Lazy (defer)
import Control.MonadPlus (guard)
import Control.Monad.Trans (lift)
import Control.Monad.State (get)
import Control.Alt ((<|>))
import Control.Apply ((*>), (<*))
import Data.Foldable (intercalate)
import Data.List (List(..), many, some, (:), toList, concat, singleton
                  , modifyAt, length)
import Text.Parsing.Parser             as P
import Text.Parsing.Parser.Combinators as P
import Text.Parsing.Parser.Pos         as P
import Text.Parsing.Parser.String      as P
import Data.List as L
import Data.String (fromChar)
import Data.String as Str
import Data.Either (Either(..))
import Data.Tuple (Tuple(..))
import Data.Maybe (Maybe(..), maybe)
import Data.Array as A
import Control.Bind ((=<<))

import Language.Docopt.Parser.Base
import Language.Docopt.Parser.Common
import Language.Docopt.Parser.State
import Language.Docopt.Parser.Usage.Usage
import Language.Docopt.Parser.Usage.Argument
import Language.Docopt.Parser.Usage.Usage  as U
import Language.Docopt.Parser.Lexer        as L
import Language.Docopt.Parser.Usage.Option as O

-- | L.TokenParser to parse the usage section
-- |
-- | This parser is tricky because it has to solve the following problems:
-- |    * What is the program name?
-- |    * Disambiguate between a usage and random text.
-- |    * Disambiguate between a usage and a line-wrapped usage.
-- |
-- | Hence, the following approach is employed:
-- |    * The parser expects a valid program name as first token
-- |    * The parser marks the indent of the first program name
-- |    * Tokens past the identation mark are considered to be part of the
-- |      previous usage pattern.
-- |    * Tokens before the identation mark are NOT considered interesting and
-- |      are IGNORED.
-- |    * A token at the identation mark starts a new usage pattern parse.
-- |
usageParser :: L.TokenParser (List Usage)
usageParser = do

  -- Calculate and mark the original program indentation.
  name <- program
  col' <- getCol
  let startCol = col' - (Str.length name) - 1
  markIndent' startCol $ do
    Cons
    <$> (usageLine name)
    <*> many do
          P.try do
            program
            usageLine name

  where

    usageLine :: String -> L.TokenParser Usage
    usageLine name = Usage name <$> do
      xs <- (many $ P.try $ moreIndented *> elem) `P.sepBy1` L.vbar
      eoa <- P.choice [
        P.try $ do
          moreIndented *> L.doubleDash
          return $ Just EOA
      , (do
          L.eof <|> (P.lookAhead $ lessIndented <|> sameIndent)
          return Nothing
        )
        -- XXX: We could show the last token that failed to be consumed, here
        P.<?> "start of next usage line or end of usage section"
      ]

      -- Push the EOA onto the last branch (the most right branch)
      return $ maybe xs id do
        e <- eoa
        modifyAt
          (length xs - 1)
          (\as -> as ++ (singleton e))
          xs

    elem :: L.TokenParser Argument
    elem = defer \_ -> do
      P.choice $ P.try <$>
        [ option
        , positional
        , command
        , group
        , reference
        , stdin
        ] P.<?> "Option, Positional, Command, Group or Reference"

    stdin :: L.TokenParser Argument
    stdin = L.dash *> return Stdin

    longOption :: L.TokenParser Argument
    longOption = Option <$> do
      { name: name, arg: arg } <- L.lopt
      O.lopt' name arg <$> repetition

    shortOption :: L.TokenParser Argument
    shortOption = OptionStack <$> do
      { flag: flag, stack: stack, arg: arg } <- L.sopt
      O.sopt' flag stack arg <$> repetition

    option :: L.TokenParser Argument
    option = longOption <|> shortOption

    reference :: L.TokenParser Argument
    reference = Reference <$> L.reference

    positional :: L.TokenParser Argument
    positional = Positional
      <$> (L.angleName <|> L.shoutName)
      <*> repetition

    command :: L.TokenParser Argument
    command = do
      cmd <- Command <$> L.name
      P.notFollowedBy L.tripleDot -- Commands may not repeat!
      pure cmd

    group :: L.TokenParser Argument
    group = defer \_ -> P.choice
      [ reqGroup
      , optGroup ]

    optGroup :: L.TokenParser Argument
    optGroup = defer \_ -> Group true
      <$> (P.between
            (indented *> L.lsquare)
            (L.rsquare)
            ((some elem) `P.sepBy1` L.vbar))
      <*> repetition

    reqGroup :: L.TokenParser Argument
    reqGroup = defer \_ -> Group false
      <$> (P.between
            (indented *> L.lparen)
            (L.rparen)
            ((some elem) `P.sepBy1` L.vbar))
      <*> repetition

    repetition :: L.TokenParser Boolean
    repetition = P.choice
      [ P.try $ indented *> L.tripleDot *> pure true
      , pure false ]

    program :: L.TokenParser String
    program = (L.name <|> L.word) P.<?> "Program Name"

parse :: (List L.PositionedToken) -> Either P.ParseError (List Usage)
parse = flip L.runTokenParser usageParser

run :: String -> Either P.ParseError (List Usage)
run x = parse =<< L.lexUsage x


[CSE-182] Fix `Loading` state of summary data

module Explorer.Update where

import Prelude

import Control.Comonad (extract)
import Control.Monad.Aff (attempt)
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Class (liftEff)
import Control.Monad.Eff.Now (nowDateTime)
import Control.SocketIO.Client (Socket, SocketIO, emit, emitData)
import DOM (DOM)
import DOM.Event.Event (target, preventDefault)
import DOM.HTML (window)
import DOM.HTML.HTMLElement (blur, focus)
import DOM.HTML.HTMLInputElement (select)
import DOM.HTML.History (DocumentTitle(..), URL(..), pushState)
import DOM.HTML.Window (history)
import DOM.Node.Node (contains)
import DOM.Node.Types (ElementId(..), elementToNode)
import Data.Array (filter, length, snoc, take, (:))
import Data.Either (Either(..))
import Data.Foldable (traverse_)
import Data.Foreign (toForeign)
import Data.Int (fromString)
import Data.Lens ((^.), over, set)
import Data.Maybe (Maybe(..), maybe)
import Data.Newtype (unwrap)
import Data.Tuple (Tuple(..), fst, snd)
import Explorer.Api.Http (fetchAddressSummary, fetchBlockSummary, fetchBlockTxs, fetchBlocksTotalPages, fetchGenesisAddressInfo, fetchGenesisAddressInfoTotalPages, fetchGenesisSummary, fetchLatestTxs, fetchPageBlocks, fetchTxSummary, searchEpoch)
import Explorer.Api.Socket (toEvent)
import Explorer.Api.Types (SocketOffset(..), SocketSubscription(..), SocketSubscriptionData(..))
import Explorer.Lenses.State (addressDetail, addressTxPagination, addressTxPaginationEditable, blockDetail, blockTxPagination, blockTxPaginationEditable, blocksViewState, blsViewPagination, blsViewPaginationEditable, connected, connection, currentAddressSummary, currentBlockSummary, currentBlockTxs, currentBlocksResult, currentCAddress, currentCGenesisAddressInfos, currentCGenesisSummary, currentTxSummary, dbViewBlockPagination, dbViewBlockPaginationEditable, dbViewBlocksExpanded, dbViewLoadingBlockPagination, dbViewMaxBlockPagination, dbViewSelectedApiCode, dbViewTxsExpanded, errors, gViewMobileMenuOpenend, gViewSearchInputFocused, gViewSearchQuery, gViewSearchTimeQuery, gViewSelectedSearch, gWaypoints, gblAddressInfosPagination, gblAddressInfosPaginationEditable, gblLoadingAddressInfosPagination, gblMaxAddressInfosPagination, genesisBlockViewState, globalViewState, lang, latestBlocks, latestTransactions, loading, route, socket, subscriptions, syncAction, viewStates)
import Explorer.Routes (Route(..), match, toUrl)
import Explorer.State (addressQRImageId, emptySearchQuery, emptySearchTimeQuery, headerSearchContainerId, heroSearchContainerId, minPagination, mkSocketSubscriptionItem, mobileMenuSearchContainerId)
import Explorer.Types.Actions (Action(..))
import Explorer.Types.App (AppEffects)
import Explorer.Types.State (PageNumber(..), PageSize(..), Search(..), SocketSubscriptionItem(..), State, WaypointItem(..))
import Explorer.Util.Config (SyncAction(..), syncBySocket)
import Explorer.Util.DOM (addClassToElement, findElementById, removeClassFromElement, scrollTop, nodeToHTMLElement, nodeToHTMLInputElement)
import Explorer.Util.Data (sortTxsByTime', unionTxs)
import Explorer.Util.Factory (mkCAddress, mkCTxId, mkEpochIndex, mkLocalSlotIndex)
import Explorer.Util.QrCode (generateQrCode)
import Explorer.View.Blocks (maxBlockRows)
import Explorer.View.CSS (dashBoardBlocksViewId, headerId, moveIn, moveOut) as CSS
import Explorer.View.Dashboard.Lenses (dashboardViewState)
import Explorer.View.Dashboard.Transactions (maxTransactionRows)
import Explorer.View.GenesisBlock (maxAddressInfoRows)
import Network.RemoteData (RemoteData(..), _Success, isNotAsked, isSuccess, withDefault)
import Pos.Explorer.Socket.Methods (ClientEvent(..), Subscription(..))
import Pos.Explorer.Web.ClientTypes (CAddress(..))
import Pos.Explorer.Web.Lenses.ClientTypes (_CAddress, _CAddressSummary, caAddress, caTxList)
import Pux (EffModel, noEffects, onlyEffects)
import Waypoints (WAYPOINT, destroy, waypoint', up) as WP

update :: forall eff. Action -> State -> EffModel State Action (AppEffects eff)

-- Language

update (SetLanguage lang) state = noEffects $ state { lang = lang }

-- Socket

update (SocketConnected connected') state =
    { state: set (socket <<< connected) connected' state
    , effects:
          [ if connected'
            then pure $ Just SocketReconnectSubscriptions
            else pure Nothing
          ]
    }

update SocketPing state =
    { state
    , effects : [ do
          _ <- case state ^. (socket <<< connection) of
              Just socket' -> liftEff <<< emit socket' $ toEvent CallMe
              Nothing -> pure unit
          pure Nothing
    ]}

update (SocketBlocksPageUpdated (Right (Tuple totalPages blocks))) state =
    noEffects $
    over latestBlocks (\bl -> if updateBlocks then Success blocks else bl) $
    over (dashboardViewState <<< dbViewBlockPagination)
        (\ pn@(PageNumber page) -> if updateCurrentPage then PageNumber totalPages else pn) $
        -- ^ to keep staying at last page we have to update `dbViewBlockPagination`
    set (dashboardViewState <<< dbViewMaxBlockPagination) (Success $ PageNumber totalPages) state
  where
    latestBlocksCheck = if updateBlocks
                        then (Success blocks)
                        else (state ^. latestBlocks)
    currentBlockPage = state ^. (dashboardViewState <<< dbViewBlockPagination)
    updateBlocks = (currentBlockPage == PageNumber totalPages) || updateCurrentPage
    updateCurrentPage = currentBlockPage == (PageNumber $ totalPages - 1) && (length blocks == 1)

update (SocketBlocksPageUpdated (Left error)) state = noEffects $
    set latestBlocks (Failure error) $
    over errors (\errors' -> (show error) : errors') state

update (SocketTxsUpdated (Right txs)) state =
    noEffects $
    over latestTransactions
        (\currentTxs -> Success <<<
                            sortTxsByTime' <<<
                            take maxTransactionRows $
                                unionTxs txs $
                                    withDefault [] currentTxs
        )
    state

update (SocketTxsUpdated (Left error)) state = noEffects $
    -- add incoming errors ahead of previous errors
    over errors (\errors' -> (show error) : errors') state

update (SocketAddressTxsUpdated (Right txs)) state =
    noEffects $
    if isSuccess addrSummary
    then do
        -- Add latest tx on top to other txs of an address
        -- Note: We have to "over" `addrSummary` and set
        -- `currentAddressSummary` explicitly to update the view
        let addrSummary' = over (_Success <<< _CAddressSummary <<< caTxList)
                              (\txs' -> txs <> txs') addrSummary
        set currentAddressSummary addrSummary' state
    else state
    where
        addrSummary = state ^. currentAddressSummary

update (SocketAddressTxsUpdated (Left error)) state = noEffects $
    over errors (\errors' -> (show error) : errors') state

-- | Creates a new socket subscription
update (SocketAddSubscription subItem) state =
    { state:
          over (socket <<< subscriptions) (\subs -> snoc subs subItem) state
    , effects : [ do
          _ <- case state ^. (socket <<< connection) of
              Just socket' -> liftEff $ socketSubscribeEvent socket' subItem
              Nothing -> pure unit
          pure Nothing
    ]}

-- | Removes an existing socket subscription
update (SocketRemoveSubscription subItem) state =
    { state:
          over (socket <<< subscriptions) (filter ((/=) subItem)) state
    , effects : [ do
          _ <- case state ^. (socket <<< connection) of
              Just socket' -> liftEff $ socketUnsubscribeEvent socket' subItem
              Nothing -> pure unit
          pure Nothing
    ]}

-- | Removes all existing socket subscriptions
update (SocketClearSubscriptions) state =
    { state:
          set (socket <<< subscriptions) [] state
    , effects : [ do
          _ <- case state ^. (socket <<< connection) of
              Just socket' -> do
                  traverse_ (liftEff <<< socketUnsubscribeEvent socket')
                      (state ^. socket <<< subscriptions)
              Nothing -> pure unit
          pure Nothing
    ]}

update SocketReconnectSubscriptions state =
    let currentSubs = state ^. socket <<< subscriptions in
    { state
    , effects : [ do
          _ <- case state ^. (socket <<< connection) of
              Just socket' -> do
                -- first unsubscribe from existing subscriptions
                traverse_ (liftEff <<< socketUnsubscribeEvent socket') currentSubs
                -- then subscribe to them again
                traverse_ (liftEff <<< socketSubscribeEvent socket') currentSubs

              Nothing -> pure unit
          pure Nothing
    ]}

-- Dashboard

update (DashboardExpandBlocks expanded) state = noEffects $
    set (dashboardViewState <<< dbViewBlocksExpanded) expanded state

update (DashboardExpandTransactions expanded) state = noEffects $
    set (dashboardViewState <<< dbViewTxsExpanded) expanded state

update (DashboardPaginateBlocks mEvent pageNumber) state =
    { state:
          set (dashboardViewState <<< dbViewBlockPaginationEditable) false state
    , effects:
          [ pure $ maybe Nothing (Just <<< BlurElement <<< nodeToHTMLElement <<< target) mEvent
          -- ^ blur element - needed by iOS to close native keyboard
          , pure <<< Just $ RequestPaginatedBlocks pageNumber (PageSize maxBlockRows)
          ]
    }

update (DashboardEditBlocksPageNumber event editable) state =
    { state:
          set (dashboardViewState <<< dbViewBlockPaginationEditable) editable state
    , effects:
          [ if editable
            then pure <<< Just $ SelectInputText $ nodeToHTMLInputElement (target event)
            else pure Nothing
          ]
    }

update (DashboardInvalidBlocksPageNumber event) state =
    { state:
          set (dashboardViewState <<< dbViewBlockPaginationEditable) false state
    , effects:
          [ pure <<< Just $ BlurElement $ nodeToHTMLElement (target event)
          ]
    }

update (DashboardShowAPICode code) state = noEffects $
    set (dashboardViewState <<< dbViewSelectedApiCode) code state

-- Address

update (AddressPaginateTxs mEvent pageNumber) state =
    { state:
          set (viewStates <<< addressDetail <<< addressTxPagination) pageNumber $
          set (viewStates <<< addressDetail <<< addressTxPaginationEditable) false state
    , effects:
        [ pure $ maybe Nothing (Just <<< BlurElement <<< nodeToHTMLElement <<< target) mEvent
        -- ^ blur element - needed by iOS to close native keyboard
        ]
    }

update (AddressEditTxsPageNumber event editable) state =
    { state:
          set (viewStates <<< addressDetail <<< addressTxPaginationEditable) editable state
    , effects:
          [ if editable
            then pure <<< Just $ SelectInputText $ nodeToHTMLInputElement (target event)
            else pure Nothing
          ]
    }

update (AddressInvalidTxsPageNumber event) state =
    { state:
          set (viewStates <<< addressDetail <<< addressTxPaginationEditable) false state
      , effects:
          [ pure <<< Just $ BlurElement $ nodeToHTMLElement (target event)
          ]
    }

-- Block

update (BlockPaginateTxs mEvent pageNumber) state =
    { state:
          set (viewStates <<< blockDetail <<< blockTxPagination) pageNumber $
          set (viewStates <<< blockDetail <<< blockTxPaginationEditable) false state
    , effects:
        [ pure $ maybe Nothing (Just <<< BlurElement <<< nodeToHTMLElement <<< target) mEvent
        -- ^ blur element - needed by iOS to close native keyboard
        ]
    }

update (BlockEditTxsPageNumber event editable) state =
    { state:
          set (viewStates <<< blockDetail <<< blockTxPaginationEditable) editable state
    , effects:
          [ if editable
            then pure <<< Just $ SelectInputText $ nodeToHTMLInputElement (target event)
            else pure Nothing
          ]
    }

update (BlockInvalidTxsPageNumber event) state =
    { state:
          set (viewStates <<< blockDetail <<< blockTxPaginationEditable) false state
      , effects:
          [ pure <<< Just $ BlurElement $ nodeToHTMLElement (target event)
          ]
    }

-- Blocks

update (BlocksPaginateBlocks mEvent pageNumber) state =
    { state:
          set (viewStates <<< blocksViewState <<< blsViewPagination) pageNumber $
          set (viewStates <<< blocksViewState <<< blsViewPaginationEditable) false state
    , effects:
        [ pure $ maybe Nothing (Just <<< BlurElement <<< nodeToHTMLElement <<< target) mEvent
        -- ^ blur element - needed by iOS to close native keyboard
        ]
    }

update (BlocksEditBlocksPageNumber event editable) state =
    { state:
          set (viewStates <<< blocksViewState <<< blsViewPaginationEditable) editable state
    , effects:
          [ if editable
            then pure <<< Just $ SelectInputText $ nodeToHTMLInputElement (target event)
            else pure Nothing
          ]
    }

update (BlocksInvalidBlocksPageNumber event) state =
    { state:
          set (viewStates <<< blocksViewState <<< blsViewPaginationEditable) false state
      , effects:
          [ pure <<< Just $ BlurElement $ nodeToHTMLElement (target event)
          ]
    }

-- Genesis Block

update (GenesisBlockPaginateAddresses mEvent pageNumber) state =
    { state:
          set (viewStates <<< genesisBlockViewState <<< gblAddressInfosPagination) pageNumber $
          set (viewStates <<< genesisBlockViewState <<< gblAddressInfosPaginationEditable) false state
    , effects:
        [ pure $ maybe Nothing (Just <<< BlurElement <<< nodeToHTMLElement <<< target) mEvent
        -- ^ blur element - needed by iOS to close native keyboard
        , pure <<< Just $ RequestPaginatedAddressInfo pageNumber (PageSize maxAddressInfoRows)
        ]
    }

update (GenesisBlockEditAddressesPageNumber event editable) state =
    { state:
          set (viewStates <<< genesisBlockViewState <<< gblAddressInfosPaginationEditable) editable state
    , effects:
          [ if editable
            then pure <<< Just $ SelectInputText $ nodeToHTMLInputElement (target event)
            else pure Nothing
          ]
    }

update (GenesisBlockInvalidAddressesPageNumber event) state =
    { state:
          set (viewStates <<< genesisBlockViewState <<< gblAddressInfosPaginationEditable) false state
      , effects:
          [ pure <<< Just $ BlurElement $ nodeToHTMLElement (target event)
          ]
    }

-- DOM side effects

update ScrollTop state =
    { state
    , effects:
        case state ^. syncAction of
            -- Don't scroll if we are doing polling
            -- TODO (jk) Remove this workaround if socket-io will be fixed
            SyncByPolling -> [ pure Nothing ]
            SyncBySocket -> [ liftEff scrollTop >>= \_ -> pure Nothing ]
    }

update (SelectInputText input) state =
    { state
    , effects:
        [ liftEff $ select input >>= \_ -> pure Nothing
        ]
    }

update (BlurElement elem) state =
    { state
    , effects:
        [ liftEff $ blur elem >>= \_ -> pure Nothing
        ]
    }

update (FocusElement elem) state =
    { state
    , effects:
        [ liftEff $ focus elem >>= \_ -> pure Nothing
        ]
    }

update (GenerateQrCode address) state =
    { state
    , effects:
        [ liftEff $ generateQrCode (address ^. _CAddress) addressQRImageId *> pure Nothing
        ]
    }

update (DashboardAddWaypoint elementId) state =
    { state
    , effects:
        [ liftEff waypoint >>= \wp -> pure <<< Just <<< StoreWaypoint $ WaypointItem { wpInstance: wp, wpRoute: Dashboard }
        ]
    }
    where
        elId = ElementId CSS.headerId
        callback = \(direction) ->
            if direction == WP.up
                then do
                    addClassToElement elId CSS.moveOut
                    removeClassFromElement elId CSS.moveIn
                else do
                    addClassToElement elId CSS.moveIn
                    removeClassFromElement elId CSS.moveOut

        waypoint = WP.waypoint' elementId callback 71 -- 71 == height of header

update (StoreWaypoint wp) state = noEffects $
    over (viewStates <<< globalViewState <<< gWaypoints) ((:) wp) state

update ClearWaypoints state =
    { state: set (viewStates <<< globalViewState <<< gWaypoints) [] state
    , effects:
          [ do
                traverse_ (liftEff <<< disposeWaypoint) waypointItems
                pure Nothing
          ]
    }
    where
      waypointItems = state ^. (viewStates <<< globalViewState <<< gWaypoints)

      -- | Disposes any `Waypoint` stored in state
      -- | Use it to reverse any changes which might be added by a Waypoint before,
      -- | e.g. adding of new CSS classes or something else
      disposeWaypoint :: forall e. WaypointItem -> Eff (dom :: DOM, waypoint :: WP.WAYPOINT | e) Unit
      disposeWaypoint (WaypointItem item) = do
          _ <- case _.wpRoute item of
                    Dashboard -> do
                      -- remove all css classes which might be added
                      -- by waypoint's callback
                      let elId = ElementId CSS.headerId
                      _ <- removeClassFromElement elId CSS.moveOut
                      _ <- removeClassFromElement elId CSS.moveIn
                      pure unit
                    -- Add any other effects for any other route if needed here
                    _ -> pure unit
          _ <- WP.destroy $ _.wpInstance item
          pure unit

update (DocumentClicked event) state =
    { state
    , effects:
        [ liftEff $
            -- First check here is to see if a search container has been clicked or not.
            -- We do ignore this check if the mobile menue is openend,
            -- because we don't need to do any effects there
            if (not (state ^. (viewStates <<< globalViewState <<< gViewMobileMenuOpenend)))
            then
                do
                -- Check if any children of one of our three search containers has been clicked or not
                  heroSearchContainerClicked <- findElementById heroSearchContainerId >>= elementClicked
                  mobileMenuSearchContainerClicked <- findElementById mobileMenuSearchContainerId >>= elementClicked
                  headerSearchContainerClicked <- findElementById headerSearchContainerId >>= elementClicked
                  -- If any of these children are clicked we know, that the search UI has been set to active (focused)
                  let clicked = heroSearchContainerClicked || mobileMenuSearchContainerClicked || headerSearchContainerClicked
                  pure <<< Just $ GlobalFocusSearchInput clicked
            else
                pure Nothing
        ]
    }
    where
        elementClicked mEl =
            case mEl of
                Just el ->
                    contains (elementToNode el) (target event)
                Nothing ->
                    pure false

-- global state
update (GlobalToggleMobileMenu toggled) state = noEffects $
    set (viewStates <<< globalViewState <<< gViewMobileMenuOpenend) toggled state

update (GlobalFocusSearchInput value) state = noEffects $
    set (viewStates <<< globalViewState <<< gViewSearchInputFocused) value $
    over (viewStates <<< globalViewState <<< gViewSelectedSearch)
        (\selectedSearch ->
              -- return to `SearchAddress` in inactive mode, but not in mobile menu
              if value == false &&
                    (not $ state ^. (viewStates <<< globalViewState <<< gViewMobileMenuOpenend))
              then SearchAddress
              else selectedSearch
        )
    state

update (GlobalSearch event) state =
    let query = state ^. (viewStates <<< globalViewState <<< gViewSearchQuery) in
    { state:
          set (viewStates <<< globalViewState <<< gViewSearchQuery) emptySearchQuery $
          set (viewStates <<< globalViewState <<< gViewMobileMenuOpenend) false $
          state
    , effects:
        [ pure <<< Just $ GlobalFocusSearchInput false
        -- ^ set state of focus explicitly
        , pure <<< Just <<< BlurElement <<< nodeToHTMLElement $ target event
        -- ^ blur element - needed by iOS to close native keyboard
        , case state ^. (viewStates <<< globalViewState <<< gViewSelectedSearch) of
            SearchAddress ->
                pure <<< Just $ Navigate (toUrl <<< Address $ mkCAddress query) event
            SearchTx ->
                pure <<< Just $ Navigate (toUrl <<< Tx $ mkCTxId query) event
            _ -> pure Nothing  -- TODO (ks) maybe put up a message?
        ]
    }
update (GlobalSearchTime event) state =
    let query = state ^. (viewStates <<< globalViewState <<< gViewSearchTimeQuery)
    in
    { state:
          set (viewStates <<< globalViewState <<< gViewSearchTimeQuery) emptySearchTimeQuery $
          set (viewStates <<< globalViewState <<< gViewMobileMenuOpenend) false $
          state
    , effects:
        [ pure <<< Just $ GlobalFocusSearchInput false
          -- ^ set state of focus explicitly
          , pure <<< Just <<< BlurElement <<< nodeToHTMLElement $ target event
          -- ^ blur element - needed by iOS to close native keyboard
          , case query of
                Tuple (Just epoch) (Just slot) ->
                    let epochIndex = mkEpochIndex epoch
                        slotIndex  = mkLocalSlotIndex slot
                        epochSlotUrl = EpochSlot epochIndex slotIndex
                    in
                    pure <<< Just $ Navigate (toUrl epochSlotUrl) event
                Tuple (Just epoch) Nothing ->
                    let epochIndex = mkEpochIndex epoch
                        epochUrl   = Epoch $ epochIndex
                    in
                    pure <<< Just $ Navigate (toUrl epochUrl) event

                _ -> pure Nothing -- TODO (ks) maybe put up a message?
        ]
    }

update (GlobalUpdateSelectedSearch search) state =
    noEffects $
        set (viewStates <<< globalViewState <<< gViewSelectedSearch) search
        state

update (GlobalUpdateSearchValue search) state =
    noEffects $ set (viewStates <<< globalViewState <<< gViewSearchQuery) search state

update (GlobalUpdateSearchEpochValue value) state =
    let slot = snd $ state ^. (viewStates <<< globalViewState <<< gViewSearchTimeQuery)
        epoch = fromString value
    in
    noEffects $ set (viewStates <<< globalViewState <<< gViewSearchTimeQuery) (Tuple epoch slot) state

update (GlobalUpdateSearchSlotValue value) state =
    let slot = fromString value
        epoch = fst $ state ^. (viewStates <<< globalViewState <<< gViewSearchTimeQuery)
    in
    noEffects $ set (viewStates <<< globalViewState <<< gViewSearchTimeQuery) (Tuple epoch slot) state

-- NoOp

update NoOp state = noEffects state

-- http endpoints

update DashboardRequestBlocksTotalPages state =
    { state:
          set loading true $
          set (dashboardViewState <<< dbViewMaxBlockPagination) Loading
          state
    , effects: [ attempt fetchBlocksTotalPages >>= pure <<< Just <<< DashboardReceiveBlocksTotalPages ]
    }

update (DashboardReceiveBlocksTotalPages (Right totalPages)) state =
    { state:
          set loading false $
          set (dashboardViewState <<< dbViewMaxBlockPagination)
              (Success $ PageNumber totalPages) $
          set (dashboardViewState <<< dbViewBlockPagination)
              (PageNumber totalPages) state
    , effects:
        [ pure <<< Just $ DashboardPaginateBlocks Nothing (PageNumber totalPages) ]
    }

update (DashboardReceiveBlocksTotalPages (Left error)) state =
    noEffects $
    set loading false $
    set (dashboardViewState <<< dbViewMaxBlockPagination) (Failure error) $
    over errors (\errors' -> (show error) : errors') state

update (RequestPaginatedBlocks pageNumber pageSize) state =
    { state:
          set loading true $
          set (dashboardViewState <<< dbViewBlockPagination) pageNumber $
          -- Important note: Don't use `set latestBlocks Loading` here,
          -- we will lost all previous `latestBlocks` in this case !!!
          -- set `dbViewLoadingBlockPagination` instead
          set (dashboardViewState <<< dbViewLoadingBlockPagination) true
          state
    , effects: [ attempt (fetchPageBlocks pageNumber pageSize) >>= pure <<< Just <<< ReceivePaginatedBlocks ]
    }

update (ReceivePaginatedBlocks (Right (Tuple totalPages blocks))) state =
    { state:
          set loading false $
          set (dashboardViewState <<< dbViewMaxBlockPagination) (Success $ PageNumber totalPages) $
          set (dashboardViewState <<< dbViewLoadingBlockPagination) false $
          set latestBlocks (Success blocks) state
    , effects:
        if (syncBySocket $ state ^. syncAction)
        then [ pure <<< Just $ SocketAddSubscription subItem ]
        else []
    }
    where
        subItem = mkSocketSubscriptionItem (SocketSubscription SubBlockLastPage) SocketNoData

update (ReceivePaginatedBlocks (Left error)) state =
    noEffects $
    set loading false <<<
    set (dashboardViewState <<< dbViewLoadingBlockPagination) false <<<
    set latestBlocks (Failure error) $
    over errors (\errors' -> (show error) : errors') state

update (RequestBlockSummary hash) state =
    { state:
          set loading true $
          set currentBlockSummary Loading
          state
    , effects: [ attempt (fetchBlockSummary hash) >>= pure <<< Just <<< ReceiveBlockSummary ]
    }
update (ReceiveBlockSummary (Right blockSummary)) state =
    noEffects $
    set loading false $
    set currentBlockSummary (Success blockSummary) state
update (ReceiveBlockSummary (Left error)) state =
    noEffects $
    set loading false $
    set currentBlockSummary (Failure error) $
    over errors (\errors' -> (show error) : errors')
    state

-- Epoch, slot

update (RequestSearchBlocks epoch slot) state =
    { state:
          set loading true $
          set currentBlocksResult Loading
          state
    , effects: [ attempt (searchEpoch epoch slot) >>= pure <<< Just <<< ReceiveSearchBlocks ]
    }
update (ReceiveSearchBlocks (Right blocks)) state =
    noEffects $
    set loading false $
    set currentBlocksResult (Success blocks) state

update (ReceiveSearchBlocks (Left error)) state =
    noEffects $
    set loading false <<<
    set currentBlocksResult (Failure error) $
    over errors (\errors' -> (show error) : errors') state

update (RequestBlockTxs hash) state =
    { state:
          set loading true $
          set currentBlockTxs Loading
          state
    , effects: [ attempt (fetchBlockTxs hash) >>= pure <<< Just <<< ReceiveBlockTxs ]
    }
update (ReceiveBlockTxs (Right txs)) state =
    noEffects $
    set loading false <<<
    set currentBlockTxs (Success txs) $
    state
update (ReceiveBlockTxs (Left error)) state =
    noEffects $
    set loading false $
    set currentBlockTxs (Failure error) $
    over errors (\errors' -> (show error) : errors') state

update (RequestLastTxs) state =
    { state:
          set loading true <<<
          set latestTransactions Loading $
          state
    , effects:
        [ attempt fetchLatestTxs >>= pure <<< Just <<< ReceiveLastTxs
        ]
    }

update (ReceiveLastTxs (Right txs)) state =
    { state:
          set loading false $
          over latestTransactions
              (\currentTxs -> Success <<<
                                  sortTxsByTime' <<<
                                  take maxTransactionRows $
                                      unionTxs txs $
                                          withDefault [] currentTxs
              )
          state
    , effects:
        if (syncBySocket $ state ^. syncAction)
        then [ pure <<< Just $ SocketAddSubscription subItem ]
        else []
    }
    where
        subItem = mkSocketSubscriptionItem (SocketSubscription SubTx) SocketNoData

update (ReceiveLastTxs (Left error)) state = noEffects $
    set loading false $
    over errors (\errors' -> (show error) : errors') state

update (RequestTxSummary id) state =
    { state:
          set loading true $
          set currentTxSummary Loading
          state
    , effects: [ attempt (fetchTxSummary id) >>= pure <<< Just <<< ReceiveTxSummary ]
    }

update (ReceiveTxSummary (Right tx)) state =
    noEffects $
    set loading false $
    set currentTxSummary (Success tx) state

update (ReceiveTxSummary (Left error)) state =
    noEffects $
    set loading false $
    set currentTxSummary (Failure error) $
    over errors (\errors' -> (show error) : errors') state

update (RequestAddressSummary address) state =
    { state:
          set loading true $
          set currentAddressSummary Loading
          state
    , effects: [ attempt (fetchAddressSummary address) >>= pure <<< Just <<< ReceiveAddressSummary ]
    }

update (ReceiveAddressSummary (Right address)) state =
    { state:
        set loading false $
        set currentAddressSummary (Success address) state
    , effects:
        [ pure <<< Just $ GenerateQrCode caAddress'
        ]
        <>  ( if (syncBySocket $ state ^. syncAction)
              then [ pure <<< Just $ SocketAddSubscription subItem ]
              else []
            )
    }
    where
        caAddress' = address ^. (_CAddressSummary <<< caAddress)
        subItem = mkSocketSubscriptionItem (SocketSubscription SubAddr) (SocketCAddressData caAddress')

update (ReceiveAddressSummary (Left error)) state =
    noEffects $
    set loading false $
    set currentAddressSummary (Failure error) $
    over errors (\errors' -> (show error) : errors') state

update RequestGenesisSummary state =
    { state:
          set loading true $
          set currentCGenesisSummary Loading
          state
    , effects:  [ attempt fetchGenesisSummary
                      >>= pure <<< Just <<< ReceiveGenesisSummary
                ]
    }

update (ReceiveGenesisSummary (Right summary)) state =
    noEffects $
    set loading false $
    set currentCGenesisSummary (Success summary) state

update (ReceiveGenesisSummary (Left error)) state =
    noEffects $
    set loading false $
    set currentCGenesisSummary (Failure error) $
    over errors (\errors' -> (show error) : errors') state

update RequestGenesisAddressInfoTotalPages state =
    { state:
          set loading true $
          set (viewStates <<< genesisBlockViewState <<< gblMaxAddressInfosPagination) Loading
          state
    , effects: [ attempt (fetchGenesisAddressInfoTotalPages (PageSize maxAddressInfoRows))
                    >>= pure <<< Just <<< ReceiveGenesisAddressInfoTotalPages
               ]
    }

update (ReceiveGenesisAddressInfoTotalPages (Right totalPages)) state =
    { state:
          set loading false $
          set (viewStates <<< genesisBlockViewState <<< gblMaxAddressInfosPagination)
              (Success $ PageNumber totalPages) state
    , effects:
        [ pure <<< Just $ GenesisBlockPaginateAddresses
                              Nothing
                              (state ^. (viewStates <<< genesisBlockViewState <<< gblAddressInfosPagination))
        ]
    }

update (ReceiveGenesisAddressInfoTotalPages (Left error)) state =
    noEffects $
    set loading false $
    set (viewStates <<< genesisBlockViewState <<< gblMaxAddressInfosPagination)
        (Failure error) $
    over errors (\errors' -> (show error) : errors') state

update (RequestPaginatedAddressInfo pageNumber pageSize) state =
    { state:
          set loading true $
          -- Note: Set `Loading` for first request only!
          -- Setting after next requests, we might lost our previous data of `currentCGenesisAddressInfos`.
          -- The reason is that `RemoteData` does not support a `Refreshing` state atm.
          -- To avoid this, we use a custom loading flag called `gblLoadingAddressInfosPagination`
          -- Hopefully the following PR will be accepted anytime to fix this issue https://github.com/krisajenkins/purescript-remotedata/pull/4
          (if (isNotAsked $ state ^. currentCGenesisAddressInfos)
              then set currentCGenesisAddressInfos Loading
              else set (viewStates <<< genesisBlockViewState <<< gblLoadingAddressInfosPagination) true
          )
          state
    , effects:  [ attempt (fetchGenesisAddressInfo pageNumber pageSize)
                      >>= pure <<< Just <<< ReceivePaginatedAddressInfo
                ]
    }

update (ReceivePaginatedAddressInfo (Right infos)) state =
    noEffects $
    set loading false $
    set (viewStates <<< genesisBlockViewState <<< gblLoadingAddressInfosPagination) false $
    set currentCGenesisAddressInfos (Success infos) state

update (ReceivePaginatedAddressInfo (Left error)) state =
    noEffects $
    set loading false $
    set (viewStates <<< genesisBlockViewState <<< gblLoadingAddressInfosPagination) false $
    set currentCGenesisAddressInfos (Failure error) $
    over errors (\errors' -> (show error) : errors') state

-- clock
update UpdateClock state = onlyEffects state
    [ do
        Just <<< SetClock <<< extract <$> liftEff nowDateTime
    ]

update (SetClock date) state = noEffects $ state { now = date }

-- Reload pages
-- TODO (jk) Remove it if socket-io is back
update Reload state = update (UpdateView state.route) state

-- routing

update (Navigate url ev) state = onlyEffects state
    [ do
        liftEff do
            preventDefault ev
            h <- history =<< window
            -- TODO (jk) Set document title
            pushState (toForeign {}) (DocumentTitle "") (URL url) h
        pure <<< Just $ UpdateView (match url)
    ]

update (UpdateView r@Dashboard) state =
    { state:
        set (viewStates <<< globalViewState <<< gViewMobileMenuOpenend) false $
        set route r state
    , effects:
        [ pure $ Just ScrollTop
        , pure $ Just ClearWaypoints
        , pure <<< Just <<< DashboardAddWaypoint $ ElementId CSS.dashBoardBlocksViewId
        , if isSuccess maxBlockPage
          then pure <<< Just $ DashboardPaginateBlocks Nothing (state ^. (dashboardViewState <<< dbViewBlockPagination))
          else
              -- Note: Request `total pages `only once.
              -- Check is needed due reloading by http pooling
              if isNotAsked maxBlockPage
              then pure $ Just DashboardRequestBlocksTotalPages
              else pure Nothing
        , pure $ Just RequestLastTxs
        ]
    }
    where
        maxBlockPage = state ^. (dashboardViewState <<< dbViewMaxBlockPagination)

update (UpdateView r@(Tx tx)) state =
    { state:
        set route r state
    , effects:
        [ pure $ Just ScrollTop
        , pure $ Just ClearWaypoints
        , pure $ Just SocketClearSubscriptions
        , pure <<< Just $ RequestTxSummary tx
        ]
    }

update (UpdateView r@(Address cAddress)) state =
    { state:
        set currentCAddress cAddress $
        set (viewStates <<< addressDetail <<< addressTxPagination) (PageNumber minPagination) $
        set route r state
    , effects:
        [ pure $ Just ScrollTop
        , pure $ Just ClearWaypoints
        , pure $ Just SocketClearSubscriptions
        , pure <<< Just $ RequestAddressSummary cAddress
        ]
    }

update (UpdateView r@(Epoch epochIndex)) state =
    { state:
        set (viewStates <<< blocksViewState <<< blsViewPagination)
            (PageNumber minPagination) $
        set route r state
    , effects:
        [ pure $ Just ScrollTop
        , pure $ Just ClearWaypoints
        , pure <<< Just $ RequestSearchBlocks epochIndex Nothing
        ]
    }

update (UpdateView r@(EpochSlot epochIndex slotIndex)) state =
    let lang' = state ^. lang

    in
    { state:
        set route r state
    , effects:
        [ pure $ Just ScrollTop
        , pure $ Just ClearWaypoints
        , pure <<< Just $ RequestSearchBlocks epochIndex (Just slotIndex)
        ]
    }

update (UpdateView r@Calculator) state =
    { state:
        set route r state
    , effects:
        [ pure $ Just ScrollTop
        , pure $ Just ClearWaypoints
        ]
    }

update (UpdateView r@(Block hash)) state =
    { state:
        set route r state
    , effects:
        [ pure $ Just ScrollTop
        , pure $ Just ClearWaypoints
        , pure $ Just SocketClearSubscriptions
        , pure <<< Just $ RequestBlockSummary hash
        , pure <<< Just $ RequestBlockTxs hash
        ]
    }

update (UpdateView r@(GenesisBlock)) state =
    { state:
        set route r state
    , effects:
        [ pure $ Just ScrollTop
        , pure $ Just ClearWaypoints
        , pure $ Just SocketClearSubscriptions
        , pure $ Just RequestGenesisSummary
        , pure $ (  if isNotAsked $ state ^. (viewStates <<< genesisBlockViewState <<< gblMaxAddressInfosPagination)
                        -- ^ Before we can get data of `CGenesisAddressInfos`,
                        -- we have to check if we do need
                        -- to load data of `gblMaxAddressInfosPagination` before
                        then Just RequestGenesisAddressInfoTotalPages
                        else Just $ GenesisBlockPaginateAddresses
                                        Nothing
                                        (state ^. (viewStates <<< genesisBlockViewState <<< gblAddressInfosPagination))
                  )
        ]
    }

update (UpdateView r@(Playground)) state =
    { state: set route r state
    , effects:
        [ pure $ Just ScrollTop
        , pure $ Just ClearWaypoints
        , pure $ Just SocketClearSubscriptions
        ]
    }

update (UpdateView r@(NotFound)) state =
    { state:
        set route r state
    , effects:
        [ pure $ Just ScrollTop
        , pure $ Just ClearWaypoints
        , pure $ Just SocketClearSubscriptions
        ]
    }

socketSubscribeEvent :: forall eff . Socket -> SocketSubscriptionItem
    -> Eff (socket :: SocketIO | eff) Unit
socketSubscribeEvent socket (SocketSubscriptionItem item) =
    subscribe socket event subData
    where
        event = toEvent <<< Subscribe <<< unwrap $ _.socketSub item
        subData = _.socketSubData item

        subscribe :: Socket -> String -> SocketSubscriptionData -> Eff (socket :: SocketIO | eff) Unit
        subscribe s e SocketNoData = emit s e
        subscribe s e (SocketOffsetData (SocketOffset o)) = emitData s e o
        subscribe s e (SocketCAddressData (CAddress addr)) = emitData s e addr

socketUnsubscribeEvent :: forall eff . Socket -> SocketSubscriptionItem
    -> Eff (socket :: SocketIO | eff) Unit
socketUnsubscribeEvent socket (SocketSubscriptionItem item)  =
    emit socket event
    where
        event = toEvent <<< Unsubscribe <<< unwrap $ _.socketSub item

module Explorer.Update where

import Prelude

import Control.Comonad (extract)
import Control.Monad.Aff (attempt)
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Class (liftEff)
import Control.Monad.Eff.Now (nowDateTime)
import Control.SocketIO.Client (Socket, SocketIO, emit, emitData)
import DOM (DOM)
import DOM.Event.Event (target, preventDefault)
import DOM.HTML (window)
import DOM.HTML.HTMLElement (blur, focus)
import DOM.HTML.HTMLInputElement (select)
import DOM.HTML.History (DocumentTitle(..), URL(..), pushState)
import DOM.HTML.Window (history)
import DOM.Node.Node (contains)
import DOM.Node.Types (ElementId(..), elementToNode)
import Data.Array (filter, length, snoc, take, (:))
import Data.Either (Either(..))
import Data.Foldable (traverse_)
import Data.Foreign (toForeign)
import Data.Int (fromString)
import Data.Lens ((^.), over, set)
import Data.Maybe (Maybe(..), maybe)
import Data.Newtype (unwrap)
import Data.Tuple (Tuple(..), fst, snd)
import Explorer.Api.Http (fetchAddressSummary, fetchBlockSummary, fetchBlockTxs, fetchBlocksTotalPages, fetchGenesisAddressInfo, fetchGenesisAddressInfoTotalPages, fetchGenesisSummary, fetchLatestTxs, fetchPageBlocks, fetchTxSummary, searchEpoch)
import Explorer.Api.Socket (toEvent)
import Explorer.Api.Types (SocketOffset(..), SocketSubscription(..), SocketSubscriptionData(..))
import Explorer.Lenses.State (addressDetail, addressTxPagination, addressTxPaginationEditable, blockDetail, blockTxPagination, blockTxPaginationEditable, blocksViewState, blsViewPagination, blsViewPaginationEditable, connected, connection, currentAddressSummary, currentBlockSummary, currentBlockTxs, currentBlocksResult, currentCAddress, currentCGenesisAddressInfos, currentCGenesisSummary, currentTxSummary, dbViewBlockPagination, dbViewBlockPaginationEditable, dbViewBlocksExpanded, dbViewLoadingBlockPagination, dbViewMaxBlockPagination, dbViewSelectedApiCode, dbViewTxsExpanded, errors, gViewMobileMenuOpenend, gViewSearchInputFocused, gViewSearchQuery, gViewSearchTimeQuery, gViewSelectedSearch, gWaypoints, gblAddressInfosPagination, gblAddressInfosPaginationEditable, gblLoadingAddressInfosPagination, gblMaxAddressInfosPagination, genesisBlockViewState, globalViewState, lang, latestBlocks, latestTransactions, loading, route, socket, subscriptions, syncAction, viewStates)
import Explorer.Routes (Route(..), match, toUrl)
import Explorer.State (addressQRImageId, emptySearchQuery, emptySearchTimeQuery, headerSearchContainerId, heroSearchContainerId, minPagination, mkSocketSubscriptionItem, mobileMenuSearchContainerId)
import Explorer.Types.Actions (Action(..))
import Explorer.Types.App (AppEffects)
import Explorer.Types.State (PageNumber(..), PageSize(..), Search(..), SocketSubscriptionItem(..), State, WaypointItem(..))
import Explorer.Util.Config (SyncAction(..), syncBySocket)
import Explorer.Util.DOM (addClassToElement, findElementById, removeClassFromElement, scrollTop, nodeToHTMLElement, nodeToHTMLInputElement)
import Explorer.Util.Data (sortTxsByTime', unionTxs)
import Explorer.Util.Factory (mkCAddress, mkCTxId, mkEpochIndex, mkLocalSlotIndex)
import Explorer.Util.QrCode (generateQrCode)
import Explorer.View.Blocks (maxBlockRows)
import Explorer.View.CSS (dashBoardBlocksViewId, headerId, moveIn, moveOut) as CSS
import Explorer.View.Dashboard.Lenses (dashboardViewState)
import Explorer.View.Dashboard.Transactions (maxTransactionRows)
import Explorer.View.GenesisBlock (maxAddressInfoRows)
import Network.RemoteData (RemoteData(..), _Success, isNotAsked, isSuccess, withDefault)
import Pos.Explorer.Socket.Methods (ClientEvent(..), Subscription(..))
import Pos.Explorer.Web.ClientTypes (CAddress(..))
import Pos.Explorer.Web.Lenses.ClientTypes (_CAddress, _CAddressSummary, caAddress, caTxList)
import Pux (EffModel, noEffects, onlyEffects)
import Waypoints (WAYPOINT, destroy, waypoint', up) as WP

update :: forall eff. Action -> State -> EffModel State Action (AppEffects eff)

-- Language

update (SetLanguage lang) state = noEffects $ state { lang = lang }

-- Socket

update (SocketConnected connected') state =
    { state: set (socket <<< connected) connected' state
    , effects:
          [ if connected'
            then pure $ Just SocketReconnectSubscriptions
            else pure Nothing
          ]
    }

update SocketPing state =
    { state
    , effects : [ do
          _ <- case state ^. (socket <<< connection) of
              Just socket' -> liftEff <<< emit socket' $ toEvent CallMe
              Nothing -> pure unit
          pure Nothing
    ]}

update (SocketBlocksPageUpdated (Right (Tuple totalPages blocks))) state =
    noEffects $
    over latestBlocks (\bl -> if updateBlocks then Success blocks else bl) $
    over (dashboardViewState <<< dbViewBlockPagination)
        (\ pn@(PageNumber page) -> if updateCurrentPage then PageNumber totalPages else pn) $
        -- ^ to keep staying at last page we have to update `dbViewBlockPagination`
    set (dashboardViewState <<< dbViewMaxBlockPagination) (Success $ PageNumber totalPages) state
  where
    latestBlocksCheck = if updateBlocks
                        then (Success blocks)
                        else (state ^. latestBlocks)
    currentBlockPage = state ^. (dashboardViewState <<< dbViewBlockPagination)
    updateBlocks = (currentBlockPage == PageNumber totalPages) || updateCurrentPage
    updateCurrentPage = currentBlockPage == (PageNumber $ totalPages - 1) && (length blocks == 1)

update (SocketBlocksPageUpdated (Left error)) state = noEffects $
    set latestBlocks (Failure error) $
    over errors (\errors' -> (show error) : errors') state

update (SocketTxsUpdated (Right txs)) state =
    noEffects $
    over latestTransactions
        (\currentTxs -> Success <<<
                            sortTxsByTime' <<<
                            take maxTransactionRows $
                                unionTxs txs $
                                    withDefault [] currentTxs
        )
    state

update (SocketTxsUpdated (Left error)) state = noEffects $
    -- add incoming errors ahead of previous errors
    over errors (\errors' -> (show error) : errors') state

update (SocketAddressTxsUpdated (Right txs)) state =
    noEffects $
    if isSuccess addrSummary
    then do
        -- Add latest tx on top to other txs of an address
        -- Note: We have to "over" `addrSummary` and set
        -- `currentAddressSummary` explicitly to update the view
        let addrSummary' = over (_Success <<< _CAddressSummary <<< caTxList)
                              (\txs' -> txs <> txs') addrSummary
        set currentAddressSummary addrSummary' state
    else state
    where
        addrSummary = state ^. currentAddressSummary

update (SocketAddressTxsUpdated (Left error)) state = noEffects $
    over errors (\errors' -> (show error) : errors') state

-- | Creates a new socket subscription
update (SocketAddSubscription subItem) state =
    { state:
          over (socket <<< subscriptions) (\subs -> snoc subs subItem) state
    , effects : [ do
          _ <- case state ^. (socket <<< connection) of
              Just socket' -> liftEff $ socketSubscribeEvent socket' subItem
              Nothing -> pure unit
          pure Nothing
    ]}

-- | Removes an existing socket subscription
update (SocketRemoveSubscription subItem) state =
    { state:
          over (socket <<< subscriptions) (filter ((/=) subItem)) state
    , effects : [ do
          _ <- case state ^. (socket <<< connection) of
              Just socket' -> liftEff $ socketUnsubscribeEvent socket' subItem
              Nothing -> pure unit
          pure Nothing
    ]}

-- | Removes all existing socket subscriptions
update (SocketClearSubscriptions) state =
    { state:
          set (socket <<< subscriptions) [] state
    , effects : [ do
          _ <- case state ^. (socket <<< connection) of
              Just socket' -> do
                  traverse_ (liftEff <<< socketUnsubscribeEvent socket')
                      (state ^. socket <<< subscriptions)
              Nothing -> pure unit
          pure Nothing
    ]}

update SocketReconnectSubscriptions state =
    let currentSubs = state ^. socket <<< subscriptions in
    { state
    , effects : [ do
          _ <- case state ^. (socket <<< connection) of
              Just socket' -> do
                -- first unsubscribe from existing subscriptions
                traverse_ (liftEff <<< socketUnsubscribeEvent socket') currentSubs
                -- then subscribe to them again
                traverse_ (liftEff <<< socketSubscribeEvent socket') currentSubs

              Nothing -> pure unit
          pure Nothing
    ]}

-- Dashboard

update (DashboardExpandBlocks expanded) state = noEffects $
    set (dashboardViewState <<< dbViewBlocksExpanded) expanded state

update (DashboardExpandTransactions expanded) state = noEffects $
    set (dashboardViewState <<< dbViewTxsExpanded) expanded state

update (DashboardPaginateBlocks mEvent pageNumber) state =
    { state:
          set (dashboardViewState <<< dbViewBlockPaginationEditable) false state
    , effects:
          [ pure $ maybe Nothing (Just <<< BlurElement <<< nodeToHTMLElement <<< target) mEvent
          -- ^ blur element - needed by iOS to close native keyboard
          , pure <<< Just $ RequestPaginatedBlocks pageNumber (PageSize maxBlockRows)
          ]
    }

update (DashboardEditBlocksPageNumber event editable) state =
    { state:
          set (dashboardViewState <<< dbViewBlockPaginationEditable) editable state
    , effects:
          [ if editable
            then pure <<< Just $ SelectInputText $ nodeToHTMLInputElement (target event)
            else pure Nothing
          ]
    }

update (DashboardInvalidBlocksPageNumber event) state =
    { state:
          set (dashboardViewState <<< dbViewBlockPaginationEditable) false state
    , effects:
          [ pure <<< Just $ BlurElement $ nodeToHTMLElement (target event)
          ]
    }

update (DashboardShowAPICode code) state = noEffects $
    set (dashboardViewState <<< dbViewSelectedApiCode) code state

-- Address

update (AddressPaginateTxs mEvent pageNumber) state =
    { state:
          set (viewStates <<< addressDetail <<< addressTxPagination) pageNumber $
          set (viewStates <<< addressDetail <<< addressTxPaginationEditable) false state
    , effects:
        [ pure $ maybe Nothing (Just <<< BlurElement <<< nodeToHTMLElement <<< target) mEvent
        -- ^ blur element - needed by iOS to close native keyboard
        ]
    }

update (AddressEditTxsPageNumber event editable) state =
    { state:
          set (viewStates <<< addressDetail <<< addressTxPaginationEditable) editable state
    , effects:
          [ if editable
            then pure <<< Just $ SelectInputText $ nodeToHTMLInputElement (target event)
            else pure Nothing
          ]
    }

update (AddressInvalidTxsPageNumber event) state =
    { state:
          set (viewStates <<< addressDetail <<< addressTxPaginationEditable) false state
      , effects:
          [ pure <<< Just $ BlurElement $ nodeToHTMLElement (target event)
          ]
    }

-- Block

update (BlockPaginateTxs mEvent pageNumber) state =
    { state:
          set (viewStates <<< blockDetail <<< blockTxPagination) pageNumber $
          set (viewStates <<< blockDetail <<< blockTxPaginationEditable) false state
    , effects:
        [ pure $ maybe Nothing (Just <<< BlurElement <<< nodeToHTMLElement <<< target) mEvent
        -- ^ blur element - needed by iOS to close native keyboard
        ]
    }

update (BlockEditTxsPageNumber event editable) state =
    { state:
          set (viewStates <<< blockDetail <<< blockTxPaginationEditable) editable state
    , effects:
          [ if editable
            then pure <<< Just $ SelectInputText $ nodeToHTMLInputElement (target event)
            else pure Nothing
          ]
    }

update (BlockInvalidTxsPageNumber event) state =
    { state:
          set (viewStates <<< blockDetail <<< blockTxPaginationEditable) false state
      , effects:
          [ pure <<< Just $ BlurElement $ nodeToHTMLElement (target event)
          ]
    }

-- Blocks

update (BlocksPaginateBlocks mEvent pageNumber) state =
    { state:
          set (viewStates <<< blocksViewState <<< blsViewPagination) pageNumber $
          set (viewStates <<< blocksViewState <<< blsViewPaginationEditable) false state
    , effects:
        [ pure $ maybe Nothing (Just <<< BlurElement <<< nodeToHTMLElement <<< target) mEvent
        -- ^ blur element - needed by iOS to close native keyboard
        ]
    }

update (BlocksEditBlocksPageNumber event editable) state =
    { state:
          set (viewStates <<< blocksViewState <<< blsViewPaginationEditable) editable state
    , effects:
          [ if editable
            then pure <<< Just $ SelectInputText $ nodeToHTMLInputElement (target event)
            else pure Nothing
          ]
    }

update (BlocksInvalidBlocksPageNumber event) state =
    { state:
          set (viewStates <<< blocksViewState <<< blsViewPaginationEditable) false state
      , effects:
          [ pure <<< Just $ BlurElement $ nodeToHTMLElement (target event)
          ]
    }

-- Genesis Block

update (GenesisBlockPaginateAddresses mEvent pageNumber) state =
    { state:
          set (viewStates <<< genesisBlockViewState <<< gblAddressInfosPagination) pageNumber $
          set (viewStates <<< genesisBlockViewState <<< gblAddressInfosPaginationEditable) false state
    , effects:
        [ pure $ maybe Nothing (Just <<< BlurElement <<< nodeToHTMLElement <<< target) mEvent
        -- ^ blur element - needed by iOS to close native keyboard
        , pure <<< Just $ RequestPaginatedAddressInfo pageNumber (PageSize maxAddressInfoRows)
        ]
    }

update (GenesisBlockEditAddressesPageNumber event editable) state =
    { state:
          set (viewStates <<< genesisBlockViewState <<< gblAddressInfosPaginationEditable) editable state
    , effects:
          [ if editable
            then pure <<< Just $ SelectInputText $ nodeToHTMLInputElement (target event)
            else pure Nothing
          ]
    }

update (GenesisBlockInvalidAddressesPageNumber event) state =
    { state:
          set (viewStates <<< genesisBlockViewState <<< gblAddressInfosPaginationEditable) false state
      , effects:
          [ pure <<< Just $ BlurElement $ nodeToHTMLElement (target event)
          ]
    }

-- DOM side effects

update ScrollTop state =
    { state
    , effects:
        case state ^. syncAction of
            -- Don't scroll if we are doing polling
            -- TODO (jk) Remove this workaround if socket-io will be fixed
            SyncByPolling -> [ pure Nothing ]
            SyncBySocket -> [ liftEff scrollTop >>= \_ -> pure Nothing ]
    }

update (SelectInputText input) state =
    { state
    , effects:
        [ liftEff $ select input >>= \_ -> pure Nothing
        ]
    }

update (BlurElement elem) state =
    { state
    , effects:
        [ liftEff $ blur elem >>= \_ -> pure Nothing
        ]
    }

update (FocusElement elem) state =
    { state
    , effects:
        [ liftEff $ focus elem >>= \_ -> pure Nothing
        ]
    }

update (GenerateQrCode address) state =
    { state
    , effects:
        [ liftEff $ generateQrCode (address ^. _CAddress) addressQRImageId *> pure Nothing
        ]
    }

update (DashboardAddWaypoint elementId) state =
    { state
    , effects:
        [ liftEff waypoint >>= \wp -> pure <<< Just <<< StoreWaypoint $ WaypointItem { wpInstance: wp, wpRoute: Dashboard }
        ]
    }
    where
        elId = ElementId CSS.headerId
        callback = \(direction) ->
            if direction == WP.up
                then do
                    addClassToElement elId CSS.moveOut
                    removeClassFromElement elId CSS.moveIn
                else do
                    addClassToElement elId CSS.moveIn
                    removeClassFromElement elId CSS.moveOut

        waypoint = WP.waypoint' elementId callback 71 -- 71 == height of header

update (StoreWaypoint wp) state = noEffects $
    over (viewStates <<< globalViewState <<< gWaypoints) ((:) wp) state

update ClearWaypoints state =
    { state: set (viewStates <<< globalViewState <<< gWaypoints) [] state
    , effects:
          [ do
                traverse_ (liftEff <<< disposeWaypoint) waypointItems
                pure Nothing
          ]
    }
    where
      waypointItems = state ^. (viewStates <<< globalViewState <<< gWaypoints)

      -- | Disposes any `Waypoint` stored in state
      -- | Use it to reverse any changes which might be added by a Waypoint before,
      -- | e.g. adding of new CSS classes or something else
      disposeWaypoint :: forall e. WaypointItem -> Eff (dom :: DOM, waypoint :: WP.WAYPOINT | e) Unit
      disposeWaypoint (WaypointItem item) = do
          _ <- case _.wpRoute item of
                    Dashboard -> do
                      -- remove all css classes which might be added
                      -- by waypoint's callback
                      let elId = ElementId CSS.headerId
                      _ <- removeClassFromElement elId CSS.moveOut
                      _ <- removeClassFromElement elId CSS.moveIn
                      pure unit
                    -- Add any other effects for any other route if needed here
                    _ -> pure unit
          _ <- WP.destroy $ _.wpInstance item
          pure unit

update (DocumentClicked event) state =
    { state
    , effects:
        [ liftEff $
            -- First check here is to see if a search container has been clicked or not.
            -- We do ignore this check if the mobile menue is openend,
            -- because we don't need to do any effects there
            if (not (state ^. (viewStates <<< globalViewState <<< gViewMobileMenuOpenend)))
            then
                do
                -- Check if any children of one of our three search containers has been clicked or not
                  heroSearchContainerClicked <- findElementById heroSearchContainerId >>= elementClicked
                  mobileMenuSearchContainerClicked <- findElementById mobileMenuSearchContainerId >>= elementClicked
                  headerSearchContainerClicked <- findElementById headerSearchContainerId >>= elementClicked
                  -- If any of these children are clicked we know, that the search UI has been set to active (focused)
                  let clicked = heroSearchContainerClicked || mobileMenuSearchContainerClicked || headerSearchContainerClicked
                  pure <<< Just $ GlobalFocusSearchInput clicked
            else
                pure Nothing
        ]
    }
    where
        elementClicked mEl =
            case mEl of
                Just el ->
                    contains (elementToNode el) (target event)
                Nothing ->
                    pure false

-- global state
update (GlobalToggleMobileMenu toggled) state = noEffects $
    set (viewStates <<< globalViewState <<< gViewMobileMenuOpenend) toggled state

update (GlobalFocusSearchInput value) state = noEffects $
    set (viewStates <<< globalViewState <<< gViewSearchInputFocused) value $
    over (viewStates <<< globalViewState <<< gViewSelectedSearch)
        (\selectedSearch ->
              -- return to `SearchAddress` in inactive mode, but not in mobile menu
              if value == false &&
                    (not $ state ^. (viewStates <<< globalViewState <<< gViewMobileMenuOpenend))
              then SearchAddress
              else selectedSearch
        )
    state

update (GlobalSearch event) state =
    let query = state ^. (viewStates <<< globalViewState <<< gViewSearchQuery) in
    { state:
          set (viewStates <<< globalViewState <<< gViewSearchQuery) emptySearchQuery $
          set (viewStates <<< globalViewState <<< gViewMobileMenuOpenend) false $
          state
    , effects:
        [ pure <<< Just $ GlobalFocusSearchInput false
        -- ^ set state of focus explicitly
        , pure <<< Just <<< BlurElement <<< nodeToHTMLElement $ target event
        -- ^ blur element - needed by iOS to close native keyboard
        , case state ^. (viewStates <<< globalViewState <<< gViewSelectedSearch) of
            SearchAddress ->
                pure <<< Just $ Navigate (toUrl <<< Address $ mkCAddress query) event
            SearchTx ->
                pure <<< Just $ Navigate (toUrl <<< Tx $ mkCTxId query) event
            _ -> pure Nothing  -- TODO (ks) maybe put up a message?
        ]
    }
update (GlobalSearchTime event) state =
    let query = state ^. (viewStates <<< globalViewState <<< gViewSearchTimeQuery)
    in
    { state:
          set (viewStates <<< globalViewState <<< gViewSearchTimeQuery) emptySearchTimeQuery $
          set (viewStates <<< globalViewState <<< gViewMobileMenuOpenend) false $
          state
    , effects:
        [ pure <<< Just $ GlobalFocusSearchInput false
          -- ^ set state of focus explicitly
          , pure <<< Just <<< BlurElement <<< nodeToHTMLElement $ target event
          -- ^ blur element - needed by iOS to close native keyboard
          , case query of
                Tuple (Just epoch) (Just slot) ->
                    let epochIndex = mkEpochIndex epoch
                        slotIndex  = mkLocalSlotIndex slot
                        epochSlotUrl = EpochSlot epochIndex slotIndex
                    in
                    pure <<< Just $ Navigate (toUrl epochSlotUrl) event
                Tuple (Just epoch) Nothing ->
                    let epochIndex = mkEpochIndex epoch
                        epochUrl   = Epoch $ epochIndex
                    in
                    pure <<< Just $ Navigate (toUrl epochUrl) event

                _ -> pure Nothing -- TODO (ks) maybe put up a message?
        ]
    }

update (GlobalUpdateSelectedSearch search) state =
    noEffects $
        set (viewStates <<< globalViewState <<< gViewSelectedSearch) search
        state

update (GlobalUpdateSearchValue search) state =
    noEffects $ set (viewStates <<< globalViewState <<< gViewSearchQuery) search state

update (GlobalUpdateSearchEpochValue value) state =
    let slot = snd $ state ^. (viewStates <<< globalViewState <<< gViewSearchTimeQuery)
        epoch = fromString value
    in
    noEffects $ set (viewStates <<< globalViewState <<< gViewSearchTimeQuery) (Tuple epoch slot) state

update (GlobalUpdateSearchSlotValue value) state =
    let slot = fromString value
        epoch = fst $ state ^. (viewStates <<< globalViewState <<< gViewSearchTimeQuery)
    in
    noEffects $ set (viewStates <<< globalViewState <<< gViewSearchTimeQuery) (Tuple epoch slot) state

-- NoOp

update NoOp state = noEffects state

-- http endpoints

update DashboardRequestBlocksTotalPages state =
    { state:
          set loading true $
          set (dashboardViewState <<< dbViewMaxBlockPagination) Loading
          state
    , effects: [ attempt fetchBlocksTotalPages >>= pure <<< Just <<< DashboardReceiveBlocksTotalPages ]
    }

update (DashboardReceiveBlocksTotalPages (Right totalPages)) state =
    { state:
          set loading false $
          set (dashboardViewState <<< dbViewMaxBlockPagination)
              (Success $ PageNumber totalPages) $
          set (dashboardViewState <<< dbViewBlockPagination)
              (PageNumber totalPages) state
    , effects:
        [ pure <<< Just $ DashboardPaginateBlocks Nothing (PageNumber totalPages) ]
    }

update (DashboardReceiveBlocksTotalPages (Left error)) state =
    noEffects $
    set loading false $
    set (dashboardViewState <<< dbViewMaxBlockPagination) (Failure error) $
    over errors (\errors' -> (show error) : errors') state

update (RequestPaginatedBlocks pageNumber pageSize) state =
    { state:
          set loading true $
          set (dashboardViewState <<< dbViewBlockPagination) pageNumber $
          -- Important note: Don't use `set latestBlocks Loading` here,
          -- we will lost all previous `latestBlocks` in this case !!!
          -- set `dbViewLoadingBlockPagination` instead
          set (dashboardViewState <<< dbViewLoadingBlockPagination) true
          state
    , effects: [ attempt (fetchPageBlocks pageNumber pageSize) >>= pure <<< Just <<< ReceivePaginatedBlocks ]
    }

update (ReceivePaginatedBlocks (Right (Tuple totalPages blocks))) state =
    { state:
          set loading false $
          set (dashboardViewState <<< dbViewMaxBlockPagination) (Success $ PageNumber totalPages) $
          set (dashboardViewState <<< dbViewLoadingBlockPagination) false $
          set latestBlocks (Success blocks) state
    , effects:
        if (syncBySocket $ state ^. syncAction)
        then [ pure <<< Just $ SocketAddSubscription subItem ]
        else []
    }
    where
        subItem = mkSocketSubscriptionItem (SocketSubscription SubBlockLastPage) SocketNoData

update (ReceivePaginatedBlocks (Left error)) state =
    noEffects $
    set loading false <<<
    set (dashboardViewState <<< dbViewLoadingBlockPagination) false <<<
    set latestBlocks (Failure error) $
    over errors (\errors' -> (show error) : errors') state

update (RequestBlockSummary hash) state =
    { state:
          set loading true $
          set currentBlockSummary Loading
          state
    , effects: [ attempt (fetchBlockSummary hash) >>= pure <<< Just <<< ReceiveBlockSummary ]
    }
update (ReceiveBlockSummary (Right blockSummary)) state =
    noEffects $
    set loading false $
    set currentBlockSummary (Success blockSummary) state
update (ReceiveBlockSummary (Left error)) state =
    noEffects $
    set loading false $
    set currentBlockSummary (Failure error) $
    over errors (\errors' -> (show error) : errors')
    state

-- Epoch, slot

update (RequestSearchBlocks epoch slot) state =
    { state:
          set loading true $
          set currentBlocksResult Loading
          state
    , effects: [ attempt (searchEpoch epoch slot) >>= pure <<< Just <<< ReceiveSearchBlocks ]
    }
update (ReceiveSearchBlocks (Right blocks)) state =
    noEffects $
    set loading false $
    set currentBlocksResult (Success blocks) state

update (ReceiveSearchBlocks (Left error)) state =
    noEffects $
    set loading false <<<
    set currentBlocksResult (Failure error) $
    over errors (\errors' -> (show error) : errors') state

update (RequestBlockTxs hash) state =
    { state:
          set loading true $
          set currentBlockTxs Loading
          state
    , effects: [ attempt (fetchBlockTxs hash) >>= pure <<< Just <<< ReceiveBlockTxs ]
    }
update (ReceiveBlockTxs (Right txs)) state =
    noEffects $
    set loading false <<<
    set currentBlockTxs (Success txs) $
    state
update (ReceiveBlockTxs (Left error)) state =
    noEffects $
    set loading false $
    set currentBlockTxs (Failure error) $
    over errors (\errors' -> (show error) : errors') state

update (RequestLastTxs) state =
    { state:
          set loading true <<<
          set latestTransactions Loading $
          state
    , effects:
        [ attempt fetchLatestTxs >>= pure <<< Just <<< ReceiveLastTxs
        ]
    }

update (ReceiveLastTxs (Right txs)) state =
    { state:
          set loading false $
          over latestTransactions
              (\currentTxs -> Success <<<
                                  sortTxsByTime' <<<
                                  take maxTransactionRows $
                                      unionTxs txs $
                                          withDefault [] currentTxs
              )
          state
    , effects:
        if (syncBySocket $ state ^. syncAction)
        then [ pure <<< Just $ SocketAddSubscription subItem ]
        else []
    }
    where
        subItem = mkSocketSubscriptionItem (SocketSubscription SubTx) SocketNoData

update (ReceiveLastTxs (Left error)) state = noEffects $
    set loading false $
    over errors (\errors' -> (show error) : errors') state

update (RequestTxSummary id) state =
    { state:
          set loading true $
          set currentTxSummary Loading
          state
    , effects: [ attempt (fetchTxSummary id) >>= pure <<< Just <<< ReceiveTxSummary ]
    }

update (ReceiveTxSummary (Right tx)) state =
    noEffects $
    set loading false $
    set currentTxSummary (Success tx) state

update (ReceiveTxSummary (Left error)) state =
    noEffects $
    set loading false $
    set currentTxSummary (Failure error) $
    over errors (\errors' -> (show error) : errors') state

update (RequestAddressSummary address) state =
    { state:
          set loading true $
          set currentAddressSummary Loading
          state
    , effects: [ attempt (fetchAddressSummary address) >>= pure <<< Just <<< ReceiveAddressSummary ]
    }

update (ReceiveAddressSummary (Right address)) state =
    { state:
        set loading false $
        set currentAddressSummary (Success address) state
    , effects:
        [ pure <<< Just $ GenerateQrCode caAddress'
        ]
        <>  ( if (syncBySocket $ state ^. syncAction)
              then [ pure <<< Just $ SocketAddSubscription subItem ]
              else []
            )
    }
    where
        caAddress' = address ^. (_CAddressSummary <<< caAddress)
        subItem = mkSocketSubscriptionItem (SocketSubscription SubAddr) (SocketCAddressData caAddress')

update (ReceiveAddressSummary (Left error)) state =
    noEffects $
    set loading false $
    set currentAddressSummary (Failure error) $
    over errors (\errors' -> (show error) : errors') state

update RequestGenesisSummary state =
    { state:
          set loading true $
          set currentCGenesisSummary Loading
          state
    , effects:  [ attempt fetchGenesisSummary
                      >>= pure <<< Just <<< ReceiveGenesisSummary
                ]
    }

update (ReceiveGenesisSummary (Right summary)) state =
    noEffects $
    set loading false $
    set currentCGenesisSummary (Success summary) state

update (ReceiveGenesisSummary (Left error)) state =
    noEffects $
    set loading false $
    set currentCGenesisSummary (Failure error) $
    over errors (\errors' -> (show error) : errors') state

update RequestGenesisAddressInfoTotalPages state =
    { state:
          set loading true $
          set (viewStates <<< genesisBlockViewState <<< gblMaxAddressInfosPagination) Loading
          state
    , effects: [ attempt (fetchGenesisAddressInfoTotalPages (PageSize maxAddressInfoRows))
                    >>= pure <<< Just <<< ReceiveGenesisAddressInfoTotalPages
               ]
    }

update (ReceiveGenesisAddressInfoTotalPages (Right totalPages)) state =
    { state:
          set loading false $
          set (viewStates <<< genesisBlockViewState <<< gblMaxAddressInfosPagination)
              (Success $ PageNumber totalPages) state
    , effects:
        [ pure <<< Just $ GenesisBlockPaginateAddresses
                              Nothing
                              (state ^. (viewStates <<< genesisBlockViewState <<< gblAddressInfosPagination))
        ]
    }

update (ReceiveGenesisAddressInfoTotalPages (Left error)) state =
    noEffects $
    set loading false $
    set (viewStates <<< genesisBlockViewState <<< gblMaxAddressInfosPagination)
        (Failure error) $
    over errors (\errors' -> (show error) : errors') state

update (RequestPaginatedAddressInfo pageNumber pageSize) state =
    { state:
          set loading true $
          -- Note: Set `Loading` for first request only!
          -- Setting after next requests, we might lost our previous data of `currentCGenesisAddressInfos`.
          -- The reason is that `RemoteData` does not support a `Refreshing` state atm.
          -- To avoid this, we use a custom loading flag called `gblLoadingAddressInfosPagination`
          -- Hopefully the following PR will be accepted anytime to fix this issue https://github.com/krisajenkins/purescript-remotedata/pull/4
          (if (isNotAsked $ state ^. currentCGenesisAddressInfos)
              then set currentCGenesisAddressInfos Loading
              else set (viewStates <<< genesisBlockViewState <<< gblLoadingAddressInfosPagination) true
          ) $
          set currentCGenesisSummary Loading
          state
    , effects:  [ attempt (fetchGenesisAddressInfo pageNumber pageSize)
                      >>= pure <<< Just <<< ReceivePaginatedAddressInfo
                ]
    }

update (ReceivePaginatedAddressInfo (Right infos)) state =
    noEffects $
    set loading false $
    set (viewStates <<< genesisBlockViewState <<< gblLoadingAddressInfosPagination) false $
    set currentCGenesisAddressInfos (Success infos) state

update (ReceivePaginatedAddressInfo (Left error)) state =
    noEffects $
    set loading false $
    set (viewStates <<< genesisBlockViewState <<< gblLoadingAddressInfosPagination) false $
    set currentCGenesisAddressInfos (Failure error) $
    over errors (\errors' -> (show error) : errors') state

-- clock
update UpdateClock state = onlyEffects state
    [ do
        Just <<< SetClock <<< extract <$> liftEff nowDateTime
    ]

update (SetClock date) state = noEffects $ state { now = date }

-- Reload pages
-- TODO (jk) Remove it if socket-io is back
update Reload state = update (UpdateView state.route) state

-- routing

update (Navigate url ev) state = onlyEffects state
    [ do
        liftEff do
            preventDefault ev
            h <- history =<< window
            -- TODO (jk) Set document title
            pushState (toForeign {}) (DocumentTitle "") (URL url) h
        pure <<< Just $ UpdateView (match url)
    ]

update (UpdateView r@Dashboard) state =
    { state:
        set (viewStates <<< globalViewState <<< gViewMobileMenuOpenend) false $
        set route r state
    , effects:
        [ pure $ Just ScrollTop
        , pure $ Just ClearWaypoints
        , pure <<< Just <<< DashboardAddWaypoint $ ElementId CSS.dashBoardBlocksViewId
        , if isSuccess maxBlockPage
          then pure <<< Just $ DashboardPaginateBlocks Nothing (state ^. (dashboardViewState <<< dbViewBlockPagination))
          else
              -- Note: Request `total pages `only once.
              -- Check is needed due reloading by http pooling
              if isNotAsked maxBlockPage
              then pure $ Just DashboardRequestBlocksTotalPages
              else pure Nothing
        , pure $ Just RequestLastTxs
        ]
    }
    where
        maxBlockPage = state ^. (dashboardViewState <<< dbViewMaxBlockPagination)

update (UpdateView r@(Tx tx)) state =
    { state:
        set route r state
    , effects:
        [ pure $ Just ScrollTop
        , pure $ Just ClearWaypoints
        , pure $ Just SocketClearSubscriptions
        , pure <<< Just $ RequestTxSummary tx
        ]
    }

update (UpdateView r@(Address cAddress)) state =
    { state:
        set currentCAddress cAddress $
        set (viewStates <<< addressDetail <<< addressTxPagination) (PageNumber minPagination) $
        set route r state
    , effects:
        [ pure $ Just ScrollTop
        , pure $ Just ClearWaypoints
        , pure $ Just SocketClearSubscriptions
        , pure <<< Just $ RequestAddressSummary cAddress
        ]
    }

update (UpdateView r@(Epoch epochIndex)) state =
    { state:
        set (viewStates <<< blocksViewState <<< blsViewPagination)
            (PageNumber minPagination) $
        set route r state
    , effects:
        [ pure $ Just ScrollTop
        , pure $ Just ClearWaypoints
        , pure <<< Just $ RequestSearchBlocks epochIndex Nothing
        ]
    }

update (UpdateView r@(EpochSlot epochIndex slotIndex)) state =
    let lang' = state ^. lang

    in
    { state:
        set route r state
    , effects:
        [ pure $ Just ScrollTop
        , pure $ Just ClearWaypoints
        , pure <<< Just $ RequestSearchBlocks epochIndex (Just slotIndex)
        ]
    }

update (UpdateView r@Calculator) state =
    { state:
        set route r state
    , effects:
        [ pure $ Just ScrollTop
        , pure $ Just ClearWaypoints
        ]
    }

update (UpdateView r@(Block hash)) state =
    { state:
        set route r state
    , effects:
        [ pure $ Just ScrollTop
        , pure $ Just ClearWaypoints
        , pure $ Just SocketClearSubscriptions
        , pure <<< Just $ RequestBlockSummary hash
        , pure <<< Just $ RequestBlockTxs hash
        ]
    }

update (UpdateView r@(GenesisBlock)) state =
    { state:
        set route r state
    , effects:
        [ pure $ Just ScrollTop
        , pure $ Just ClearWaypoints
        , pure $ Just SocketClearSubscriptions
        , pure $ Just RequestGenesisSummary
        , pure $ (  if isNotAsked $ state ^. (viewStates <<< genesisBlockViewState <<< gblMaxAddressInfosPagination)
                        -- ^ Before we can get data of `CGenesisAddressInfos`,
                        -- we have to check if we do need
                        -- to load data of `gblMaxAddressInfosPagination` before
                        then Just RequestGenesisAddressInfoTotalPages
                        else Just $ GenesisBlockPaginateAddresses
                                        Nothing
                                        (state ^. (viewStates <<< genesisBlockViewState <<< gblAddressInfosPagination))
                  )
        ]
    }

update (UpdateView r@(Playground)) state =
    { state: set route r state
    , effects:
        [ pure $ Just ScrollTop
        , pure $ Just ClearWaypoints
        , pure $ Just SocketClearSubscriptions
        ]
    }

update (UpdateView r@(NotFound)) state =
    { state:
        set route r state
    , effects:
        [ pure $ Just ScrollTop
        , pure $ Just ClearWaypoints
        , pure $ Just SocketClearSubscriptions
        ]
    }

socketSubscribeEvent :: forall eff . Socket -> SocketSubscriptionItem
    -> Eff (socket :: SocketIO | eff) Unit
socketSubscribeEvent socket (SocketSubscriptionItem item) =
    subscribe socket event subData
    where
        event = toEvent <<< Subscribe <<< unwrap $ _.socketSub item
        subData = _.socketSubData item

        subscribe :: Socket -> String -> SocketSubscriptionData -> Eff (socket :: SocketIO | eff) Unit
        subscribe s e SocketNoData = emit s e
        subscribe s e (SocketOffsetData (SocketOffset o)) = emitData s e o
        subscribe s e (SocketCAddressData (CAddress addr)) = emitData s e addr

socketUnsubscribeEvent :: forall eff . Socket -> SocketSubscriptionItem
    -> Eff (socket :: SocketIO | eff) Unit
socketUnsubscribeEvent socket (SocketSubscriptionItem item)  =
    emit socket event
    where
        event = toEvent <<< Unsubscribe <<< unwrap $ _.socketSub item