{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Data.Cache
  ( Cache (..)
  , withCacheA
  , traceWithCache
  , mapTraceWithCache
  ) where

import           Control.Monad (when)
import           Control.Tracer (Tracer, traceWith)

-- | Cache newtype wrapper allows to perform an action only if the cache
-- is not up-to-date, i.e. different than another value dimmed more recent.
--
newtype Cache a = Cache { Cache a -> a
getCache :: a }
  deriving (Cache a -> Cache a -> Bool
(Cache a -> Cache a -> Bool)
-> (Cache a -> Cache a -> Bool) -> Eq (Cache a)
forall a. Eq a => Cache a -> Cache a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Cache a -> Cache a -> Bool
$c/= :: forall a. Eq a => Cache a -> Cache a -> Bool
== :: Cache a -> Cache a -> Bool
$c== :: forall a. Eq a => Cache a -> Cache a -> Bool
Eq, Int -> Cache a -> ShowS
[Cache a] -> ShowS
Cache a -> String
(Int -> Cache a -> ShowS)
-> (Cache a -> String) -> ([Cache a] -> ShowS) -> Show (Cache a)
forall a. Show a => Int -> Cache a -> ShowS
forall a. Show a => [Cache a] -> ShowS
forall a. Show a => Cache a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Cache a] -> ShowS
$cshowList :: forall a. Show a => [Cache a] -> ShowS
show :: Cache a -> String
$cshow :: forall a. Show a => Cache a -> String
showsPrec :: Int -> Cache a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Cache a -> ShowS
Show, b -> Cache a -> Cache a
NonEmpty (Cache a) -> Cache a
Cache a -> Cache a -> Cache a
(Cache a -> Cache a -> Cache a)
-> (NonEmpty (Cache a) -> Cache a)
-> (forall b. Integral b => b -> Cache a -> Cache a)
-> Semigroup (Cache a)
forall b. Integral b => b -> Cache a -> Cache a
forall a. Semigroup a => NonEmpty (Cache a) -> Cache a
forall a. Semigroup a => Cache a -> Cache a -> Cache a
forall a b. (Semigroup a, Integral b) => b -> Cache a -> Cache a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> Cache a -> Cache a
$cstimes :: forall a b. (Semigroup a, Integral b) => b -> Cache a -> Cache a
sconcat :: NonEmpty (Cache a) -> Cache a
$csconcat :: forall a. Semigroup a => NonEmpty (Cache a) -> Cache a
<> :: Cache a -> Cache a -> Cache a
$c<> :: forall a. Semigroup a => Cache a -> Cache a -> Cache a
Semigroup, Semigroup (Cache a)
Cache a
Semigroup (Cache a)
-> Cache a
-> (Cache a -> Cache a -> Cache a)
-> ([Cache a] -> Cache a)
-> Monoid (Cache a)
[Cache a] -> Cache a
Cache a -> Cache a -> Cache a
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall a. Monoid a => Semigroup (Cache a)
forall a. Monoid a => Cache a
forall a. Monoid a => [Cache a] -> Cache a
forall a. Monoid a => Cache a -> Cache a -> Cache a
mconcat :: [Cache a] -> Cache a
$cmconcat :: forall a. Monoid a => [Cache a] -> Cache a
mappend :: Cache a -> Cache a -> Cache a
$cmappend :: forall a. Monoid a => Cache a -> Cache a -> Cache a
mempty :: Cache a
$cmempty :: forall a. Monoid a => Cache a
$cp1Monoid :: forall a. Monoid a => Semigroup (Cache a)
Monoid, a -> Cache b -> Cache a
(a -> b) -> Cache a -> Cache b
(forall a b. (a -> b) -> Cache a -> Cache b)
-> (forall a b. a -> Cache b -> Cache a) -> Functor Cache
forall a b. a -> Cache b -> Cache a
forall a b. (a -> b) -> Cache a -> Cache b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Cache b -> Cache a
$c<$ :: forall a b. a -> Cache b -> Cache a
fmap :: (a -> b) -> Cache a -> Cache b
$cfmap :: forall a b. (a -> b) -> Cache a -> Cache b
Functor)

-- | Run a computation that depends on a certain cached value, only if the
-- the most recent one is different.
--
withCacheA :: (Applicative m, Eq a) => Cache a -> a -> (a -> m ()) -> m ()
withCacheA :: Cache a -> a -> (a -> m ()) -> m ()
withCacheA (Cache a
a) a
a' a -> m ()
action =
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
a') (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
      a -> m ()
action a
a'

-- | Trace with cache only performs the tracing when the cached value is
-- different than the most recent one.
--
traceWithCache :: (Applicative m, Eq a) => Tracer m a -> Cache a -> a -> m ()
traceWithCache :: Tracer m a -> Cache a -> a -> m ()
traceWithCache Tracer m a
tracer Cache a
cache a
a =
    Cache a -> a -> (a -> m ()) -> m ()
forall (m :: * -> *) a.
(Applicative m, Eq a) =>
Cache a -> a -> (a -> m ()) -> m ()
withCacheA Cache a
cache a
a (Tracer m a -> a -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m a
tracer)

-- | Trace with cache only performs the tracing when the cached value is
-- different than the most recent one. And applies a function to the cache
-- value before tracing.
--
mapTraceWithCache :: (Applicative m, Eq a)
                  => (a -> b) -> Tracer m b -> Cache a -> a -> m ()
mapTraceWithCache :: (a -> b) -> Tracer m b -> Cache a -> a -> m ()
mapTraceWithCache a -> b
f Tracer m b
tracer Cache a
cache a
a =
    Cache a -> a -> (a -> m ()) -> m ()
forall (m :: * -> *) a.
(Applicative m, Eq a) =>
Cache a -> a -> (a -> m ()) -> m ()
withCacheA Cache a
cache a
a (Tracer m b -> b -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m b
tracer (b -> m ()) -> (a -> b) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)