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

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

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
type UseLoader path state =
36 37
  ( errorHandler :: Maybe (RESTError -> Effect Unit)
  , herePrefix   :: R2.HerePrefix
38
  , loader       :: path -> AffRESTError state
39 40 41
  , path         :: path
  , render       :: state -> R.Element
  )
42

43
useLoader :: forall path st. Eq path => Eq st
44
          => Record (UseLoader path st)
45
          -> R.Hooks R.Element
46 47 48 49 50
useLoader { errorHandler
          , herePrefix
          , loader
          , path
          , render } = do
51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77
  { errors } <- Store.use

  useLoader' { errorHandler: errorHandler' errors
             , loader
             , path
             , render }
  where
    errorHandler' errors error = do
      T.modify_ (A.cons $ FRESTError { error }) errors
      -- default error handler
      case errorHandler of
        Nothing -> logRESTError herePrefix error
        Just eh -> eh error


-- | Version that doesn't use boxes for errors, prefer unticked one
type UseLoader' path state =
  ( errorHandler :: RESTError -> Effect Unit
  , loader       :: path -> AffRESTError state
  , path         :: path
  , render       :: state -> R.Element
  )

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

80
  useLoaderEffect { errorHandler, loader: loader', path, state: state }
81

82
  pure $ loader { render, state } []
83 84


85 86
type LoaderProps st =
  ( render :: st -> R.Element
87 88
  , state  :: T.Box (Maybe st) )

89
loader :: forall st. Eq st => R2.Component (LoaderProps st)
90
loader = R.createElement loaderCpt
91
loaderCpt :: forall st. Eq st => R.Component (LoaderProps st)
92 93
loaderCpt = here.component "loader" cpt
  where
94
    cpt { render, state } _ = do
95 96
      state' <- T.useLive T.unequal state

97
      pure $ maybe (loadingSpinner { additionalClass: Nothing }) render state'
98

99 100
type UseLoaderEffect path state =
  ( errorHandler :: RESTError -> Effect Unit
101
  , loader       :: path -> AffRESTError state
102 103 104
  , path         :: path
  , state        :: T.Box (Maybe state)
  )
105

106 107
useLoaderEffect :: forall st path. Eq path => Eq st
                   => Record (UseLoaderEffect path st)
108
                   -> R.Hooks Unit
109
useLoaderEffect { errorHandler, loader: loader', path, state } = do
110
  state' <- T.useLive T.unequal state
111
  oPath <- R.useRef path
112

113
  R.useEffect2' path state' $ do
James Laver's avatar
James Laver committed
114 115 116
    path' <- R.readRefM oPath
    if (path' == path) && (isJust state')
    then pure $ R.nothing
117 118
    else do
      R.setRef oPath path
119
      liftEffect $ T.write_ Nothing state
120
      R2.affEffect "G.H.Loader.useLoaderEffect" $ do
121
        l <- loader' path
122
        case l of
123
          Left err -> liftEffect $ errorHandler err
124
          Right l' -> liftEffect $ T.write_ (Just l') state
125 126


127
type UseLoaderBox path state =
128 129
  ( errorHandler :: Maybe (RESTError -> Effect Unit)
  , herePrefix   :: R2.HerePrefix
130
  , loader       :: path -> AffRESTError state
131 132 133 134 135 136 137
  , path         :: T.Box path
  , render       :: state -> R.Element
  )

useLoaderBox :: forall path st. Eq path => Eq st
          => Record (UseLoaderBox path st)
          -> R.Hooks R.Element
138
useLoaderBox { errorHandler, herePrefix, loader: loader', path, render } = do
139 140
  path' <- T.useLive T.unequal path

141 142 143 144 145
  useLoader { errorHandler
            , herePrefix
            , loader: loader'
            , path: path'
            , render }
146 147


James Laver's avatar
James Laver committed
148
newtype HashedResponse a = HashedResponse { hash  :: Hash, value :: a }
149 150 151 152
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)
153

154
type LoaderWithCacheAPIProps path res ret =
155
  ( cacheEndpoint  :: path -> AffRESTError Hash
156
  , handleResponse :: HashedResponse res -> ret
157 158 159
  , mkRequest      :: path -> GUC.Request
  , path           :: path
  , renderer       :: ret -> R.Element
160
  , spinnerClass   :: Maybe String
161 162
  )

163
useLoaderWithCacheAPI :: forall path res ret.
164
                         Eq ret => Eq path => JSON.ReadForeign res =>
165 166
                         Record (LoaderWithCacheAPIProps path res ret)
                      -> R.Hooks R.Element
167
useLoaderWithCacheAPI { cacheEndpoint
168 169 170
                      , handleResponse
                      , mkRequest
                      , path
171 172
                      , renderer
                      , spinnerClass } = do
173 174 175
  state <- T.useBox Nothing
  state' <- T.useLive T.unequal state

176
  useCachedAPILoaderEffect { cacheEndpoint
177 178 179 180
                           , handleResponse
                           , mkRequest
                           , path
                           , state }
181
  pure $ maybe (loadingSpinner { additionalClass: spinnerClass }) renderer state'
182

183
type LoaderWithCacheAPIEffectProps path res ret = (
184
    cacheEndpoint  :: path -> AffRESTError Hash
185
  , handleResponse :: HashedResponse res -> ret
186 187 188
  , mkRequest      :: path -> GUC.Request
  , path           :: path
  , state          :: T.Box (Maybe ret)
189 190
  )

191
useCachedAPILoaderEffect :: forall path res ret.
192
                            Eq ret => Eq path => JSON.ReadForeign res =>
193 194
                            Record (LoaderWithCacheAPIEffectProps path res ret)
                         -> R.Hooks Unit
195
useCachedAPILoaderEffect { cacheEndpoint
196 197 198
                         , handleResponse
                         , mkRequest
                         , path
199
                         , state } = do
200
  { errors } <- Store.use
201
  state' <- T.useLive T.unequal state
202 203 204 205 206 207 208 209 210 211 212 213 214
  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?
215
        hr@(HashedResponse { hash }) <- GUC.cachedJson cache req
216
        eCacheReal <- cacheEndpoint path
217
        handleRESTError (R2.herePrefix here "[useCachedAPILoaderEffect]") errors eCacheReal $ \cacheReal -> do
218 219 220 221 222 223 224
          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'
225
            else do
226 227 228 229 230
              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