Offset isn't just for WordPress?

spec/Common.hs

@@ -38,11 +38,11 @@ import           Web.Offset.Types
 -- Section 1: Example application used for testing.     --
 ----------------------------------------------------------
 
-data Ctxt = Ctxt { _req       :: FnRequest
-                 , _redis     :: R.Connection
-                 , _wordpress :: Wordpress Ctxt
-                 , _wpsubs    :: Substitutions Ctxt
-                 , _lib       :: Library Ctxt
+data Ctxt = Ctxt { _req     :: FnRequest
+                 , _redis   :: R.Connection
+                 , _cms     :: CMS Ctxt
+                 , _cmssubs :: Substitutions Ctxt
+                 , _lib     :: Library Ctxt
                  }
 
 makeLenses ''Ctxt
@@ -131,7 +131,7 @@ renderLarceny ctxt name =
   do let tpl = M.lookup [name] tplLibrary
      case tpl of
        Just t -> do
-         rendered <- evalStateT (runTemplate t [name] (ctxt ^. wpsubs) tplLibrary) ctxt
+         rendered <- evalStateT (runTemplate t [name] (ctxt ^. cmssubs) tplLibrary) ctxt
          return $ Just rendered
        _ -> return Nothing
 
@@ -170,17 +170,17 @@ fauxRequester mRecord rqPath rqParams = do
 initializer :: Either UserPassword Requester -> CacheBehavior -> Text -> IO Ctxt
 initializer requester cache endpoint =
   do rconn <- R.connect R.defaultConnectInfo
-     let wpconf = def { wpConfEndpoint = endpoint
-                      , wpConfLogger = Nothing
-                      , wpConfRequester = requester
-                      , wpConfExtraFields = customFields
-                      , wpConfCacheBehavior = cache
+     let wpconf = def { cmsConfEndpoint = endpoint
+                      , cmsConfLogger = Nothing
+                      , cmsConfRequest = requester
+                      , cmsConfExtraFields = customFields
+                      , cmsConfCacheBehavior = cache
                    }
      let getUri :: StateT Ctxt IO Text
          getUri = do ctxt <- S.get
                      return (T.decodeUtf8 . rawPathInfo . fst . getRequest $ ctxt)
-     (wp,wpSubs) <- initWordpress wpconf rconn getUri wordpress
-     return (Ctxt defaultFnRequest rconn wp wpSubs mempty)
+     (cms', cmssubs) <- initCMS wpconf rconn getUri cms
+     return (Ctxt defaultFnRequest rconn cms' cmssubs mempty)
 
 initFauxRequestNoCache :: IO Ctxt
 initFauxRequestNoCache =
@@ -218,29 +218,29 @@ shouldRender :: TemplateText
              -> Expectation
 shouldRender t output = do
   ctxt <- initFauxRequestNoCache
-  let s = _wpsubs ctxt
+  let s = _cmssubs ctxt
   rendered <- evalStateT (runTemplate (toTpl t) [] s mempty) ctxt
   ignoreWhitespace rendered `shouldBe` ignoreWhitespace output
 
 -- Caching helpers
 
-wpCacheGet' :: S.MonadIO m => Wordpress b -> WPKey -> m (Maybe Text)
-wpCacheGet' wordpress' wpKey = do
-  let WordpressInt{..} = cacheInternals wordpress'
-  liftIO $ wpCacheGet wpKey
+cmsCacheGet' :: S.MonadIO m => CMS b -> WPKey -> m (Maybe Text)
+cmsCacheGet' cms' wpKey = do
+  let CMSInt{..} = cacheInternals cms'
+  liftIO $ cmsCacheGet (toCMSKey wpKey)
 
-wpCacheSet' :: S.MonadIO m => Wordpress b -> WPKey -> Text -> m ()
-wpCacheSet' wordpress' wpKey o = do
-  let WordpressInt{..} = cacheInternals wordpress'
-  liftIO $ wpCacheSet wpKey o
+cmsCacheSet' :: S.MonadIO m => CMS b -> WPKey -> Text -> m ()
+cmsCacheSet' cms' wpKey o = do
+  let CMSInt{..} = cacheInternals cms'
+  liftIO $ cmsCacheSet (toCMSKey wpKey) o
 
-wpExpireAggregates' :: S.MonadIO m => Wordpress t -> m Bool
-wpExpireAggregates' Wordpress{..} =
-  liftIO wpExpireAggregates
+cmsExpireAggregates' :: S.MonadIO m => CMS t -> m Bool
+cmsExpireAggregates' CMS{..} =
+  liftIO cmsExpireAggregates
 
-wpExpirePost' :: S.MonadIO m => Wordpress t -> WPKey -> m Bool
-wpExpirePost'  Wordpress{..} k =
-  liftIO $ wpExpirePost k
+cmsExpirePost' :: S.MonadIO m => CMS t -> WPKey -> m Bool
+cmsExpirePost'  CMS{..} wpKey =
+  liftIO $ cmsExpirePost (toCMSKey wpKey)
 
 {-
 shouldRenderAtUrlContaining' :: (TemplateName, Ctxt)
@@ -250,7 +250,7 @@ shouldRenderAtUrlContaining' (template, ctxt) (url, match) = do
     let requestWithUrl = defaultRequest {rawPathInfo = T.encodeUtf8 url }
     let ctxt' = setRequest ctxt
                  $ (\(x,y) -> (requestWithUrl, y)) defaultFnRequest
-    let s = _wpsubs ctxt
+    let s = _cmssubs ctxt
     rendered <- renderLarceny ctxt' template
     print rendered
     let rendered' = fromMaybe "" rendered
@@ -263,10 +263,10 @@ shouldQueryTo hQuery wpQuery =
   it ("should query from " <> T.unpack hQuery) $ do
       record <- liftIO $ newMVar []
       ctxt <- liftIO $ initializer
-                         (Right $ Requester $ fauxRequester (Just record))
-                         NoCache
-                         ""
-      let s = _wpsubs ctxt
+                       (Right $ Requester $ fauxRequester (Just record))
+                       NoCache
+                       ""
+      let s = _cmssubs ctxt
       void $ evalStateT (runTemplate (toTpl hQuery) [] s mempty) ctxt
       x <- liftIO $ tryTakeMVar record
       x `shouldBe` Just wpQuery

spec/Main.hs

@@ -3,7 +3,7 @@
 {-# LANGUAGE RankNTypes        #-}
 
 module Main where
-
+ 
 import           Prelude                 hiding ((++))
 
 import           Control.Concurrent.MVar
@@ -75,7 +75,7 @@ larcenyFillTests = do
                         ""
       let ctxt' = setRequest ctxt
             $ (\(_,y) -> (requestWithUrl, y)) defaultFnRequest
-      let s = _wpsubs ctxt'
+      let s = _cmssubs ctxt'
       let tpl = toTpl "<wp><wpPostByPermalink><wpTitle/></wpPostByPermalink></wp"
       void $ evalStateT (runTemplate tpl [] s mempty) ctxt'
       liftIO (tryTakeMVar record) `shouldReturn` Just ["/wp/v2/posts?slug=the-post"]
@@ -84,7 +84,7 @@ larcenyFillTests = do
       let requestWithUrl = defaultRequest {rawPathInfo = T.encodeUtf8 "/2009/10/the-post/"}
       let ctxt' = setRequest ctxt
                  $ (\(_,y) -> (requestWithUrl, y)) defaultFnRequest
-      let s = view wpsubs ctxt'
+      let s = view cmssubs ctxt'
       let tpl = toTpl "<wp><wpNoPostDuplicates/><wpPostByPermalink><wpTitle/></wpPostByPermalink><wpPosts limit=1><wpTitle/></wpPosts></wp>"
       rendered <- evalStateT (runTemplate tpl [] s mempty) ctxt'
       rendered `shouldBe` "Foo bar"
@@ -118,61 +118,61 @@ cacheTests = do
       it "should render the post even w/o json source" $ do
         let (Object a2) = article2
         ctxt <- liftIO initNoRequestWithCache
-        wpCacheSet' (view wordpress ctxt) (PostByPermalinkKey "2001" "10" "the-post")
+        cmsCacheSet' (view cms ctxt) (PostByPermalinkKey "2001" "10" "the-post")
                                           (enc [a2])
         ("single", ctxt) `shouldRenderAtUrlContaining` ("/2001/10/the-post/", "The post")
 
   describe "caching" $ do
     it "should find nothing for a non-existent post" $ do
       ctxt <- initNoRequestWithCache
-      p <- wpCacheGet' (view wordpress ctxt) (PostByPermalinkKey "2000" "1" "the-article")
+      p <- cmsCacheGet' (view cms ctxt) (PostByPermalinkKey "2000" "1" "the-article")
       p `shouldBe` Nothing
     it "should find something if there is a post in cache" $ do
       ctxt <- initNoRequestWithCache
-      void $ wpCacheSet' (view wordpress ctxt) (PostByPermalinkKey "2000" "1" "the-article")
+      void $ cmsCacheSet' (view cms ctxt) (PostByPermalinkKey "2000" "1" "the-article")
                                           (enc article1)
-      p <- wpCacheGet' (view wordpress ctxt) (PostByPermalinkKey "2000" "1" "the-article")
+      p <- cmsCacheGet' (view cms ctxt) (PostByPermalinkKey "2000" "1" "the-article")
       p `shouldBe` (Just $ enc article1)
     it "should not find single post after expire handler is called" $ do
          ctxt <- initNoRequestWithCache
-         void $ wpCacheSet' (view wordpress ctxt) (PostByPermalinkKey "2000" "1" "the-article")
+         void $ cmsCacheSet' (view cms ctxt) (PostByPermalinkKey "2000" "1" "the-article")
                                                   (enc article1)
-         void $ wpExpirePost' (view wordpress ctxt) (PostByPermalinkKey "2000" "1" "the-article")
-         wpCacheGet' (view wordpress ctxt) (PostByPermalinkKey "2000" "1" "the-article")
+         void $ cmsExpirePost' (view cms ctxt) (PostByPermalinkKey "2000" "1" "the-article")
+         cmsCacheGet' (view cms ctxt) (PostByPermalinkKey "2000" "1" "the-article")
            >>= shouldBe Nothing
     it "should find post aggregates in cache" $
       do ctxt <- initNoRequestWithCache
          let key = PostsKey (Set.fromList [NumFilter 20, OffsetFilter 0])
-         void $ wpCacheSet' (view wordpress ctxt) key ("[" <> enc article1 <> "]")
-         void $ wpCacheGet' (view wordpress ctxt) key
+         void $ cmsCacheSet' (view cms ctxt) key ("[" <> enc article1 <> "]")
+         void $ cmsCacheGet' (view cms ctxt) key
            >>= shouldBe (Just $ "[" <> enc article1 <> "]")
     it "should not find post aggregates after expire handler is called" $
       do ctxt <- initNoRequestWithCache
          let key = PostsKey (Set.fromList [NumFilter 20, OffsetFilter 0])
-         void $ wpCacheSet' (view wordpress ctxt) key ("[" <> enc article1 <> "]")
-         void $ wpExpirePost' (view wordpress ctxt) (PostByPermalinkKey "2000" "1" "the-article")
-         wpCacheGet' (view wordpress ctxt) key
+         void $ cmsCacheSet' (view cms ctxt) key ("[" <> enc article1 <> "]")
+         void $ cmsExpirePost' (view cms ctxt) (PostByPermalinkKey "2000" "1" "the-article")
+         cmsCacheGet' (view cms ctxt) key
            >>= shouldBe Nothing
     it "should find single post after expiring aggregates" $
       do ctxt <- initNoRequestWithCache
-         void $ wpCacheSet' (view wordpress ctxt) (PostByPermalinkKey "2000" "1" "the-article")
+         void $ cmsCacheSet' (view cms ctxt) (PostByPermalinkKey "2000" "1" "the-article")
                           (enc article1)
-         void $ wpExpireAggregates' (view wordpress ctxt)
-         wpCacheGet' (view wordpress ctxt) (PostByPermalinkKey "2000" "1" "the-article")
+         void $ cmsExpireAggregates' (view cms ctxt)
+         cmsCacheGet' (view cms ctxt) (PostByPermalinkKey "2000" "1" "the-article")
            >>= shouldNotBe Nothing
     it "should find a different single post after expiring another" $
       do ctxt <- initNoRequestWithCache
          let key1 = PostByPermalinkKey "2000" "1" "the-article"
              key2 = PostByPermalinkKey "2001" "2" "another-article"
-         void $ wpCacheSet' (view wordpress ctxt) key1 (enc article1)
-         void $ wpCacheSet' (view wordpress ctxt) key2 (enc article2)
-         void $ wpExpirePost' (view wordpress ctxt) (PostByPermalinkKey "2000" "1" "the-article")
-         wpCacheGet' (view wordpress ctxt) key2 >>= shouldBe (Just (enc article2))
+         void $ cmsCacheSet' (view cms ctxt) key1 (enc article1)
+         void $ cmsCacheSet' (view cms ctxt) key2 (enc article2)
+         void $ cmsExpirePost' (view cms ctxt) (PostByPermalinkKey "2000" "1" "the-article")
+         cmsCacheGet' (view cms ctxt) key2 >>= shouldBe (Just (enc article2))
     it "should be able to cache and retrieve post" $
       do ctxt <- initNoRequestWithCache
          let key = PostKey 200
-         wpCacheSet' (view wordpress ctxt) key (enc article1)
-         wpCacheGet' (view wordpress ctxt) key >>= shouldBe (Just (enc article1))
+         cmsCacheSet' (view cms ctxt) key (enc article1)
+         cmsCacheGet' (view cms ctxt) key >>= shouldBe (Just (enc article1))
 
 queryTests :: Spec
 queryTests =

src/Web/Offset.hs

@@ -4,18 +4,18 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings     #-}
 {-# LANGUAGE RankNTypes            #-}
-{-# LANGUAGE RecordWildCards       #-}
 {-# LANGUAGE ScopedTypeVariables   #-}
 {-# LANGUAGE TypeSynonymInstances  #-}
 
 module Web.Offset (
-   Wordpress(..)
- , WordpressConfig(..)
+   CMS(..)
+ , CMSConfig(..)
  , Requester(..)
  , CacheBehavior(..)
- , initWordpress
+ , initCMS
  , wpGetPost
  , getPost
+ , CMSKey(..)
  , WPKey(..)
  , Filter(..)
  , transformName

src/Web/Offset/Cache.hs

@@ -20,7 +20,7 @@ import           Web.Offset.Cache.Types
 import           Web.Offset.Types
 import           Web.Offset.Utils
 
-startReqMutexInt :: MVar (Map WPKey UTCTime) -> WPKey -> IO Bool
+startReqMutexInt :: MVar (Map CMSKey UTCTime) -> CMSKey -> IO Bool
 startReqMutexInt activeMV wpKey =
   do now <- getCurrentTime
      modifyMVar activeMV $ \a ->
@@ -30,16 +30,16 @@ startReqMutexInt activeMV wpKey =
           else return (Map.insert wpKey now active, False)
   where filterCurrent now = Map.filter (\v -> diffUTCTime now v < 1)
 
-stopReqMutexInt :: MVar (Map WPKey UTCTime) -> WPKey -> IO ()
+stopReqMutexInt :: MVar (Map CMSKey UTCTime) -> CMSKey -> IO ()
 stopReqMutexInt activeMV wpKey =
   modifyMVar_ activeMV $ return . Map.delete wpKey
 
-cachingGetRetryInt :: WordpressInt b -> WPKey -> IO (Either StatusCode Text)
+cachingGetRetryInt :: CMSInt b -> CMSKey -> IO (Either StatusCode Text)
 cachingGetRetryInt wp = retryUnless . cachingGetInt wp
 
-cachingGetErrorInt :: WordpressInt b -> WPKey -> IO (Either StatusCode Text)
+cachingGetErrorInt :: CMSInt b -> CMSKey -> IO (Either StatusCode Text)
 cachingGetErrorInt wp wpKey = errorUnless msg (cachingGetInt wp wpKey)
-  where msg = "Could not retrieve " <> tshow wpKey
+  where msg = "Could not retrieve " <> cShow wpKey
 
 retryUnless :: IO (CacheResult a) -> IO (Either StatusCode a)
 retryUnless action =
@@ -58,36 +58,36 @@ errorUnless _ action =
       Abort code -> return $ Left code
       Retry -> return $ Left 500
 
-cachingGetInt :: WordpressInt b
-           -> WPKey
+cachingGetInt :: CMSInt b
+           -> CMSKey
            -> IO (CacheResult Text)
-cachingGetInt WordpressInt{..} wpKey =
-  do mCached <- wpCacheGet wpKey
+cachingGetInt CMSInt{..} wpKey =
+  do mCached <- cmsCacheGet wpKey
      case mCached of
        Just cached -> return $ Successful cached
        Nothing ->
          do running <- startReqMutex wpKey
             if running
                then return Retry
                else
-                 do o <- wpRequest wpKey
+                 do o <- cmsRequest wpKey
                     case o of
                       Left errorCode ->
                         return $ Abort errorCode
                       Right jsonBlob -> do
-                        wpCacheSet wpKey jsonBlob
+                        cmsCacheSet wpKey jsonBlob
                         stopReqMutex wpKey
                         return $ Successful jsonBlob
 
-wpCacheGetInt :: RunRedis -> CacheBehavior -> WPKey -> IO (Maybe Text)
-wpCacheGetInt runRedis b = runRedis . cacheGet b . formatKey
+cmsCacheGetInt :: RunRedis -> CacheBehavior -> CMSKey -> IO (Maybe Text)
+cmsCacheGetInt runRedis b = runRedis . cacheGet b . cFormatKey
 
 cacheGet :: CacheBehavior -> Text -> Redis (Maybe Text)
 cacheGet NoCache _ = return Nothing
 cacheGet _ key = rget key
 
-wpCacheSetInt :: RunRedis -> CacheBehavior -> WPKey -> Text -> IO ()
-wpCacheSetInt runRedis b key = void . runRedis . cacheSet b (formatKey key)
+cmsCacheSetInt :: RunRedis -> CacheBehavior -> CMSKey -> Text -> IO ()
+cmsCacheSetInt runRedis b key = void . runRedis . cacheSet b (cFormatKey key)
 
 cacheSet :: CacheBehavior -> Text -> Text -> Redis Bool
 cacheSet b k v =
@@ -102,21 +102,8 @@ wpExpireAggregatesInt runRedis = runRedis expireAggregates
 expireAggregates :: Redis Bool
 expireAggregates = rdelstar "wordpress:posts:*"
 
-wpExpirePostInt :: RunRedis -> WPKey -> IO Bool
+wpExpirePostInt :: RunRedis -> CMSKey -> IO Bool
 wpExpirePostInt runRedis = runRedis . expire
 
-expire :: WPKey -> Redis Bool
-expire key = rdel [formatKey key] >> expireAggregates
-
-formatKey :: WPKey -> Text
-formatKey = format
-  where format (PostByPermalinkKey y m s) = ns "post_perma:" <> y <> "_" <> m <> "_" <> s
-        format (PostsKey filters) =
-          ns "posts:" <> T.intercalate "_" (map tshow $ Set.toAscList filters)
-        format (PostKey n) = ns "post:" <> tshow n
-        format (PageKey s) = ns "page:" <> s
-        format (AuthorKey n) = ns "author:" <> tshow n
-        format (TaxDictKey t) = ns "tax_dict:" <> t
-        format (TaxSlugKey tn ts) = ns "tax_slug:" <> tn <> ":" <> ts
-        format (EndpointKey e) = ns "endpoint:" <> e
-        ns k = "wordpress:" <> k
+expire :: CMSKey -> Redis Bool
+expire key = rdel [cFormatKey key] >> expireAggregates