Loader.purs 5.13 KB
Newer Older
1 2
module Gargantext.Components.Loader where

3
import Control.Monad.Cont.Trans (lift)
4 5
import Data.Maybe (Maybe(..))
import React as React
6
import React (ReactClass, Children)
7
import Gargantext.Prelude
8
import Effect (Effect)
9 10 11
import Effect.Aff (Aff)

import Thermite (Render, PerformAction, simpleSpec, modifyState_, createReactSpec)
12

13 14
data Action path = ForceReload | SetPath path

15 16 17
type InnerPropsRow path loaded row =
  ( path     :: path
  , loaded   :: loaded
18
  , dispatch :: Action path -> Effect Unit
19 20 21 22
  | row
  )

type InnerProps path loaded row = Record (InnerPropsRow path loaded row)
23

24 25
type InnerClass path loaded = ReactClass (InnerProps path loaded (children :: Children))

26
type PropsRow path loaded row =
27
  ( path      :: path
28
  , component :: InnerClass path loaded
29
  | row
30 31
  )

32
type Props path loaded = Record (PropsRow path loaded (children :: Children))
33

34
type Props' path loaded = Record (PropsRow path loaded ())
35

36
type State path loaded = { currentPath :: path, loaded :: Maybe loaded }
37

38 39
createLoaderClass' :: forall path loaded props
                    . Eq path
40
                   => Show path
41 42 43 44 45
                   => String
                   -> (path -> Aff loaded)
                   -> Render (State path loaded) {path :: path | props} (Action path)
                   -> ReactClass { path :: path, children :: Children | props }
createLoaderClass' name loader render =
46 47
  React.component name
    (\this -> do
48
       logs $ "createLoaderClass' " <> name
49 50 51
       s <- spec this
       pure { state: s.state
            , render: s.render
52 53 54 55
            , componentDidMount: do
                logs $ name <> ".componentDidMount"
                dispatcher this ForceReload
            , componentDidUpdate: \{path: prevPath} {currentPath} _snapshot -> do
56
                {path} <- React.getProps this
57
                logs $ name <> ".componentDidUpdate " <> show {currentPath, path, prevPath}
58
                -- This guard is the similar to the one in performAction (SetPath ...),
59 60
                -- however we need it here to avoid potential infinite loops.
                -- https://reactjs.org/docs/react-component.html#componentdidupdate
61 62 63 64 65 66
                -- Moreover we want to make sure that not only the new prop
                -- `path` is different from the one in the state (`currentPath`)
                -- but also that it is different than the previous `path` prop
                -- (`prevPath`). This avoid the path being reset to the
                -- previous value.
                when (prevPath /= path && path /= currentPath) do
67
                  dispatcher this (SetPath path)
68 69 70 71
            })
  where
    initialState {path} = {currentPath: path, loaded: Nothing}

72
    performAction :: PerformAction (State path loaded) {path :: path | props} (Action path)
73
    performAction ForceReload _ {currentPath} = do
74
      logs $ name <> ".ForceReload {currentPath: " <> show currentPath <> "}"
75 76
      loaded <- lift $ loader currentPath
      modifyState_ $ _ { loaded = Just loaded }
77 78
    performAction (SetPath newPath) _ {currentPath} = do
      logs $ name <> ".SetPath " <> show {newPath, currentPath}
79
      when (newPath /= currentPath) do
80 81 82 83
        loaded <- lift $ loader newPath
        modifyState_ $ _ { currentPath = newPath, loaded = Just loaded }

    {spec, dispatcher} = createReactSpec (simpleSpec performAction render) initialState
84

85 86 87
type LoaderClass path loaded =
  ReactClass (Record (PropsRow path loaded (children :: Children)))

88
createLoaderClass :: forall path loaded
89
                   . Eq path
90
                  => Show path
91 92
                  => String
                  -> (path -> Aff loaded)
93
                  -> LoaderClass path loaded
94 95 96
createLoaderClass name loader =
    createLoaderClass' name loader render
  where
97
    render :: Render (State path loaded) (Props' path loaded) (Action path)
98 99 100 101
    render _ _ {loaded: Nothing} _ =
      -- TODO load spinner
      []
    render dispatch {component} {currentPath, loaded: Just loaded} c =
102
      [React.createElement component {path: currentPath, loaded, dispatch} c]
103

104
{-
105
createLoaderClass :: forall path loaded
106
                   . String
107
                  -> (path -> Aff loaded)
108
                  -> ReactClass (Props path loaded)
109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134
createLoaderClass name loader = React.component name mk
  where
    mk this =
      pure
        { state: { loaded: Nothing, fiber: Nothing }
        , componentDidMount: do
            logs "componentDidMount"
            {path} <- React.getProps this
            fiber <- launchAff $ do
              newState <- loader path
              makeAff $ \cb -> do
                void $ React.modifyStateWithCallback
                         this
                         (_ {loaded = Just newState})
                         (cb (Right unit))
                pure nonCanceler
            React.modifyState this (_ { fiber = Just fiber })
        , componentWillUnmount: do
            {fiber} <- React.getState this
            traverse_ (launchAff_ <<< killFiber (error "Loader: killFiber"))
                      fiber
        , render: do
            {path, component} <- React.getProps this
            {loaded} <- React.getState this
            pure $ React.createElement component {path, loaded} []
        }
135
-}