Add comments to Guide.Cache

src/Guide/Cache.hs

@@ -25,31 +25,52 @@ import Guide.State
 import Guide.Utils
 
 
--- Left = someone started rendering but haven't finished yet
--- Right = result of the render
+{- | The cache is a (concurrent) map of rendered HTML for various pages and
+pieces of pages.
+
+* 'Left' means that someone has started rendering the piece but hasn't
+  finished yet; the 'Unique' specifies who started the rendering.
+
+* 'Right' gives you the result of a complete render.
+-}
 type Cache = STMMap.Map CacheKey (Either Unique LByteString)
 
+-- | The actual global cache.
 cache :: Cache
 {-# NOINLINE cache #-}
 cache = unsafePerformIO STMMap.newIO
 
+-- | 'CacheKey' specifies what exactly we're caching. Currently we only cache
+-- pieces of pages, never pages themselves.
 data CacheKey
+    -- | List of categories on the main page
   = CacheCategoryList
-  -- categories
+
+    -- | Whole category (but not the wrapper page)
   | CacheCategory (Uid Category)
+    -- | The header with category name + the edit form + possibly status banner
   | CacheCategoryInfo (Uid Category)
+    -- | Category description
   | CacheCategoryNotes (Uid Category)
-  -- items
+
+    -- | Whole item (but not the wrapper page)
   | CacheItem (Uid Item)
+    -- | Item header
   | CacheItemInfo (Uid Item)
+    -- | Item summary
   | CacheItemDescription (Uid Item)
+    -- | Item ecosystem
   | CacheItemEcosystem (Uid Item)
+    -- | Item “traits” section
   | CacheItemTraits (Uid Item)
+    -- | Item notes
   | CacheItemNotes (Uid Item)
   deriving (Show, Eq, Generic)
 
 instance Hashable CacheKey
 
+-- | Determine which parts should be re-rendered when a given part
+-- updates. (Including the given part itself.)
 cacheDepends :: GlobalState -> CacheKey -> [CacheKey]
 cacheDepends gs key = case key of
   CacheCategoryList    -> [key]
@@ -93,58 +114,61 @@ cacheDepends gs key = case key of
     let cat = findCategoryByItem x gs
     in  [key, CacheItem x, CacheCategory (cat^.uid)]
 
--- Note that cache invalidation has to happen before the actual action is
--- performed, because otherwise bad things can happen (e.g. if we're deleting
--- an item we have to invalidate the cache for its category, but if we've
--- already deleted the item we can't look up its category).
+{- | Remove a part from the cache, together with all parts that depend on it.
+
+Note that cache invalidation has to happen before the actual action is
+performed, because otherwise bad things can happen (e.g. if we're deleting an
+item we have to invalidate the cache for its category, but if we've already
+deleted the item we can't look up its category in the 'GlobalState').
+-}
 invalidateCache :: MonadIO m => GlobalState -> CacheKey -> m ()
 invalidateCache gs key = liftIO $ atomically $ do
   for_ (cacheDepends gs key) $ \k ->
     STMMap.delete k cache
 
+-- | Empty the whole cache.
 emptyCache :: MonadIO m => m ()
 emptyCache = liftIO $ atomically $ STMMap.deleteAll cache
 
+-- | Either take the rendered item from the cache, or render it and put it
+-- into the cache if it's not there.
 cached :: MonadIO m => CacheKey -> HtmlT IO () -> HtmlT m ()
 cached key gen = do
   -- If the item isn't in the cache, we'll have to render it, so we insert a
   -- unique mark if the item wasn't found, and we do it in the same STM
   -- transaction (so that nobody would be able to interfere)
   uniq <- liftIO newUnique
-  mbRes <- liftSTM $ do
+  mbRes <- liftSTM $ do                 -- liftSTM uses 'atomically'
     r <- STMMap.lookup key cache
     when (isNothing r) $
       STMMap.insert (Left uniq) key cache
     return r
-  -- Okay, so. What's the result?
   case mbRes of
-    -- The item was in the cache, so we just return it
+    -- If the item was in the cache already, we just return it
     Just (Right res) -> toHtmlRaw res
-    -- Someone else is already rendering this; we'll use their result when
-    -- it's ready
+    -- If someone else is already rendering this, we'll use their result when
+    -- it's ready (so we wait a bit and then retry)
     Just (Left _) -> do
       liftIO (threadDelay 1000)
       cached key gen
-    -- The item isn't in the cache, so we'll take on rendering it
+    -- If the item isn't in the cache, we'll take on rendering it
     Nothing -> do
-      -- If rendering doesn't succeed, we delete the mark so that someone
-      -- else would be able to render it
+      -- On exception (i.e. when we have failed to do the render), we delete
+      -- our mark (but only if it's really our mark) so that someone else
+      -- would be able to try to render it
       bs <- liftIO $ renderBST gen `onException`
                        liftSTM (deleteIfEq key (Left uniq) cache)
-      -- If rendering has succeeded, we write the rendered result
+      -- If rendering has succeeded, we write the rendered result, but only
+      -- if the rendering has been started by us
       liftSTM (replaceIfEq key (Left uniq) (Right bs) cache)
       toHtmlRaw bs
 
--- The *IfEq functions are used for extra safety (we'll never replace a newer
--- render with an older render accidentally)
-
+-- | Delete the value, but only if it's equal to the one we expect.
 deleteIfEq :: Eq v => STMMap.Key k => k -> v -> STMMap.Map k v -> STM ()
 deleteIfEq k v m = STMMap.focus (Focus.updateM upd) k m
   where upd a = return (if a == v then Nothing else Just a)
 
+-- | Replace the value, but only if it's equal to the one we expect.
 replaceIfEq :: Eq v => STMMap.Key k => k -> v -> v -> STMMap.Map k v -> STM ()
 replaceIfEq k v v' m = STMMap.focus (Focus.adjustM upd) k m
   where upd a = return (if a == v then v' else a)
-
-liftSTM :: MonadIO m => STM a -> m a
-liftSTM = liftIO . atomically

src/Guide/Utils.hs

@@ -63,6 +63,9 @@ module Guide.Utils
   MigrateConstructor(..),
   migrateVer,
 
+  -- * STM
+  liftSTM,
+
   -- * Instances
   -- ** 'MonadThrow' for 'HtmlT'
 )
@@ -629,6 +632,13 @@ migrateVer tyName ver constructors = do
 
   lam1E (varP arg) (caseE (varE arg) (map return branches'))
 
+----------------------------------------------------------------------------
+-- STM
+----------------------------------------------------------------------------
+
+liftSTM :: MonadIO m => STM a -> m a
+liftSTM = liftIO . atomically
+
 ----------------------------------------------------------------------------
 -- Orphan instances
 ----------------------------------------------------------------------------

src/Guide/Views.hs

@@ -657,7 +657,8 @@ renderSearch mbSearchQuery =
   mustache "search" $ A.object [
     "query" A..= mbSearchQuery ]
 
--- | Render list of categories on the main page.
+-- | Render list of categories on the main page (the one with category groups
+-- and categories in it).
 --
 -- If the presentation of the category list ever changes (e.g. to include
 -- lists of items in categories, or their counts, or something), you might