Browse Source

Cache the TMDB configuration

tags/v0.2.0.0
Peter J. Jones 4 years ago
parent
commit
10b3a57bb6
4 changed files with 100 additions and 3 deletions
  1. 2
    1
      TODO.org
  2. 95
    0
      src/Vimeta/Core/Cache.hs
  3. 2
    2
      src/Vimeta/Core/Vimeta.hs
  4. 1
    0
      vimeta.cabal

+ 2
- 1
TODO.org View File

@@ -1,5 +1,6 @@
* Milestone: Release 0.2.0.0
** TODO Cache TMDB.Configuration
** DONE Cache TMDB.Configuration
CLOSED: [2015-07-22 Wed 19:27]
** DONE Add support for --version
CLOSED: [2015-07-21 Tue 21:00]
** DONE Search for FIXME and undefined and remove

+ 95
- 0
src/Vimeta/Core/Cache.hs View File

@@ -0,0 +1,95 @@
{-# LANGUAGE OverloadedStrings #-}

{-

This file is part of the vimeta package. It is subject to the license
terms in the LICENSE file found in the top-level directory of this
distribution and at git://pmade.com/vimeta/LICENSE. No part of the
vimeta package, including this file, may be copied, modified,
propagated, or distributed except according to the terms contained in
the LICENSE file.

-}

--------------------------------------------------------------------------------
-- | Caching functions.
module Vimeta.Core.Cache
( cacheTMDBConfig
) where

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

--------------------------------------------------------------------------------
-- | Manage cache file expiration.
data Age = MaxDays Int -- ^ Cap to N days.

--------------------------------------------------------------------------------
ageAsTime :: Age -> UTCTime -> UTCTime
ageAsTime (MaxDays days) now =
now {utctDay = addDays (fromIntegral (-days)) (utctDay now)}

--------------------------------------------------------------------------------
-- | The file name for catching @TheMovieDB.Configuration@.
tmdbCacheFile :: IO FilePath
tmdbCacheFile = getUserCacheFile "vimeta" "tmdb-config.json"

--------------------------------------------------------------------------------
-- | Produce a cached version of @TheMovieDB.Configuration@ or use
-- the given action to create a cache a new value.
cacheTMDBConfig :: (MonadIO m)
=> m (Either e TheMovieDB.Configuration)
-> m (Either e TheMovieDB.Configuration)
cacheTMDBConfig action = do
file <- liftIO tmdbCacheFile
cache file (MaxDays 3) action

--------------------------------------------------------------------------------
-- | Generic cache reader.
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' <$> liftIO (BL.readFile filename)
else return Nothing

fresh :: UTCTime -> UTCTime -> Bool
fresh now modtime = ageAsTime age now <= modtime

--------------------------------------------------------------------------------
-- | Generic cache writer.
writeCache :: (MonadIO m, ToJSON a) => FilePath -> a -> m ()
writeCache filename value = liftIO $ do
createDirectoryIfMissing True (takeDirectory filename)
BL.writeFile filename (Aeson.encode value)

--------------------------------------------------------------------------------
-- | Generic caching function.
cache :: (MonadIO m, FromJSON a, ToJSON a)
=> FilePath -- ^ Cache file.
-> Age -- ^ Age of cache file.
-> m (Either e a) -- ^ Action to generate new value.
-> m (Either e a) -- ^ Cached or new value.
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

+ 2
- 2
src/Vimeta/Core/Vimeta.hs View File

@@ -45,6 +45,7 @@ import System.IO (Handle, stdout)

--------------------------------------------------------------------------------
-- Local imports:
import Vimeta.Core.Cache
import Vimeta.Core.Config

--------------------------------------------------------------------------------
@@ -110,8 +111,7 @@ verbose msg = do
--------------------------------------------------------------------------------
loadTMDBConfig :: (MonadIO m) => Manager -> Key -> EitherT String m TheMovieDB.Configuration
loadTMDBConfig manager key = do
-- FIXME: Cache the config value
result <- liftIO $ runTheMovieDBWithManager manager key TheMovieDB.config
result <- cacheTMDBConfig (liftIO $ runTheMovieDBWithManager manager key TheMovieDB.config)

case result of
Left e -> left (show e)

+ 1
- 0
vimeta.cabal View File

@@ -39,6 +39,7 @@ flag maintainer
library
exposed-modules:
Vimeta.Core
Vimeta.Core.Cache
Vimeta.Core.Config
Vimeta.Core.Download
Vimeta.Core.Format

Loading…
Cancel
Save