{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -O2 -fdicts-strict -fspec-constr-recursive=16 -fmax-worker-args=16 #-}
module Knit.Report.Cache
(
WithCacheTime
, ActionWithCacheTime
, ignoreCacheTime
, ignoreCacheTimeM
, withCacheTime
, onlyCacheTime
, store
, clear
, clearIfPresent
, retrieve
, retrieveOrMake
, retrieveOrMakeTransformed
, StreamWithCacheTime
, ignoreCacheTimeStream
, streamToAction
, streamAsAction
, storeStream
, retrieveStream
, retrieveOrMakeStream
, retrieveOrMakeTransformedStream
, UTCTime
)
where
import qualified Knit.Effect.AtomicCache as C
import Knit.Effect.AtomicCache (clear
, clearIfPresent
, WithCacheTime
, withCacheTime
, ignoreCacheTime
, ignoreCacheTimeM
, ActionWithCacheTime
, onlyCacheTime)
import qualified Knit.Effect.Serialize as KS
import qualified Knit.Effect.Logger as K
import qualified Control.Monad.Catch.Pure as Exceptions
import qualified Data.Text as T
import qualified Data.Time.Clock as Time
import Data.Time.Clock (UTCTime)
import qualified Polysemy as P
import qualified Polysemy.Error as P
import qualified Streamly as Streamly
import qualified Streamly.Prelude as Streamly
import qualified Streamly.Internal.Prelude as Streamly
serializationToCacheError :: KS.SerializationError -> C.CacheError
serializationToCacheError :: SerializationError -> CacheError
serializationToCacheError (KS.SerializationError msg :: Text
msg) = Text -> CacheError
C.DeSerializationError Text
msg
mapSerializationErrorsOne ::
P.MemberWithError (P.Error C.CacheError) r
=> KS.Serialize KS.SerializationError (P.Error KS.SerializationError ': r) a ct
-> KS.Serialize C.CacheError r a ct
mapSerializationErrorsOne :: Serialize SerializationError (Error SerializationError : r) a ct
-> Serialize CacheError r a ct
mapSerializationErrorsOne (KS.Serialize encode :: a -> Sem (Error SerializationError : r) (ct, a)
encode decode :: ct -> Sem (Error SerializationError : r) a
decode encBytes :: ct -> Int64
encBytes) =
let f :: Sem (Error SerializationError : r) a -> Sem r a
f = (SerializationError -> CacheError)
-> Sem (Error SerializationError : r) a -> Sem r a
forall e1 e2 (r :: [(* -> *) -> * -> *]) a.
Member (Error e2) r =>
(e1 -> e2) -> Sem (Error e1 : r) a -> Sem r a
P.mapError SerializationError -> CacheError
serializationToCacheError
in (a -> Sem r (ct, a))
-> (ct -> Sem r a) -> (ct -> Int64) -> Serialize CacheError r a ct
forall e (r :: [(* -> *) -> * -> *]) a ct.
MemberWithError (Error e) r =>
(a -> Sem r (ct, a))
-> (ct -> Sem r a) -> (ct -> Int64) -> Serialize e r a ct
KS.Serialize
(Sem (Error SerializationError : r) (ct, a) -> Sem r (ct, a)
forall a. Sem (Error SerializationError : r) a -> Sem r a
f (Sem (Error SerializationError : r) (ct, a) -> Sem r (ct, a))
-> (a -> Sem (Error SerializationError : r) (ct, a))
-> a
-> Sem r (ct, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Sem (Error SerializationError : r) (ct, a)
encode)
(Sem (Error SerializationError : r) a -> Sem r a
forall a. Sem (Error SerializationError : r) a -> Sem r a
f (Sem (Error SerializationError : r) a -> Sem r a)
-> (ct -> Sem (Error SerializationError : r) a) -> ct -> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ct -> Sem (Error SerializationError : r) a
decode)
ct -> Int64
encBytes
knitSerialize
:: ( sc a
, P.Member (P.Embed IO) r
, P.MemberWithError (P.Error C.CacheError) r
)
=> KS.SerializeDict sc ct
-> KS.Serialize C.CacheError r a ct
knitSerialize :: SerializeDict sc ct -> Serialize CacheError r a ct
knitSerialize = Serialize SerializationError (Error SerializationError : r) a ct
-> Serialize CacheError r a ct
forall (r :: [(* -> *) -> * -> *]) a ct.
MemberWithError (Error CacheError) r =>
Serialize SerializationError (Error SerializationError : r) a ct
-> Serialize CacheError r a ct
mapSerializationErrorsOne (Serialize SerializationError (Error SerializationError : r) a ct
-> Serialize CacheError r a ct)
-> (SerializeDict sc ct
-> Serialize
SerializationError (Error SerializationError : r) a ct)
-> SerializeDict sc ct
-> Serialize CacheError r a ct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SerializeDict sc ct
-> Serialize SerializationError (Error SerializationError : r) a ct
forall (c :: * -> Constraint) a (r :: [(* -> *) -> * -> *]) ct.
(c a, MemberWithError (Error SerializationError) r) =>
SerializeDict c ct -> Serialize SerializationError r a ct
KS.serializeOne
{-# INLINEABLE knitSerialize #-}
mapSerializationErrorsStreamly ::
P.MemberWithError (P.Error C.CacheError) r
=> KS.Serialize KS.SerializationError (P.Error KS.SerializationError ': r) (Streamly.SerialT (P.Sem (P.Error KS.SerializationError ': r)) a) ct
-> KS.Serialize C.CacheError r (Streamly.SerialT (P.Sem r) a) ct
(KS.Serialize encode :: SerialT (Sem (Error SerializationError : r)) a
-> Sem
(Error SerializationError : r)
(ct, SerialT (Sem (Error SerializationError : r)) a)
encode decode :: ct
-> Sem
(Error SerializationError : r)
(SerialT (Sem (Error SerializationError : r)) a)
decode encBytes :: ct -> Int64
encBytes) =
let f :: Sem (Error SerializationError : r) a -> Sem r a
f = (SerializationError -> CacheError)
-> Sem (Error SerializationError : r) a -> Sem r a
forall e1 e2 (r :: [(* -> *) -> * -> *]) a.
Member (Error e2) r =>
(e1 -> e2) -> Sem (Error e1 : r) a -> Sem r a
P.mapError SerializationError -> CacheError
serializationToCacheError
in (SerialT (Sem r) a -> Sem r (ct, SerialT (Sem r) a))
-> (ct -> Sem r (SerialT (Sem r) a))
-> (ct -> Int64)
-> Serialize CacheError r (SerialT (Sem r) a) ct
forall e (r :: [(* -> *) -> * -> *]) a ct.
MemberWithError (Error e) r =>
(a -> Sem r (ct, a))
-> (ct -> Sem r a) -> (ct -> Int64) -> Serialize e r a ct
KS.Serialize
(Sem (Error SerializationError : r) (ct, SerialT (Sem r) a)
-> Sem r (ct, SerialT (Sem r) a)
forall a. Sem (Error SerializationError : r) a -> Sem r a
f (Sem (Error SerializationError : r) (ct, SerialT (Sem r) a)
-> Sem r (ct, SerialT (Sem r) a))
-> (SerialT (Sem r) a
-> Sem (Error SerializationError : r) (ct, SerialT (Sem r) a))
-> SerialT (Sem r) a
-> Sem r (ct, SerialT (Sem r) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ct, SerialT (Sem (Error SerializationError : r)) a)
-> (ct, SerialT (Sem r) a))
-> Sem
(Error SerializationError : r)
(ct, SerialT (Sem (Error SerializationError : r)) a)
-> Sem (Error SerializationError : r) (ct, SerialT (Sem r) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(ct :: ct
ct, a :: SerialT (Sem (Error SerializationError : r)) a
a) -> (ct
ct, (forall a. Sem (Error SerializationError : r) a -> Sem r a)
-> SerialT (Sem (Error SerializationError : r)) a
-> SerialT (Sem r) a
forall (m :: * -> *) (n :: * -> *) a.
(Monad m, Monad n) =>
(forall x. m x -> n x) -> SerialT m a -> SerialT n a
Streamly.hoist forall a. Sem (Error SerializationError : r) a -> Sem r a
f SerialT (Sem (Error SerializationError : r)) a
a)) (Sem
(Error SerializationError : r)
(ct, SerialT (Sem (Error SerializationError : r)) a)
-> Sem (Error SerializationError : r) (ct, SerialT (Sem r) a))
-> (SerialT (Sem r) a
-> Sem
(Error SerializationError : r)
(ct, SerialT (Sem (Error SerializationError : r)) a))
-> SerialT (Sem r) a
-> Sem (Error SerializationError : r) (ct, SerialT (Sem r) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SerialT (Sem (Error SerializationError : r)) a
-> Sem
(Error SerializationError : r)
(ct, SerialT (Sem (Error SerializationError : r)) a)
encode (SerialT (Sem (Error SerializationError : r)) a
-> Sem
(Error SerializationError : r)
(ct, SerialT (Sem (Error SerializationError : r)) a))
-> (SerialT (Sem r) a
-> SerialT (Sem (Error SerializationError : r)) a)
-> SerialT (Sem r) a
-> Sem
(Error SerializationError : r)
(ct, SerialT (Sem (Error SerializationError : r)) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall x. Sem r x -> Sem (Error SerializationError : r) x)
-> SerialT (Sem r) a
-> SerialT (Sem (Error SerializationError : r)) a
forall (m :: * -> *) (n :: * -> *) a.
(Monad m, Monad n) =>
(forall x. m x -> n x) -> SerialT m a -> SerialT n a
Streamly.hoist forall x. Sem r x -> Sem (Error SerializationError : r) x
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
Sem r a -> Sem (e : r) a
P.raise)
(Sem (Error SerializationError : r) (SerialT (Sem r) a)
-> Sem r (SerialT (Sem r) a)
forall a. Sem (Error SerializationError : r) a -> Sem r a
f (Sem (Error SerializationError : r) (SerialT (Sem r) a)
-> Sem r (SerialT (Sem r) a))
-> (ct -> Sem (Error SerializationError : r) (SerialT (Sem r) a))
-> ct
-> Sem r (SerialT (Sem r) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SerialT (Sem (Error SerializationError : r)) a
-> SerialT (Sem r) a)
-> Sem
(Error SerializationError : r)
(SerialT (Sem (Error SerializationError : r)) a)
-> Sem (Error SerializationError : r) (SerialT (Sem r) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((forall a. Sem (Error SerializationError : r) a -> Sem r a)
-> SerialT (Sem (Error SerializationError : r)) a
-> SerialT (Sem r) a
forall (m :: * -> *) (n :: * -> *) a.
(Monad m, Monad n) =>
(forall x. m x -> n x) -> SerialT m a -> SerialT n a
Streamly.hoist forall a. Sem (Error SerializationError : r) a -> Sem r a
f) (Sem
(Error SerializationError : r)
(SerialT (Sem (Error SerializationError : r)) a)
-> Sem (Error SerializationError : r) (SerialT (Sem r) a))
-> (ct
-> Sem
(Error SerializationError : r)
(SerialT (Sem (Error SerializationError : r)) a))
-> ct
-> Sem (Error SerializationError : r) (SerialT (Sem r) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ct
-> Sem
(Error SerializationError : r)
(SerialT (Sem (Error SerializationError : r)) a)
decode)
ct -> Int64
encBytes
knitSerializeStream :: (sc [a]
, P.Member (P.Embed IO) r
, P.MemberWithError (P.Error C.CacheError) r
)
=> KS.SerializeDict sc ct
-> KS.Serialize C.CacheError r (Streamly.SerialT (P.Sem r) a) ct
knitSerializeStream :: SerializeDict sc ct
-> Serialize CacheError r (SerialT (Sem r) a) ct
knitSerializeStream = Serialize
SerializationError
(Error SerializationError : r)
(SerialT (Sem (Error SerializationError : r)) a)
ct
-> Serialize CacheError r (SerialT (Sem r) a) ct
forall (r :: [(* -> *) -> * -> *]) a ct.
MemberWithError (Error CacheError) r =>
Serialize
SerializationError
(Error SerializationError : r)
(SerialT (Sem (Error SerializationError : r)) a)
ct
-> Serialize CacheError r (SerialT (Sem r) a) ct
mapSerializationErrorsStreamly (Serialize
SerializationError
(Error SerializationError : r)
(SerialT (Sem (Error SerializationError : r)) a)
ct
-> Serialize CacheError r (SerialT (Sem r) a) ct)
-> (SerializeDict sc ct
-> Serialize
SerializationError
(Error SerializationError : r)
(SerialT (Sem (Error SerializationError : r)) a)
ct)
-> SerializeDict sc ct
-> Serialize CacheError r (SerialT (Sem r) a) ct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SerializeDict sc ct
-> Serialize
SerializationError
(Error SerializationError : r)
(SerialT (Sem (Error SerializationError : r)) a)
ct
forall (r :: [(* -> *) -> * -> *]) (c :: * -> Constraint) a ct.
(MemberWithError (Error SerializationError) r, Member (Embed IO) r,
c [a]) =>
SerializeDict c ct
-> Serialize SerializationError r (SerialT (Sem r) a) ct
KS.serializeStreamlyViaList
{-# INLINEABLE knitSerializeStream #-}
store
:: forall sc ct k r a.
( P.Members '[KS.SerializeEnv sc ct, C.Cache k ct, P.Error C.CacheError, P.Embed IO] r
, K.LogWithPrefixesLE r
, Show k
, sc a
)
=> k
-> a
-> P.Sem r ()
store :: k -> a -> Sem r ()
store k :: k
k a :: a
a = Text -> Sem r () -> Sem r ()
forall (effs :: [(* -> *) -> * -> *]) a.
Member PrefixLog effs =>
Text -> Sem effs a -> Sem effs a
K.wrapPrefix ("Knit.store (key=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ k -> String
forall a. Show a => a -> String
show k
k) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ")") (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ do
SerializeDict sc ct
cacheSD <- Sem r (SerializeDict sc ct)
forall (c :: * -> Constraint) ct (r :: [(* -> *) -> * -> *]).
Member (SerializeEnv c ct) r =>
Sem r (SerializeDict c ct)
KS.getSerializeDict
LogSeverity -> Text -> Sem r ()
forall (effs :: [(* -> *) -> * -> *]).
Member (Logger LogEntry) effs =>
LogSeverity -> Text -> Sem effs ()
K.logLE (Int -> LogSeverity
K.Debug 3) (Text -> Sem r ()) -> Text -> Sem r ()
forall a b. (a -> b) -> a -> b
$ "Called with k=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ k -> String
forall a. Show a => a -> String
show k
k)
Serialize CacheError r a ct -> k -> a -> Sem r ()
forall k ct (r :: [(* -> *) -> * -> *]) a.
(Show k, Member (Cache k ct) r, LogWithPrefixesLE r) =>
Serialize CacheError r a ct -> k -> a -> Sem r ()
C.encodeAndStore (SerializeDict sc ct -> Serialize CacheError r a ct
forall (sc :: * -> Constraint) a (r :: [(* -> *) -> * -> *]) ct.
(sc a, Member (Embed IO) r,
MemberWithError (Error CacheError) r) =>
SerializeDict sc ct -> Serialize CacheError r a ct
knitSerialize SerializeDict sc ct
cacheSD) k
k a
a
{-# INLINEABLE store #-}
retrieve
:: forall sc ct k r a.
(P.Members '[KS.SerializeEnv sc ct, C.Cache k ct, P.Error C.CacheError, P.Embed IO] r
, K.LogWithPrefixesLE r
, Show k
, sc a)
=> k
-> P.Sem r (C.ActionWithCacheTime r a)
retrieve :: k -> Sem r (ActionWithCacheTime r a)
retrieve k :: k
k = Text
-> Sem r (ActionWithCacheTime r a)
-> Sem r (ActionWithCacheTime r a)
forall (effs :: [(* -> *) -> * -> *]) a.
Member PrefixLog effs =>
Text -> Sem effs a -> Sem effs a
K.wrapPrefix ("Cache.retrieve (key=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ k -> String
forall a. Show a => a -> String
show k
k) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ")") (Sem r (ActionWithCacheTime r a)
-> Sem r (ActionWithCacheTime r a))
-> Sem r (ActionWithCacheTime r a)
-> Sem r (ActionWithCacheTime r a)
forall a b. (a -> b) -> a -> b
$ do
SerializeDict sc ct
cacheSD <- Sem r (SerializeDict sc ct)
forall (c :: * -> Constraint) ct (r :: [(* -> *) -> * -> *]).
Member (SerializeEnv c ct) r =>
Sem r (SerializeDict c ct)
KS.getSerializeDict
Serialize CacheError r a ct
-> k -> Maybe UTCTime -> Sem r (ActionWithCacheTime r a)
forall ct k (r :: [(* -> *) -> * -> *]) a.
(Member (Cache k ct) r, Member (Embed IO) r,
MemberWithError (Error CacheError) r, LogWithPrefixesLE r,
Show k) =>
Serialize CacheError r a ct
-> k -> Maybe UTCTime -> Sem r (ActionWithCacheTime r a)
C.retrieveAndDecode (SerializeDict sc ct -> Serialize CacheError r a ct
forall (sc :: * -> Constraint) a (r :: [(* -> *) -> * -> *]) ct.
(sc a, Member (Embed IO) r,
MemberWithError (Error CacheError) r) =>
SerializeDict sc ct -> Serialize CacheError r a ct
knitSerialize SerializeDict sc ct
cacheSD) k
k Maybe UTCTime
forall a. Maybe a
Nothing
{-# INLINEABLE retrieve #-}
retrieveOrMake
:: forall sc ct k r a b.
( P.Members '[KS.SerializeEnv sc ct, C.Cache k ct, P.Error C.CacheError, P.Embed IO] r
, K.LogWithPrefixesLE r
, Show k
, sc a
)
=> k
-> C.ActionWithCacheTime r b
-> (b -> P.Sem r a)
-> P.Sem r (C.ActionWithCacheTime r a)
retrieveOrMake :: k
-> ActionWithCacheTime r b
-> (b -> Sem r a)
-> Sem r (ActionWithCacheTime r a)
retrieveOrMake k :: k
k cachedDeps :: ActionWithCacheTime r b
cachedDeps toMake :: b -> Sem r a
toMake =
Text
-> Sem r (ActionWithCacheTime r a)
-> Sem r (ActionWithCacheTime r a)
forall (effs :: [(* -> *) -> * -> *]) a.
Member PrefixLog effs =>
Text -> Sem effs a -> Sem effs a
K.wrapPrefix ("Cache.retrieveOrMake (key=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ k -> String
forall a. Show a => a -> String
show k
k) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ")") (Sem r (ActionWithCacheTime r a)
-> Sem r (ActionWithCacheTime r a))
-> Sem r (ActionWithCacheTime r a)
-> Sem r (ActionWithCacheTime r a)
forall a b. (a -> b) -> a -> b
$ do
SerializeDict sc ct
cacheSD <- Sem r (SerializeDict sc ct)
forall (c :: * -> Constraint) ct (r :: [(* -> *) -> * -> *]).
Member (SerializeEnv c ct) r =>
Sem r (SerializeDict c ct)
KS.getSerializeDict
Serialize CacheError r a ct
-> k
-> ActionWithCacheTime r b
-> (b -> Sem r a)
-> Sem r (ActionWithCacheTime r a)
forall ct k (r :: [(* -> *) -> * -> *]) a b.
(Member (Cache k ct) r, LogWithPrefixesLE r, Member (Embed IO) r,
MemberWithError (Error CacheError) r, Show k) =>
Serialize CacheError r a ct
-> k
-> ActionWithCacheTime r b
-> (b -> Sem r a)
-> Sem r (ActionWithCacheTime r a)
C.retrieveOrMake (SerializeDict sc ct -> Serialize CacheError r a ct
forall (sc :: * -> Constraint) a (r :: [(* -> *) -> * -> *]) ct.
(sc a, Member (Embed IO) r,
MemberWithError (Error CacheError) r) =>
SerializeDict sc ct -> Serialize CacheError r a ct
knitSerialize SerializeDict sc ct
cacheSD) k
k ActionWithCacheTime r b
cachedDeps b -> Sem r a
toMake
{-# INLINEABLE retrieveOrMake #-}
retrieveOrMakeTransformed
:: forall sc ct k r a b c.
( P.Members '[KS.SerializeEnv sc ct, C.Cache k ct, P.Error C.CacheError, P.Embed IO] r
, K.LogWithPrefixesLE r
, Show k
, sc b
)
=> (a -> b)
-> (b -> a)
-> k
-> C.ActionWithCacheTime r c
-> (c -> P.Sem r a)
-> P.Sem r (C.ActionWithCacheTime r a)
retrieveOrMakeTransformed :: (a -> b)
-> (b -> a)
-> k
-> ActionWithCacheTime r c
-> (c -> Sem r a)
-> Sem r (ActionWithCacheTime r a)
retrieveOrMakeTransformed toSerializable :: a -> b
toSerializable fromSerializable :: b -> a
fromSerializable k :: k
k newestM :: ActionWithCacheTime r c
newestM toMake :: c -> Sem r a
toMake =
Text
-> Sem r (ActionWithCacheTime r a)
-> Sem r (ActionWithCacheTime r a)
forall (effs :: [(* -> *) -> * -> *]) a.
Member PrefixLog effs =>
Text -> Sem effs a -> Sem effs a
K.wrapPrefix "retrieveOrMakeTransformed"
(Sem r (ActionWithCacheTime r a)
-> Sem r (ActionWithCacheTime r a))
-> Sem r (ActionWithCacheTime r a)
-> Sem r (ActionWithCacheTime r a)
forall a b. (a -> b) -> a -> b
$ (WithCacheTime (Sem r) b -> ActionWithCacheTime r a)
-> Sem r (WithCacheTime (Sem r) b)
-> Sem r (ActionWithCacheTime r a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((b -> a) -> WithCacheTime (Sem r) b -> ActionWithCacheTime r a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> a
fromSerializable)
(Sem r (WithCacheTime (Sem r) b)
-> Sem r (ActionWithCacheTime r a))
-> Sem r (WithCacheTime (Sem r) b)
-> Sem r (ActionWithCacheTime r a)
forall a b. (a -> b) -> a -> b
$ k
-> ActionWithCacheTime r c
-> (c -> Sem r b)
-> Sem r (WithCacheTime (Sem r) b)
forall (sc :: * -> Constraint) ct k (r :: [(* -> *) -> * -> *]) a
b.
(Members
'[SerializeEnv sc ct, Cache k ct, Error CacheError, Embed IO] r,
LogWithPrefixesLE r, Show k, sc a) =>
k
-> ActionWithCacheTime r b
-> (b -> Sem r a)
-> Sem r (ActionWithCacheTime r a)
retrieveOrMake k
k ActionWithCacheTime r c
newestM ((a -> b) -> Sem r a -> Sem r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
toSerializable (Sem r a -> Sem r b) -> (c -> Sem r a) -> c -> Sem r b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> Sem r a
toMake)
{-# INLINEABLE retrieveOrMakeTransformed #-}
storeStream
:: forall sc ct k r a.
( P.Members '[KS.SerializeEnv sc ct, C.Cache k ct, P.Error C.CacheError, P.Embed IO] r
, P.MemberWithError (P.Error Exceptions.SomeException) r
, K.LogWithPrefixesLE r
, Show k
, sc [a]
)
=> k
-> Streamly.SerialT (P.Sem r) a
-> P.Sem r ()
storeStream :: k -> SerialT (Sem r) a -> Sem r ()
storeStream k :: k
k aS :: SerialT (Sem r) a
aS = Text -> Sem r () -> Sem r ()
forall (effs :: [(* -> *) -> * -> *]) a.
Member PrefixLog effs =>
Text -> Sem effs a -> Sem effs a
K.wrapPrefix ("Cache.storeStream key=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ k -> String
forall a. Show a => a -> String
show k
k) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ")") (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ do
LogSeverity -> Text -> Sem r ()
forall (effs :: [(* -> *) -> * -> *]).
Member (Logger LogEntry) effs =>
LogSeverity -> Text -> Sem effs ()
K.logLE(Int -> LogSeverity
K.Debug 3) (Text -> Sem r ()) -> Text -> Sem r ()
forall a b. (a -> b) -> a -> b
$ "Called with k=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ k -> String
forall a. Show a => a -> String
show k
k)
SerializeDict sc ct
cacheSD <- Sem r (SerializeDict sc ct)
forall (c :: * -> Constraint) ct (r :: [(* -> *) -> * -> *]).
Member (SerializeEnv c ct) r =>
Sem r (SerializeDict c ct)
KS.getSerializeDict
Serialize CacheError r (SerialT (Sem r) a) ct
-> k -> SerialT (Sem r) a -> Sem r ()
forall k ct (r :: [(* -> *) -> * -> *]) a.
(Show k, Member (Cache k ct) r, LogWithPrefixesLE r) =>
Serialize CacheError r a ct -> k -> a -> Sem r ()
C.encodeAndStore (SerializeDict sc ct
-> Serialize CacheError r (SerialT (Sem r) a) ct
forall (sc :: * -> Constraint) a (r :: [(* -> *) -> * -> *]) ct.
(sc [a], Member (Embed IO) r,
MemberWithError (Error CacheError) r) =>
SerializeDict sc ct
-> Serialize CacheError r (SerialT (Sem r) a) ct
knitSerializeStream SerializeDict sc ct
cacheSD) k
k SerialT (Sem r) a
aS
{-# INLINEABLE storeStream #-}
type StreamWithCacheTime r a = C.WithCacheTime (Streamly.SerialT (P.Sem r)) a
streamToAction :: (Streamly.SerialT (P.Sem r) a -> P.Sem r b) -> StreamWithCacheTime r a -> C.ActionWithCacheTime r b
streamToAction :: (SerialT (Sem r) a -> Sem r b)
-> StreamWithCacheTime r a -> ActionWithCacheTime r b
streamToAction = (SerialT (Sem r) a -> Sem r b)
-> StreamWithCacheTime r a -> ActionWithCacheTime r b
forall k1 k2 (m :: k1 -> *) (a :: k1) (n :: k2 -> *) (b :: k2).
(m a -> n b) -> WithCacheTime m a -> WithCacheTime n b
C.wctMapAction
{-# INLINEABLE streamToAction #-}
streamAsAction :: StreamWithCacheTime r a -> C.ActionWithCacheTime r (Streamly.SerialT (P.Sem r) a)
streamAsAction :: StreamWithCacheTime r a
-> ActionWithCacheTime r (SerialT (Sem r) a)
streamAsAction = (SerialT (Sem r) a -> Sem r (SerialT (Sem r) a))
-> StreamWithCacheTime r a
-> ActionWithCacheTime r (SerialT (Sem r) a)
forall (r :: [(* -> *) -> * -> *]) a b.
(SerialT (Sem r) a -> Sem r b)
-> StreamWithCacheTime r a -> ActionWithCacheTime r b
streamToAction SerialT (Sem r) a -> Sem r (SerialT (Sem r) a)
forall (m :: * -> *) a. Monad m => a -> m a
return
{-# INLINEABLE streamAsAction #-}
ignoreCacheTimeStream :: P.Sem r (StreamWithCacheTime r a) -> Streamly.SerialT (P.Sem r) a
ignoreCacheTimeStream :: Sem r (StreamWithCacheTime r a) -> SerialT (Sem r) a
ignoreCacheTimeStream = Sem r (SerialT (Sem r) a) -> SerialT (Sem r) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(IsStream t, Monad m) =>
m (t m a) -> t m a
Streamly.concatM (Sem r (SerialT (Sem r) a) -> SerialT (Sem r) a)
-> (Sem r (StreamWithCacheTime r a) -> Sem r (SerialT (Sem r) a))
-> Sem r (StreamWithCacheTime r a)
-> SerialT (Sem r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StreamWithCacheTime r a -> SerialT (Sem r) a)
-> Sem r (StreamWithCacheTime r a) -> Sem r (SerialT (Sem r) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap StreamWithCacheTime r a -> SerialT (Sem r) a
forall k (m :: k -> *) (a :: k). WithCacheTime m a -> m a
C.ignoreCacheTime
{-# INLINEABLE ignoreCacheTimeStream #-}
retrieveStream
:: forall sc k ct r a.
(P.Members '[KS.SerializeEnv sc ct, C.Cache k ct, P.Error C.CacheError, P.Embed IO] r
, K.LogWithPrefixesLE r
, P.MemberWithError (P.Error Exceptions.SomeException) r
, Show k
, sc [a])
=> k
-> Maybe Time.UTCTime
-> P.Sem r (StreamWithCacheTime r a)
retrieveStream :: k -> Maybe UTCTime -> Sem r (StreamWithCacheTime r a)
retrieveStream k :: k
k newestM :: Maybe UTCTime
newestM = Text
-> Sem r (StreamWithCacheTime r a)
-> Sem r (StreamWithCacheTime r a)
forall (effs :: [(* -> *) -> * -> *]) a.
Member PrefixLog effs =>
Text -> Sem effs a -> Sem effs a
K.wrapPrefix ("Cache.retrieveStream (key=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ k -> String
forall a. Show a => a -> String
show k
k) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ")") (Sem r (StreamWithCacheTime r a)
-> Sem r (StreamWithCacheTime r a))
-> Sem r (StreamWithCacheTime r a)
-> Sem r (StreamWithCacheTime r a)
forall a b. (a -> b) -> a -> b
$ do
SerializeDict sc ct
cacheSD <- Sem r (SerializeDict sc ct)
forall (c :: * -> Constraint) ct (r :: [(* -> *) -> * -> *]).
Member (SerializeEnv c ct) r =>
Sem r (SerializeDict c ct)
KS.getSerializeDict
(WithCacheTime (Sem r) (SerialT (Sem r) a)
-> StreamWithCacheTime r a)
-> Sem r (WithCacheTime (Sem r) (SerialT (Sem r) a))
-> Sem r (StreamWithCacheTime r a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Sem r (SerialT (Sem r) a) -> SerialT (Sem r) a)
-> WithCacheTime (Sem r) (SerialT (Sem r) a)
-> StreamWithCacheTime r a
forall k1 k2 (m :: k1 -> *) (a :: k1) (n :: k2 -> *) (b :: k2).
(m a -> n b) -> WithCacheTime m a -> WithCacheTime n b
C.wctMapAction Sem r (SerialT (Sem r) a) -> SerialT (Sem r) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(IsStream t, Monad m) =>
m (t m a) -> t m a
Streamly.concatM)
(Sem r (WithCacheTime (Sem r) (SerialT (Sem r) a))
-> Sem r (StreamWithCacheTime r a))
-> Sem r (WithCacheTime (Sem r) (SerialT (Sem r) a))
-> Sem r (StreamWithCacheTime r a)
forall a b. (a -> b) -> a -> b
$ Serialize CacheError r (SerialT (Sem r) a) ct
-> k
-> Maybe UTCTime
-> Sem r (WithCacheTime (Sem r) (SerialT (Sem r) a))
forall ct k (r :: [(* -> *) -> * -> *]) a.
(Member (Cache k ct) r, Member (Embed IO) r,
MemberWithError (Error CacheError) r, LogWithPrefixesLE r,
Show k) =>
Serialize CacheError r a ct
-> k -> Maybe UTCTime -> Sem r (ActionWithCacheTime r a)
C.retrieveAndDecode (SerializeDict sc ct
-> Serialize CacheError r (SerialT (Sem r) a) ct
forall (sc :: * -> Constraint) a (r :: [(* -> *) -> * -> *]) ct.
(sc [a], Member (Embed IO) r,
MemberWithError (Error CacheError) r) =>
SerializeDict sc ct
-> Serialize CacheError r (SerialT (Sem r) a) ct
knitSerializeStream SerializeDict sc ct
cacheSD) k
k Maybe UTCTime
newestM
{-# INLINEABLE retrieveStream #-}
retrieveOrMakeStream
:: forall sc k ct r a b.
( P.Members '[KS.SerializeEnv sc ct, C.Cache k ct, P.Error C.CacheError, P.Embed IO] r
, K.LogWithPrefixesLE r
, P.MemberWithError (P.Error Exceptions.SomeException) r
, Show k
, sc [a]
)
=> k
-> C.ActionWithCacheTime r b
-> (b -> Streamly.SerialT (P.Sem r) a)
-> P.Sem r (StreamWithCacheTime r a)
retrieveOrMakeStream :: k
-> ActionWithCacheTime r b
-> (b -> SerialT (Sem r) a)
-> Sem r (StreamWithCacheTime r a)
retrieveOrMakeStream k :: k
k cachedDeps :: ActionWithCacheTime r b
cachedDeps toMake :: b -> SerialT (Sem r) a
toMake = Text
-> Sem r (StreamWithCacheTime r a)
-> Sem r (StreamWithCacheTime r a)
forall (effs :: [(* -> *) -> * -> *]) a.
Member PrefixLog effs =>
Text -> Sem effs a -> Sem effs a
K.wrapPrefix ("Cache.retrieveOrMakeStream (key=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ k -> String
forall a. Show a => a -> String
show k
k) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ")") (Sem r (StreamWithCacheTime r a)
-> Sem r (StreamWithCacheTime r a))
-> Sem r (StreamWithCacheTime r a)
-> Sem r (StreamWithCacheTime r a)
forall a b. (a -> b) -> a -> b
$ do
SerializeDict sc ct
cacheSD <- Sem r (SerializeDict sc ct)
forall (c :: * -> Constraint) ct (r :: [(* -> *) -> * -> *]).
Member (SerializeEnv c ct) r =>
Sem r (SerializeDict c ct)
KS.getSerializeDict
(WithCacheTime (Sem r) (SerialT (Sem r) a)
-> StreamWithCacheTime r a)
-> Sem r (WithCacheTime (Sem r) (SerialT (Sem r) a))
-> Sem r (StreamWithCacheTime r a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Sem r (SerialT (Sem r) a) -> SerialT (Sem r) a)
-> WithCacheTime (Sem r) (SerialT (Sem r) a)
-> StreamWithCacheTime r a
forall k1 k2 (m :: k1 -> *) (a :: k1) (n :: k2 -> *) (b :: k2).
(m a -> n b) -> WithCacheTime m a -> WithCacheTime n b
C.wctMapAction Sem r (SerialT (Sem r) a) -> SerialT (Sem r) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(IsStream t, Monad m) =>
m (t m a) -> t m a
Streamly.concatM)
(Sem r (WithCacheTime (Sem r) (SerialT (Sem r) a))
-> Sem r (StreamWithCacheTime r a))
-> Sem r (WithCacheTime (Sem r) (SerialT (Sem r) a))
-> Sem r (StreamWithCacheTime r a)
forall a b. (a -> b) -> a -> b
$ Serialize CacheError r (SerialT (Sem r) a) ct
-> k
-> ActionWithCacheTime r b
-> (b -> Sem r (SerialT (Sem r) a))
-> Sem r (WithCacheTime (Sem r) (SerialT (Sem r) a))
forall ct k (r :: [(* -> *) -> * -> *]) a b.
(Member (Cache k ct) r, LogWithPrefixesLE r, Member (Embed IO) r,
MemberWithError (Error CacheError) r, Show k) =>
Serialize CacheError r a ct
-> k
-> ActionWithCacheTime r b
-> (b -> Sem r a)
-> Sem r (ActionWithCacheTime r a)
C.retrieveOrMake (SerializeDict sc ct
-> Serialize CacheError r (SerialT (Sem r) a) ct
forall (sc :: * -> Constraint) a (r :: [(* -> *) -> * -> *]) ct.
(sc [a], Member (Embed IO) r,
MemberWithError (Error CacheError) r) =>
SerializeDict sc ct
-> Serialize CacheError r (SerialT (Sem r) a) ct
knitSerializeStream SerializeDict sc ct
cacheSD) k
k ActionWithCacheTime r b
cachedDeps (SerialT (Sem r) a -> Sem r (SerialT (Sem r) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (SerialT (Sem r) a -> Sem r (SerialT (Sem r) a))
-> (b -> SerialT (Sem r) a) -> b -> Sem r (SerialT (Sem r) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> SerialT (Sem r) a
toMake)
{-# INLINEABLE retrieveOrMakeStream #-}
retrieveOrMakeTransformedStream
:: forall sc ct k r a b c.
( P.Members '[KS.SerializeEnv sc ct, C.Cache k ct, P.Error C.CacheError, P.Embed IO] r
, K.LogWithPrefixesLE r
, P.MemberWithError (P.Error Exceptions.SomeException) r
, Show k
, sc [b]
)
=> (a -> b)
-> (b -> a)
-> k
-> C.ActionWithCacheTime r c
-> (c -> Streamly.SerialT (P.Sem r) a)
-> P.Sem r (StreamWithCacheTime r a)
retrieveOrMakeTransformedStream :: (a -> b)
-> (b -> a)
-> k
-> ActionWithCacheTime r c
-> (c -> SerialT (Sem r) a)
-> Sem r (StreamWithCacheTime r a)
retrieveOrMakeTransformedStream toSerializable :: a -> b
toSerializable fromSerializable :: b -> a
fromSerializable k :: k
k cachedDeps :: ActionWithCacheTime r c
cachedDeps toMake :: c -> SerialT (Sem r) a
toMake =
Text
-> Sem r (StreamWithCacheTime r a)
-> Sem r (StreamWithCacheTime r a)
forall (effs :: [(* -> *) -> * -> *]) a.
Member PrefixLog effs =>
Text -> Sem effs a -> Sem effs a
K.wrapPrefix ("retrieveOrMakeTransformedStream (key=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ k -> String
forall a. Show a => a -> String
show k
k) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ")")
(Sem r (StreamWithCacheTime r a)
-> Sem r (StreamWithCacheTime r a))
-> Sem r (StreamWithCacheTime r a)
-> Sem r (StreamWithCacheTime r a)
forall a b. (a -> b) -> a -> b
$ (WithCacheTime (SerialT (Sem r)) b -> StreamWithCacheTime r a)
-> Sem r (WithCacheTime (SerialT (Sem r)) b)
-> Sem r (StreamWithCacheTime r a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((SerialT (Sem r) b -> SerialT (Sem r) a)
-> WithCacheTime (SerialT (Sem r)) b -> StreamWithCacheTime r a
forall k1 k2 (m :: k1 -> *) (a :: k1) (n :: k2 -> *) (b :: k2).
(m a -> n b) -> WithCacheTime m a -> WithCacheTime n b
C.wctMapAction ((SerialT (Sem r) b -> SerialT (Sem r) a)
-> WithCacheTime (SerialT (Sem r)) b -> StreamWithCacheTime r a)
-> (SerialT (Sem r) b -> SerialT (Sem r) a)
-> WithCacheTime (SerialT (Sem r)) b
-> StreamWithCacheTime r a
forall a b. (a -> b) -> a -> b
$ (b -> a) -> SerialT (Sem r) b -> SerialT (Sem r) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
(IsStream t, Monad m) =>
(a -> b) -> t m a -> t m b
Streamly.map b -> a
fromSerializable)
(Sem r (WithCacheTime (SerialT (Sem r)) b)
-> Sem r (StreamWithCacheTime r a))
-> Sem r (WithCacheTime (SerialT (Sem r)) b)
-> Sem r (StreamWithCacheTime r a)
forall a b. (a -> b) -> a -> b
$ k
-> ActionWithCacheTime r c
-> (c -> SerialT (Sem r) b)
-> Sem r (WithCacheTime (SerialT (Sem r)) b)
forall (sc :: * -> Constraint) k ct (r :: [(* -> *) -> * -> *]) a
b.
(Members
'[SerializeEnv sc ct, Cache k ct, Error CacheError, Embed IO] r,
LogWithPrefixesLE r, MemberWithError (Error SomeException) r,
Show k, sc [a]) =>
k
-> ActionWithCacheTime r b
-> (b -> SerialT (Sem r) a)
-> Sem r (StreamWithCacheTime r a)
retrieveOrMakeStream k
k ActionWithCacheTime r c
cachedDeps ((a -> b) -> SerialT (Sem r) a -> SerialT (Sem r) b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
(IsStream t, Monad m) =>
(a -> b) -> t m a -> t m b
Streamly.map a -> b
toSerializable (SerialT (Sem r) a -> SerialT (Sem r) b)
-> (c -> SerialT (Sem r) a) -> c -> SerialT (Sem r) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> SerialT (Sem r) a
toMake)
{-# INLINEABLE retrieveOrMakeTransformedStream #-}