{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Slick.Caching
  ( 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

-- | 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.
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

-- | 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