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