diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,5 @@ +# Version history for cached-json-file + +## 0.1.0 (2021-07-29) +- initial release with getCachedJSON and getCachedJSONQuery +- exports lookupKey from http-query diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2021, Jens Petersen + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Jens Petersen nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,35 @@ +# cached-json-file + +A Haskell library providing a cached json file. + +Useful for frequently used programs that use some remote json data +which changes rather slowly (like in hours, days, weeks or months), +where it is not critical to have always the latest data immediately. + +## Usage + +`getCachedJSON dir file url minutes` caches the json obtained from `url` in +`~/.cache/dir/file` for `minutes`. + +eg: + +```haskell +import System.Cached.JSON + +getSnapshots :: IO Object +getSnapshots = + getCachedJSON "stackage-snapshots" "snapshots.json" "http://haddock.stackage.org/snapshots.json" 180 + +main = getSnapshots >>= print +``` + +Each time you run this program within 3 hours the data will be read +from the local cache file `~/.cache/stackage-snapshots/snapshots.json` +rather than re-downloading it each time, +which helps to speed up the program and avoid unnecessary web queries. + +There is also `getCachedJSONQuery prog jsonfile webquery minutes` +which uses `webquery :: (FromJSON a, ToJSON a) => IO a` to download +the json data. + +Currently the smallest possible cache time is 1 minute. diff --git a/cached-json-file.cabal b/cached-json-file.cabal new file mode 100644 --- /dev/null +++ b/cached-json-file.cabal @@ -0,0 +1,54 @@ +name: cached-json-file +version: 0.1.0 +synopsis: Locally cache a json file obtained by http +description: + A small library for caching a slow-changing remote json file in + a specified directory (under "~\/.cache\/"). When the json is requested + and the cache file is still fresh enough it is read directly from + the local cache, otherwise the cached file is refreshed first. +license: BSD3 +license-file: LICENSE +author: Jens Petersen +maintainer: Jens Petersen +copyright: 2021 Jens Petersen +category: Network +homepage: https://github.com/juhp/cached-json-file +bug-reports: https://github.com/juhp/cached-json-file/issues +build-type: Simple +extra-doc-files: README.md + ChangeLog.md +cabal-version: 2.0 +tested-with: GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.5, GHC == 8.8.4, + GHC == 8.10.4, GHC == 9.0.1 + +source-repository head + type: git + location: https://github.com/juhp/cached-json-file.git + +library + build-depends: base < 5, + aeson, + bytestring, + directory, + filepath, + http-query, + time, + xdg-basedir + default-language: Haskell2010 + exposed-modules: System.Cached.JSON + hs-source-dirs: src + + ghc-options: -Wall + if impl(ghc >= 8.0) + ghc-options: -Wcompat + -Widentities + -Wincomplete-uni-patterns + -Wincomplete-record-updates + -Wredundant-constraints + if impl(ghc >= 8.2) + ghc-options: -fhide-source-paths + if impl(ghc >= 8.4) + ghc-options: -Wmissing-export-lists + -Wpartial-fields + if impl(ghc >= 8.10) + ghc-options: -Wunused-packages diff --git a/src/System/Cached/JSON.hs b/src/System/Cached/JSON.hs new file mode 100644 --- /dev/null +++ b/src/System/Cached/JSON.hs @@ -0,0 +1,61 @@ +{-# 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 + +-- FIXME handle network failure + +-- | 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 prog jsonfile url = + getCachedJSONQuery prog jsonfile (webAPIQuery 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 prog jsonfile webquery minutes = do + file <- getUserCacheFile prog jsonfile + exists <- doesFileExist file + unless exists $ do + putStrLn $ "Creating " ++ file ++ " ..." + createDirectoryIfMissing True (takeDirectory file) + recent <- do + if exists then do + ts <- getModificationTime file + t <- getCurrentTime + return $ diffUTCTime t ts < (minutes * 60) + else return False + if recent + then do + eObj <- eitherDecode <$> B.readFile file + case eObj of + Left err -> error err + Right obj -> return obj + else do + obj <- webquery + B.writeFile file $ encode obj + return obj