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

3
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, (.:), (:=), (~>), jsonEmptyObject)
4 5 6
import Data.Argonaut.Core (stringify)
import Data.Argonaut.Parser (jsonParser)
import Data.Either (Either(..))
7 8
import Data.Maybe (Maybe(..), isJust, maybe)
import Data.Tuple (fst)
9
import Data.Tuple.Nested ((/\))
10
import DOM.Simple.Console (log2)
11
import Effect.Aff (Aff, launchAff_, throwError)
12
import Effect.Class (liftEffect)
13
import Effect.Exception (error)
14 15 16 17
import Milkis as M
import Reactix as R
import Web.Storage.Storage as WSS

18
import Gargantext.Components.LoadingSpinner (loadingSpinner)
19
import Gargantext.Ends (class ToUrl, toUrl)
20
import Gargantext.Prelude
21
import Gargantext.Utils.Crypto (Hash)
22
import Gargantext.Utils as GU
23
import Gargantext.Utils.CacheAPI as GUC
24 25
import Gargantext.Utils.Reactix as R2

26 27 28 29 30 31
cacheName :: String
cacheName = "cache-api-loader"

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

32

33 34 35 36 37
useLoader :: forall path st. Eq path
          => path
          -> (path -> Aff st)
          -> (st -> R.Element)
          -> R.Hooks R.Element
38
useLoader path loader render = do
39
  state <- R.useState' Nothing
40
  useLoaderEffect path state loader
41 42
  pure $ maybe (loadingSpinner {}) render (fst state)

43
useLoaderEffect :: forall st path. Eq path =>
44 45 46 47
                      path
                   -> R.State (Maybe st)
                   -> (path -> Aff st)
                   -> R.Hooks Unit
48 49
useLoaderEffect path state@(state' /\ setState) loader = do
  oPath <- R.useRef path
50

51 52 53 54 55 56
  R.useEffect' $ do
    if (R.readRef oPath == path) && (isJust state') then
      pure $ pure unit
    else do
      R.setRef oPath path

57
      R2.affEffect "G.H.Loader.useLoaderEffect" $ do
58 59
        l <- loader path
        liftEffect $ setState $ const $ Just l
60 61


62 63 64 65
newtype HashedResponse a =
  HashedResponse { hash  :: Hash
                 , value :: a
                 }
66 67 68

instance decodeHashedResponse :: DecodeJson a => DecodeJson (HashedResponse a) where
  decodeJson json = do
69 70
    obj   <- decodeJson json
    hash  <- obj .: "hash"
71
    value <- obj .: "value"
72
    pure $ HashedResponse { hash, value }
73 74

instance encodeHashedResponse :: EncodeJson a => EncodeJson (HashedResponse a) where
75 76
  encodeJson (HashedResponse { hash, value }) = do
       "hash" := encodeJson hash
77 78 79
    ~> "value" := encodeJson value
    ~> jsonEmptyObject

80

81 82
type LoaderWithCacheAPIProps path res ret = (
    cacheEndpoint :: path -> Aff Hash
83 84 85 86 87 88 89
  , handleResponse :: HashedResponse res -> ret
  , mkRequest :: path -> GUC.Request
  , path :: path
  , renderer :: ret -> R.Element
  )


90 91
useLoaderWithCacheAPI :: forall path res ret.
                         Eq path => DecodeJson res =>
92 93 94 95 96 97 98 99 100 101 102
                         Record (LoaderWithCacheAPIProps path res ret)
                      -> R.Hooks R.Element
useLoaderWithCacheAPI { cacheEndpoint, handleResponse, mkRequest, path, renderer } = do
  state <- R.useState' Nothing
  useCachedAPILoaderEffect { cacheEndpoint
                           , handleResponse
                           , mkRequest
                           , path
                           , state }
  pure $ maybe (loadingSpinner {}) renderer (fst state)

103 104
type LoaderWithCacheAPIEffectProps path res ret = (
    cacheEndpoint :: path -> Aff Hash
105 106 107 108 109 110
  , handleResponse :: HashedResponse res -> ret
  , mkRequest :: path -> GUC.Request
  , path :: path
  , state :: R.State (Maybe ret)
  )

111 112
useCachedAPILoaderEffect :: forall path res ret.
                            Eq path => DecodeJson res =>
113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132
                            Record (LoaderWithCacheAPIEffectProps path res ret)
                         -> R.Hooks Unit
useCachedAPILoaderEffect { cacheEndpoint
                         , handleResponse
                         , mkRequest
                         , path
                         , state: state@(state' /\ setState) } = do
  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?
133
        hr@(HashedResponse { hash, value }) <- GUC.cachedJson cache req
134
        cacheReal <- cacheEndpoint path
135
        val <- if hash == cacheReal then
136 137
          pure hr
        else do
138
          _ <- GUC.deleteReq cache req
139 140
          hr@(HashedResponse { hash, value }) <- GUC.cachedJson cache req
          if hash == cacheReal then
141 142 143 144
            pure hr
          else
            throwError $ error $ "Fetched clean cache but hashes don't match"
        liftEffect $ do
145
          setState $ const $ Just $ handleResponse val