diff options
Diffstat (limited to 'src/Hakyll/Core/Resource/MetadataCache.hs')
| -rw-r--r-- | src/Hakyll/Core/Resource/MetadataCache.hs | 61 |
1 files changed, 61 insertions, 0 deletions
diff --git a/src/Hakyll/Core/Resource/MetadataCache.hs b/src/Hakyll/Core/Resource/MetadataCache.hs new file mode 100644 index 0000000..b459674 --- /dev/null +++ b/src/Hakyll/Core/Resource/MetadataCache.hs @@ -0,0 +1,61 @@ +-------------------------------------------------------------------------------- +module Hakyll.Core.Resource.MetadataCache + ( resourceMetadata + , resourceBody + , resourceInvalidateMetadataCache + ) where + + +-------------------------------------------------------------------------------- +import Hakyll.Core.Resource +import Hakyll.Core.Resource.Metadata +import Hakyll.Core.Resource.Provider.Internal +import qualified Hakyll.Core.Store as Store + + +-------------------------------------------------------------------------------- +resourceMetadata :: ResourceProvider -> Resource -> IO Metadata +resourceMetadata rp r = do + load rp r + Store.Found md <- Store.get (resourceStore rp) + [name, unResource r, "metadata"] + return md + + +-------------------------------------------------------------------------------- +resourceBody :: ResourceProvider -> Resource -> IO String +resourceBody rp r = do + load rp r + Store.Found bd <- Store.get (resourceStore rp) + [name, unResource r, "body"] + maybe (resourceString r) return bd + + +-------------------------------------------------------------------------------- +resourceInvalidateMetadataCache :: ResourceProvider -> Resource -> IO () +resourceInvalidateMetadataCache rp r = do + Store.delete (resourceStore rp) [name, unResource r, "metadata"] + Store.delete (resourceStore rp) [name, unResource r, "body"] + + +-------------------------------------------------------------------------------- +load :: ResourceProvider -> Resource -> IO () +load rp r = do + mmd <- Store.get store mdk :: IO (Store.Result Metadata) + case mmd of + -- Already loaded + Store.Found _ -> return () + -- Not yet loaded + _ -> do + (metadata, body) <- loadMetadata rp r + Store.set store mdk metadata + Store.set store bk body + where + store = resourceStore rp + mdk = [name, unResource r, "metadata"] + bk = [name, unResource r, "body"] + + +-------------------------------------------------------------------------------- +name :: String +name = "Hakyll.Core.Resource.Provider.MetadataCache" |
