{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE RecordWildCards           #-}

-- |
-- Module      : Advent.Throttle
-- Copyright   : (c) Justin Le 2018
-- License     : BSD3
--
-- Maintainer  : justin@jle.im
-- Stability   : experimental
-- Portability : non-portable
--
-- (Internal) Implement cacheing of API requests.

module Advent.Cache (
    cacheing
  , SaverLoader(..)
  , noCache
  ) where

import           Control.DeepSeq
import           Control.Exception
import           Control.Monad
import           Control.Monad.IO.Class
import           Data.Text              (Text)
import           System.Directory
import           System.FilePath
import           System.IO.Error
import qualified Data.Text.IO           as T

data SaverLoader a =
     SL { forall a. SaverLoader a -> a -> Maybe Text
_slSave :: a -> Maybe Text
        , forall a. SaverLoader a -> Text -> Maybe a
_slLoad :: Text -> Maybe a
        }

noCache :: SaverLoader a
noCache :: forall a. SaverLoader a
noCache = forall a. (a -> Maybe Text) -> (Text -> Maybe a) -> SaverLoader a
SL (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) (forall a b. a -> b -> a
const forall a. Maybe a
Nothing)

cacheing
    :: MonadIO m
    => FilePath
    -> SaverLoader a
    -> m a
    -> m a
cacheing :: forall (m :: * -> *) a.
MonadIO m =>
FilePath -> SaverLoader a -> m a -> m a
cacheing FilePath
fp SL{a -> Maybe Text
Text -> Maybe a
_slLoad :: Text -> Maybe a
_slSave :: a -> Maybe Text
_slLoad :: forall a. SaverLoader a -> Text -> Maybe a
_slSave :: forall a. SaverLoader a -> a -> Maybe Text
..} m a
act = do
    Maybe a
old <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
      Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True (FilePath -> FilePath
takeDirectory FilePath
fp)
      (Text -> Maybe a
_slLoad forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO (Maybe Text)
readFileMaybe FilePath
fp
    case Maybe a
old of
      Maybe a
Nothing -> do
        a
r <- m a
act
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (FilePath -> Text -> IO ()
T.writeFile FilePath
fp) forall a b. (a -> b) -> a -> b
$ a -> Maybe Text
_slSave a
r
        forall (f :: * -> *) a. Applicative f => a -> f a
pure a
r
      Just a
o  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
o

readFileMaybe :: FilePath -> IO (Maybe Text)
readFileMaybe :: FilePath -> IO (Maybe Text)
readFileMaybe =
     (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall a. a -> IO a
evaluate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NFData a => a -> a
force) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<)
   forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e b a.
Exception e =>
(e -> Maybe b) -> IO a -> IO (Either b a)
tryJust (forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOError -> Bool
isDoesNotExistError)
   forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO Text
T.readFile