Loader.purs 7.26 KB
Newer Older
1 2
module Gargantext.Hooks.Loader where

3 4
import Gargantext.Prelude

5
import Data.Array as A
6
import Data.Either (Either(..))
7
import Data.Generic.Rep (class Generic)
8
import Data.Maybe (Maybe(..), isJust, maybe)
9
import Data.Newtype (class Newtype)
10
import Effect (Effect)
11
import Effect.Aff (Aff, launchAff_, throwError)
12
import Effect.Class (liftEffect)
13
import Effect.Exception (error)
arturo's avatar
arturo committed
14
import Gargantext.Components.App.Store (Boxes)
15
import Gargantext.Components.LoadingSpinner (loadingSpinner)
16
import Gargantext.Config.REST (RESTError, AffRESTError)
17 18
import Gargantext.Config.Utils (handleRESTError)
import Gargantext.Types (FrontendError(..))
19
import Gargantext.Utils.CacheAPI as GUC
20
import Gargantext.Utils.Crypto (Hash)
21
import Gargantext.Utils.Reactix as R2
22 23 24
import Reactix as R
import Simple.JSON as JSON
import Toestand as T
25

26 27 28
here :: R2.Here
here = R2.here "Gargantext.Hooks.Loader"

29 30 31 32 33 34
cacheName :: String
cacheName = "cache-api-loader"

clearCache :: Unit -> Aff Unit
clearCache _ = GUC.delete $ GUC.CacheName cacheName

35 36
type UseLoader path state =
  ( errorHandler :: RESTError -> Effect Unit
37
  , loader       :: path -> AffRESTError state
38 39 40
  , path         :: path
  , render       :: state -> R.Element
  )
41

42
useLoader :: forall path st. Eq path => Eq st
43
          => Record (UseLoader path st)
44
          -> R.Hooks R.Element
45
useLoader { errorHandler, loader: loader', path, render } = do
46 47
  state <- T.useBox Nothing

48
  useLoaderEffect { errorHandler, loader: loader', path, state: state }
49

50
  pure $ loader { render, state } []
51 52


53 54
type LoaderProps st =
  ( render :: st -> R.Element
55 56
  , state  :: T.Box (Maybe st) )

57
loader :: forall st. Eq st => R2.Component (LoaderProps st)
58
loader = R.createElement loaderCpt
59
loaderCpt :: forall st. Eq st => R.Component (LoaderProps st)
60 61
loaderCpt = here.component "loader" cpt
  where
62
    cpt { render, state } _ = do
63 64
      state' <- T.useLive T.unequal state

65
      pure $ maybe (loadingSpinner { additionalClass: Nothing }) render state'
66

67 68
type UseLoaderEffect path state =
  ( errorHandler :: RESTError -> Effect Unit
69
  , loader       :: path -> AffRESTError state
70 71 72
  , path         :: path
  , state        :: T.Box (Maybe state)
  )
73

74 75
useLoaderEffect :: forall st path. Eq path => Eq st
                   => Record (UseLoaderEffect path st)
76
                   -> R.Hooks Unit
77
useLoaderEffect { errorHandler, loader: loader', path, state } = do
78
  state' <- T.useLive T.unequal state
79
  oPath <- R.useRef path
80

81
  R.useEffect' $ do
James Laver's avatar
James Laver committed
82 83 84
    path' <- R.readRefM oPath
    if (path' == path) && (isJust state')
    then pure $ R.nothing
85 86
    else do
      R.setRef oPath path
87
      R2.affEffect "G.H.Loader.useLoaderEffect" $ do
88
        l <- loader' path
89
        case l of
90
          Left err -> liftEffect $ errorHandler err
91
          Right l' -> liftEffect $ T.write_ (Just l') state
92 93


94 95
type UseLoaderBox path state =
  ( errorHandler :: RESTError -> Effect Unit
96
  , loader       :: path -> AffRESTError state
97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112
  , path         :: T.Box path
  , render       :: state -> R.Element
  )

useLoaderBox :: forall path st. Eq path => Eq st
          => Record (UseLoaderBox path st)
          -> R.Hooks R.Element
useLoaderBox { errorHandler, loader: loader', path, render } = do
  state <- T.useBox Nothing

  useLoaderBoxEffect { errorHandler, loader: loader', path, state: state }

  pure $ loader { render, state } []

type UseLoaderBoxEffect path state =
  ( errorHandler :: RESTError -> Effect Unit
113
  , loader       :: path -> AffRESTError state
114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131
  , path         :: T.Box path
  , state        :: T.Box (Maybe state)
  )

useLoaderBoxEffect :: forall st path. Eq path => Eq st
                   => Record (UseLoaderBoxEffect path st)
                   -> R.Hooks Unit
useLoaderBoxEffect { errorHandler, loader: loader', path, state } = do
  path' <- T.useLive T.unequal path

  R.useEffect' $ do
    R2.affEffect "G.H.Loader.useLoaderBoxEffect" $ do
      l <- loader' path'
      case l of
        Left err -> liftEffect $ errorHandler err
        Right l' -> liftEffect $ T.write_ (Just l') state


James Laver's avatar
James Laver committed
132
newtype HashedResponse a = HashedResponse { hash  :: Hash, value :: a }
133 134 135 136
derive instance Generic (HashedResponse a) _
derive instance Newtype (HashedResponse a) _
derive newtype instance JSON.ReadForeign a => JSON.ReadForeign (HashedResponse a)
derive newtype instance JSON.WriteForeign a => JSON.WriteForeign (HashedResponse a)
137

138 139
type LoaderWithCacheAPIProps path res ret =
  ( boxes          :: Boxes
140
  , cacheEndpoint  :: path -> AffRESTError Hash
141
  , handleResponse :: HashedResponse res -> ret
142 143 144
  , mkRequest      :: path -> GUC.Request
  , path           :: path
  , renderer       :: ret -> R.Element
145
  , spinnerClass   :: Maybe String
146 147
  )

148
useLoaderWithCacheAPI :: forall path res ret.
149
                         Eq ret => Eq path => JSON.ReadForeign res =>
150 151
                         Record (LoaderWithCacheAPIProps path res ret)
                      -> R.Hooks R.Element
152 153 154 155 156
useLoaderWithCacheAPI { boxes
                      , cacheEndpoint
                      , handleResponse
                      , mkRequest
                      , path
157 158
                      , renderer
                      , spinnerClass } = do
159 160 161
  state <- T.useBox Nothing
  state' <- T.useLive T.unequal state

162 163
  useCachedAPILoaderEffect { boxes
                           , cacheEndpoint
164 165 166 167
                           , handleResponse
                           , mkRequest
                           , path
                           , state }
168
  pure $ maybe (loadingSpinner { additionalClass: spinnerClass }) renderer state'
169

170
type LoaderWithCacheAPIEffectProps path res ret = (
171
    boxes          :: Boxes
172
  , cacheEndpoint  :: path -> AffRESTError Hash
173
  , handleResponse :: HashedResponse res -> ret
174 175 176
  , mkRequest      :: path -> GUC.Request
  , path           :: path
  , state          :: T.Box (Maybe ret)
177 178
  )

179
useCachedAPILoaderEffect :: forall path res ret.
180
                            Eq ret => Eq path => JSON.ReadForeign res =>
181 182
                            Record (LoaderWithCacheAPIEffectProps path res ret)
                         -> R.Hooks Unit
183 184
useCachedAPILoaderEffect { boxes: { errors }
                         , cacheEndpoint
185 186 187
                         , handleResponse
                         , mkRequest
                         , path
188 189
                         , state } = do
  state' <- T.useLive T.unequal state
190 191 192 193 194 195 196 197 198 199 200 201 202
  oPath <- R.useRef path

  R.useEffect' $ do
    if (R.readRef oPath == path) && (isJust state') then
      pure unit
    else do
      R.setRef oPath path

      let req = mkRequest path
      -- log2 "[useCachedLoader] mState" mState
      launchAff_ $ do
        cache <- GUC.openCache $ GUC.CacheName cacheName
        -- TODO Parallelize?
203
        hr@(HashedResponse { hash }) <- GUC.cachedJson cache req
204 205 206 207 208 209 210 211 212
        eCacheReal <- cacheEndpoint path
        handleRESTError errors eCacheReal $ \cacheReal -> do
          val <- if hash == cacheReal then
            pure hr
          else do
            _ <- GUC.deleteReq cache req
            hr'@(HashedResponse { hash: h }) <- GUC.cachedJson cache req
            if h == cacheReal then
              pure hr'
213
            else do
214 215 216 217 218
              let err = "[Hooks.Loader] Fetched clean cache but hashes don't match: " <> h <> " != " <> cacheReal
              liftEffect $ T.modify_ (A.cons $ FStringError { error: err }) errors
              throwError $ error err
          liftEffect $ do
            T.write_ (Just $ handleResponse val) state