{-# 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 { forall a. 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
$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
/= :: 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
$cshowsPrec :: forall a. Show a => Int -> Cache a -> ShowS
showsPrec :: Int -> Cache a -> ShowS
$cshow :: forall a. Show a => Cache a -> String
show :: Cache a -> String
$cshowList :: forall a. Show a => [Cache a] -> ShowS
showList :: [Cache a] -> ShowS
Show, 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
$c<> :: forall a. Semigroup a => Cache a -> Cache a -> Cache a
<> :: Cache a -> Cache a -> Cache a
$csconcat :: forall a. Semigroup a => NonEmpty (Cache a) -> Cache a
sconcat :: NonEmpty (Cache a) -> Cache a
$cstimes :: forall a b. (Semigroup a, Integral b) => b -> Cache a -> Cache a
stimes :: forall b. Integral b => b -> 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
$cmempty :: forall a. Monoid a => Cache a
mempty :: Cache a
$cmappend :: forall a. Monoid a => Cache a -> Cache a -> Cache a
mappend :: Cache a -> Cache a -> Cache a
$cmconcat :: forall a. Monoid a => [Cache a] -> Cache a
mconcat :: [Cache a] -> Cache a
Monoid, (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
$cfmap :: forall a b. (a -> b) -> Cache a -> Cache b
fmap :: forall a b. (a -> b) -> Cache a -> Cache b
$c<$ :: forall a b. a -> Cache b -> Cache a
<$ :: forall a b. a -> Cache b -> Cache a
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 :: forall (m :: * -> *) a.
(Applicative m, Eq a) =>
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 :: forall (m :: * -> *) a.
(Applicative m, Eq a) =>
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 :: forall (m :: * -> *) a b.
(Applicative m, Eq a) =>
(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)