/
Store.purs
126 lines (118 loc) · 3.71 KB
/
Store.purs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
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
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
module React.Basic.Hooks.Suspense.Store
( mkSuspenseStore
, SuspenseStore
, get
, get'
) where
import Prelude
import Control.Alt ((<|>))
import Data.DateTime.Instant (Instant, unInstant)
import Data.Either (Either(..))
import Data.Int (ceil)
import Data.Map (Map)
import Data.Map as Map
import Data.Maybe (Maybe(..))
import Data.Newtype (un)
import Data.Time.Duration (Milliseconds(..))
import Effect (Effect)
import Effect.Aff (Aff, attempt, launchAff, throwError)
import Effect.Class (liftEffect)
import Effect.Console (warn)
import Effect.Exception (try)
import Effect.Now (now)
import Effect.Ref (Ref)
import Effect.Ref as Ref
import React.Basic.Hooks (type (/\), (/\))
import React.Basic.Hooks.Suspense (Suspended(..), SuspenseResult(..))
import Web.HTML (window)
import Web.HTML.Window (requestIdleCallback)
-- | Simple key-based cache.
mkSuspenseStore ::
forall k v.
Ord k =>
Maybe Milliseconds ->
(k -> Aff v) ->
Effect (SuspenseStore k v)
mkSuspenseStore defaultMaxAge backend = do
ref <- Ref.new mempty
let
isExpired maxAge now' (_ /\ d) = unInstant now' < unInstant d <> maxAge
pruneCache = do
case defaultMaxAge of
Nothing -> pure unit
Just maxAge -> do
now' <- now
void $ Ref.modify (Map.filter (not isExpired maxAge now')) ref
void
$ window
>>= requestIdleCallback
{ timeout: ceil $ un Milliseconds maxAge
}
pruneCache
tryFromCache itemMaxAge k = do
rMaybe <- Map.lookup k <$> Ref.read ref
case rMaybe of
Nothing -> pure Nothing
Just v@(r /\ d) -> do
case itemMaxAge <|> defaultMaxAge of
Nothing -> pure (Just r)
Just maxAge -> do
now' <- now
if isExpired maxAge now' v then do
_ <- Ref.modify (Map.delete k) ref
pure Nothing
else
pure (Just r)
getCacheOrBackend itemMaxAge k = do
c <- tryFromCache itemMaxAge k
case c of
Just v -> pure v
Nothing -> do
fiber <-
launchAff do
r <- attempt do backend k
liftEffect do
let
v = case r of
Left e -> Failed e
Right v' -> Complete v'
d <- now
_ <-
ref
# Ref.modify
( k
# Map.alter case _ of
Nothing -> Just (v /\ d)
Just r'@(v' /\ d') ->
if d > d' then
Just (v /\ d)
else
Just r'
)
case r of
Left e -> throwError e
Right v' -> pure v'
let
v = InProgress fiber
d <- now
_ <- ref # Ref.modify (Map.insert k (v /\ d))
pure v
do
r <- try pruneCache
case r of
Left _ -> warn "Failed to initialize the suspense store cleanup task. Ensure you're using it in a browser with `requestIdleCallback` support."
Right _ -> pure unit
pure
$ SuspenseStore
{ cache: ref
, get: map Suspended <<< getCacheOrBackend
}
newtype SuspenseStore k v
= SuspenseStore
{ cache :: Ref (Map k (SuspenseResult v /\ Instant))
, get :: Maybe Milliseconds -> k -> Suspended v
}
get :: forall k v. SuspenseStore k v -> k -> Suspended v
get (SuspenseStore s) = s.get Nothing
get' :: forall k v. SuspenseStore k v -> Milliseconds -> k -> Suspended v
get' (SuspenseStore s) d = s.get (Just d)