{-# 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 { SaverLoader a -> a -> Maybe Text
_slSave :: a -> Maybe Text
        , SaverLoader a -> Text -> Maybe a
_slLoad :: Text -> Maybe a
        }

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

cacheing
    :: MonadIO m
    => FilePath
    -> SaverLoader a
    -> m a
    -> m a
cacheing :: 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 <- IO (Maybe a) -> m (Maybe a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe a) -> m (Maybe a)) -> IO (Maybe a) -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ do
      Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True (FilePath -> FilePath
takeDirectory FilePath
fp)
      (Text -> Maybe a
_slLoad (Text -> Maybe a) -> Maybe Text -> Maybe a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (Maybe Text -> Maybe a) -> IO (Maybe Text) -> IO (Maybe a)
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
        IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (Maybe Text -> IO ()) -> Maybe Text -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> IO ()) -> Maybe Text -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (FilePath -> Text -> IO ()
T.writeFile FilePath
fp) (Maybe Text -> m ()) -> Maybe Text -> m ()
forall a b. (a -> b) -> a -> b
$ a -> Maybe Text
_slSave a
r
        a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
r
      Just a
o  -> a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
o

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