Caching.hs

{-|
Module      : Slick.Shake
Description : DEPRECATED -- Advanced caching tools for using slick with shake
Copyright   : (c) Chris Penner, 2019
License     : BSD3
-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE TypeFamilies               #-}

module Slick.Caching {-# DEPRECATED "No longer necessary with slick >= 0.3.0.0" #-}
  ( simpleJsonCache
  , simpleJsonCache'
  , jsonCache
  , jsonCache'
  )
where

import Data.Aeson                 as A
import Data.ByteString.Lazy
import Development.Shake          hiding (Resource)
import Development.Shake.Classes
import GHC.Generics               (Generic)

--------------------------------------------------------------------------------

newtype CacheQuery q =
  CacheQuery q
  deriving (Show, Eq, Generic, Binary, NFData, Hashable)

type instance RuleResult (CacheQuery q) = ByteString

-- | Note that you probably don't need this if you're using the recommended @Development.Shake.Forward@ module. It can do a lot of caching for you, otherwise look at 'Development.Shake.Forward.cacheAction'.
--
-- A wrapper around 'addOracleCache' which given a @q@ which is a 'ShakeValue'
-- allows caching and retrieving 'Value's within Shake. See documentation on
-- 'addOracleCache' or see Slick examples for more info.
--
-- > -- We need to define a unique datatype as our cache key
-- > newtype PostFilePath =
-- >   PostFilePath String
-- > -- We can derive the classes we need (using GeneralizedNewtypeDeriving)
-- > -- so long as the underlying type implements them
-- >   deriving (Show, Eq, Hashable, Binary, NFData)
-- > -- now in our shake rules we can create a cache by providing a loader action
-- >
-- > do
-- > postCache <- jsonCache $ \(PostFilePath path) ->
-- >   readFile' path >>= markdownToHTML . Text.pack
-- > -- Now use postCache inside an Action to load your post with caching!
jsonCache :: ShakeValue q => (q -> Action Value) -> Rules (q -> Action Value)
jsonCache = jsonCache'

-- | Like 'jsonCache' but allows caching/retrieving any JSON serializable
-- objects.
jsonCache'
  :: forall a q
   . (ToJSON a, FromJSON a, ShakeValue q)
  => (q -> Action a)
  -> Rules (q -> Action a)
jsonCache' loader = unpackJSON
  <$> addOracleCache (\(CacheQuery q) -> A.encode <$> loader q)
 where
  unpackJSON
    :: FromJSON a => (CacheQuery q -> Action ByteString) -> q -> Action a
  unpackJSON runCacheQuery = \q -> do
    bytes <- runCacheQuery $ CacheQuery q
    case A.eitherDecode bytes of
      Left  err -> fail err
      Right res -> pure res

-- | Note that you probably don't need this if you're using the recommended @Development.Shake.Forward@ module. It can do a lot of caching for you, otherwise look at 'Development.Shake.Forward.cacheAction'.
--
-- A wrapper around 'jsonCache' which simplifies caching of values which do NOT
-- depend on an input parameter. Unfortunately Shake still requires that the
-- key type implement several typeclasses, however this is easily accomplished
-- using @GeneralizedNewtypeDeriving@ and a wrapper around @()@.
-- example usage:
--
-- > {-# LANGUAGE GeneralizedNewtypeDeriving #-}
-- > module Main where
-- > newtype ProjectList = ProjectList ()
-- >   deriving (Show, Eq, Hashable, Binary, NFData)
--  Within your shake Rules:
--
-- > projectCache = simpleJsonCache (ProjectList ()) $ do
-- >   -- load your project list here; returning it as a Value
simpleJsonCache :: ShakeValue q => q -> Action Value -> Rules (Action Value)
simpleJsonCache = simpleJsonCache'

-- | Like 'simpleJsonCache' but allows caching any JSON serializable object.
simpleJsonCache'
  :: forall q a
   . (ToJSON a, FromJSON a, ShakeValue q)
  => q
  -> Action a
  -> Rules (Action a)
simpleJsonCache' q loader = do
  cacheGetter <- jsonCache' (const loader)
  return $ cacheGetter q