Browse Source

Cache the TMDB configuration

tags/v0.2.0.0
Peter J. Jones 3 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 @@
1 1
 * Milestone: Release 0.2.0.0
2
-** TODO Cache TMDB.Configuration
2
+** DONE Cache TMDB.Configuration
3
+   CLOSED: [2015-07-22 Wed 19:27]
3 4
 ** DONE Add support for --version
4 5
    CLOSED: [2015-07-21 Tue 21:00]
5 6
 ** DONE Search for FIXME and undefined and remove

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

@@ -0,0 +1,95 @@
1
+{-# LANGUAGE OverloadedStrings #-}
2
+
3
+{-
4
+
5
+This file is part of the vimeta package. It is subject to the license
6
+terms in the LICENSE file found in the top-level directory of this
7
+distribution and at git://pmade.com/vimeta/LICENSE. No part of the
8
+vimeta package, including this file, may be copied, modified,
9
+propagated, or distributed except according to the terms contained in
10
+the LICENSE file.
11
+
12
+-}
13
+
14
+--------------------------------------------------------------------------------
15
+-- | Caching functions.
16
+module Vimeta.Core.Cache
17
+       ( cacheTMDBConfig
18
+       ) where
19
+
20
+--------------------------------------------------------------------------------
21
+import Control.Monad.IO.Class
22
+import Data.Aeson as Aeson
23
+import qualified Data.ByteString.Lazy as BL
24
+import Data.Time.Calendar
25
+import Data.Time.Clock
26
+import qualified Network.API.TheMovieDB as TheMovieDB
27
+import System.Directory (doesFileExist, getModificationTime, createDirectoryIfMissing)
28
+import System.Environment.XDG.BaseDir (getUserCacheFile)
29
+import System.FilePath (takeDirectory)
30
+
31
+--------------------------------------------------------------------------------
32
+-- | Manage cache file expiration.
33
+data Age = MaxDays Int          -- ^ Cap to N days.
34
+
35
+--------------------------------------------------------------------------------
36
+ageAsTime :: Age -> UTCTime -> UTCTime
37
+ageAsTime (MaxDays days) now =
38
+  now {utctDay = addDays (fromIntegral (-days)) (utctDay now)}
39
+
40
+--------------------------------------------------------------------------------
41
+-- | The file name for catching @TheMovieDB.Configuration@.
42
+tmdbCacheFile :: IO FilePath
43
+tmdbCacheFile = getUserCacheFile "vimeta" "tmdb-config.json"
44
+
45
+--------------------------------------------------------------------------------
46
+-- | Produce a cached version of @TheMovieDB.Configuration@ or use
47
+-- the given action to create a cache a new value.
48
+cacheTMDBConfig :: (MonadIO m)
49
+                => m (Either e TheMovieDB.Configuration)
50
+                -> m (Either e TheMovieDB.Configuration)
51
+cacheTMDBConfig action = do
52
+  file <- liftIO tmdbCacheFile
53
+  cache file (MaxDays 3) action
54
+
55
+--------------------------------------------------------------------------------
56
+-- | Generic cache reader.
57
+readCache :: (MonadIO m, FromJSON a) => FilePath -> Age -> m (Maybe a)
58
+readCache filename age = do
59
+  exists <- liftIO (doesFileExist filename)
60
+  if not exists then return Nothing else go
61
+
62
+  where
63
+    go = do
64
+      now     <- liftIO getCurrentTime
65
+      modtime <- liftIO (getModificationTime filename)
66
+
67
+      if fresh now modtime
68
+         then Aeson.decode' <$> liftIO (BL.readFile filename)
69
+         else return Nothing
70
+
71
+    fresh :: UTCTime -> UTCTime -> Bool
72
+    fresh now modtime = ageAsTime age now <= modtime
73
+
74
+--------------------------------------------------------------------------------
75
+-- | Generic cache writer.
76
+writeCache :: (MonadIO m, ToJSON a) => FilePath -> a -> m ()
77
+writeCache filename value = liftIO $ do
78
+  createDirectoryIfMissing True (takeDirectory filename)
79
+  BL.writeFile filename (Aeson.encode value)
80
+
81
+--------------------------------------------------------------------------------
82
+-- | Generic caching function.
83
+cache :: (MonadIO m, FromJSON a, ToJSON a)
84
+      => FilePath               -- ^ Cache file.
85
+      -> Age                    -- ^ Age of cache file.
86
+      -> m (Either e a)         -- ^ Action to generate new value.
87
+      -> m (Either e a)         -- ^ Cached or new value.
88
+cache file age action = do
89
+  cached <- liftIO (readCache file age)
90
+
91
+  case cached of
92
+    Just c  -> return (Right c)
93
+    Nothing -> do result <- action
94
+                  either (const $ return ()) (writeCache file) result
95
+                  return result

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

@@ -45,6 +45,7 @@ import System.IO (Handle, stdout)
45 45
 
46 46
 --------------------------------------------------------------------------------
47 47
 -- Local imports:
48
+import Vimeta.Core.Cache
48 49
 import Vimeta.Core.Config
49 50
 
50 51
 --------------------------------------------------------------------------------
@@ -110,8 +111,7 @@ verbose msg = do
110 111
 --------------------------------------------------------------------------------
111 112
 loadTMDBConfig :: (MonadIO m) => Manager -> Key -> EitherT String m TheMovieDB.Configuration
112 113
 loadTMDBConfig manager key = do
113
-  -- FIXME: Cache the config value
114
-  result <- liftIO $ runTheMovieDBWithManager manager key TheMovieDB.config
114
+  result <- cacheTMDBConfig (liftIO $ runTheMovieDBWithManager manager key TheMovieDB.config)
115 115
 
116 116
   case result of
117 117
     Left e  -> left (show e)

+ 1
- 0
vimeta.cabal View File

@@ -39,6 +39,7 @@ flag maintainer
39 39
 library
40 40
   exposed-modules:
41 41
     Vimeta.Core
42
+    Vimeta.Core.Cache
42 43
     Vimeta.Core.Config
43 44
     Vimeta.Core.Download
44 45
     Vimeta.Core.Format

Loading…
Cancel
Save