{-# LANGUAGE OverloadedStrings #-}
module Vimeta.Core.Cache
( cacheTMDBConfig
) where
import Control.Monad (liftM)
import Control.Monad.IO.Class
import Data.Aeson as Aeson
import qualified Data.ByteString.Lazy as BL
import Data.Time.Calendar
import Data.Time.Clock
import qualified Network.API.TheMovieDB as TheMovieDB
import System.Directory (doesFileExist, getModificationTime, createDirectoryIfMissing)
import System.Environment.XDG.BaseDir (getUserCacheFile)
import System.FilePath (takeDirectory)
data Age = MaxDays Int
ageAsTime :: Age -> UTCTime -> UTCTime
ageAsTime (MaxDays days) now =
now {utctDay = addDays (fromIntegral (-days)) (utctDay now)}
tmdbCacheFile :: IO FilePath
tmdbCacheFile = getUserCacheFile "vimeta" "tmdb-config.json"
cacheTMDBConfig :: (MonadIO m)
=> m (Either e TheMovieDB.Configuration)
-> m (Either e TheMovieDB.Configuration)
cacheTMDBConfig action = do
file <- liftIO tmdbCacheFile
cache file (MaxDays 3) action
readCache :: (MonadIO m, FromJSON a) => FilePath -> Age -> m (Maybe a)
readCache filename age = do
exists <- liftIO (doesFileExist filename)
if not exists then return Nothing else go
where
go = do
now <- liftIO getCurrentTime
modtime <- liftIO (getModificationTime filename)
if fresh now modtime
then Aeson.decode' `liftM` liftIO (BL.readFile filename)
else return Nothing
fresh :: UTCTime -> UTCTime -> Bool
fresh now modtime = ageAsTime age now <= modtime
writeCache :: (MonadIO m, ToJSON a) => FilePath -> a -> m ()
writeCache filename value = liftIO $ do
createDirectoryIfMissing True (takeDirectory filename)
BL.writeFile filename (Aeson.encode value)
cache :: (MonadIO m, FromJSON a, ToJSON a)
=> FilePath
-> Age
-> m (Either e a)
-> m (Either e a)
cache file age action = do
cached <- liftIO (readCache file age)
case cached of
Just c -> return (Right c)
Nothing -> do result <- action
either (const $ return ()) (writeCache file) result
return result