{-# LANGUAGE OverloadedStrings #-}

module System.Cached.JSON (
  getCachedJSON,
  getCachedJSONQuery,
  lookupKey
  )
where

import Control.Monad
import Data.Aeson
import qualified Data.ByteString.Lazy.Char8 as B
import Data.Time.Clock (diffUTCTime, getCurrentTime, NominalDiffTime)
import Network.HTTP.Query
import System.Directory
import System.Environment.XDG.BaseDir
import System.FilePath

-- | If the local cached json file is new enough then use it,
-- otherwise refresh from the remote url.
getCachedJSON :: (FromJSON a, ToJSON a)
              => String -- ^ subdirectory/program name
              -> FilePath -- ^ filename
              -> String -- ^ json url
              -> NominalDiffTime -- ^ cache duration (minutes)
              -> IO a
getCachedJSON :: String -> String -> String -> NominalDiffTime -> IO a
getCachedJSON String
prog String
jsonfile String
url =
  String -> String -> IO a -> NominalDiffTime -> IO a
forall a.
(FromJSON a, ToJSON a) =>
String -> String -> IO a -> NominalDiffTime -> IO a
getCachedJSONQuery String
prog String
jsonfile (String -> Query -> IO a
forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
String -> Query -> m a
webAPIQuery String
url [])

-- | Similar to getCachedJSON but takes an IO procedure that fetches
-- the remote json data.
getCachedJSONQuery :: (FromJSON a, ToJSON a)
                   => String -- ^ program name
                   -> FilePath -- ^ filename
                   -> IO a -- ^ http query
                   -> NominalDiffTime -- ^ cache duration (minutes)
                   -> IO a
getCachedJSONQuery :: String -> String -> IO a -> NominalDiffTime -> IO a
getCachedJSONQuery String
prog String
jsonfile IO a
webquery NominalDiffTime
minutes = do
  String
file <- String -> String -> IO String
getUserCacheFile String
prog String
jsonfile
  Bool
exists <- String -> IO Bool
doesFileExist String
file
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
exists (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Creating " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" ..."
    Bool -> String -> IO ()
createDirectoryIfMissing Bool
True (String -> String
takeDirectory String
file)
  Bool
recent <- do
    if Bool
exists
      then do
      Integer
size <- String -> IO Integer
getFileSize String
file
      if Integer
size Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0
        then Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
        else do
        UTCTime
ts <- String -> IO UTCTime
getModificationTime String
file
        UTCTime
t <- IO UTCTime
getCurrentTime
        Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
t UTCTime
ts NominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
< (NominalDiffTime
minutes NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
60)
      else Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
  if Bool
recent
    then do
    Either String a
eObj <- ByteString -> Either String a
forall a. FromJSON a => ByteString -> Either String a
eitherDecode (ByteString -> Either String a)
-> IO ByteString -> IO (Either String a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
B.readFile String
file
    case Either String a
eObj of
      Left String
err -> String -> IO a
forall a. HasCallStack => String -> a
error String
err
      Right a
obj -> a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
obj
    else do
    a
obj <- IO a
webquery
    String -> ByteString -> IO ()
B.writeFile String
file (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ a -> ByteString
forall a. ToJSON a => a -> ByteString
encode a
obj
    a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
obj