Loader.purs 6.61 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.useEffect2' path state' $ 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
      liftEffect $ T.write_ Nothing state
88
      R2.affEffect "G.H.Loader.useLoaderEffect" $ do
89
        l <- loader' path
90
        case l of
91
          Left err -> liftEffect $ errorHandler err
92
          Right l' -> liftEffect $ T.write_ (Just l') state
93 94


95 96
type UseLoaderBox path state =
  ( errorHandler :: RESTError -> Effect Unit
97
  , loader       :: path -> AffRESTError state
98 99 100 101 102 103 104 105 106 107
  , 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
  path' <- T.useLive T.unequal path

108
  useLoader { errorHandler, loader: loader', path: path', render }
109 110


James Laver's avatar
James Laver committed
111
newtype HashedResponse a = HashedResponse { hash  :: Hash, value :: a }
112 113 114 115
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)
116

117 118
type LoaderWithCacheAPIProps path res ret =
  ( boxes          :: Boxes
119
  , cacheEndpoint  :: path -> AffRESTError Hash
120
  , handleResponse :: HashedResponse res -> ret
121 122 123
  , mkRequest      :: path -> GUC.Request
  , path           :: path
  , renderer       :: ret -> R.Element
124
  , spinnerClass   :: Maybe String
125 126
  )

127
useLoaderWithCacheAPI :: forall path res ret.
128
                         Eq ret => Eq path => JSON.ReadForeign res =>
129 130
                         Record (LoaderWithCacheAPIProps path res ret)
                      -> R.Hooks R.Element
131 132 133 134 135
useLoaderWithCacheAPI { boxes
                      , cacheEndpoint
                      , handleResponse
                      , mkRequest
                      , path
136 137
                      , renderer
                      , spinnerClass } = do
138 139 140
  state <- T.useBox Nothing
  state' <- T.useLive T.unequal state

141 142
  useCachedAPILoaderEffect { boxes
                           , cacheEndpoint
143 144 145 146
                           , handleResponse
                           , mkRequest
                           , path
                           , state }
147
  pure $ maybe (loadingSpinner { additionalClass: spinnerClass }) renderer state'
148

149
type LoaderWithCacheAPIEffectProps path res ret = (
150
    boxes          :: Boxes
151
  , cacheEndpoint  :: path -> AffRESTError Hash
152
  , handleResponse :: HashedResponse res -> ret
153 154 155
  , mkRequest      :: path -> GUC.Request
  , path           :: path
  , state          :: T.Box (Maybe ret)
156 157
  )

158
useCachedAPILoaderEffect :: forall path res ret.
159
                            Eq ret => Eq path => JSON.ReadForeign res =>
160 161
                            Record (LoaderWithCacheAPIEffectProps path res ret)
                         -> R.Hooks Unit
162 163
useCachedAPILoaderEffect { boxes: { errors }
                         , cacheEndpoint
164 165 166
                         , handleResponse
                         , mkRequest
                         , path
167 168
                         , state } = do
  state' <- T.useLive T.unequal state
169 170 171 172 173 174 175 176 177 178 179 180 181
  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?
182
        hr@(HashedResponse { hash }) <- GUC.cachedJson cache req
183 184 185 186 187 188 189 190 191
        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'
192
            else do
193 194 195 196 197
              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