Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Offset isn't just for WordPress? #42

Open
wants to merge 11 commits into
base: master
Choose a base branch
from
16 changes: 12 additions & 4 deletions offset.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -21,13 +21,17 @@ library
, Web.Offset.Field
, Web.Offset.Init
, Web.Offset.Splices
, Web.Offset.Queries
, Web.Offset.Splices.Helpers
, Web.Offset.HTTP
, Web.Offset.Cache
, Web.Offset.Cache.Types
, Web.Offset.Cache.Redis
, Web.Offset.Posts
, Web.Offset.Utils
, Web.Offset.WordPress.Field
, Web.Offset.WordPress.Posts
, Web.Offset.WordPress.Queries
, Web.Offset.WordPress.Splices
, Web.Offset.WordPress.Types
-- other-extensions:
build-depends: aeson
, base < 4.9
Expand Down Expand Up @@ -69,11 +73,15 @@ Test-Suite test-offset
, Web.Offset.HTTP
, Web.Offset.Init
, Web.Offset.Internal
, Web.Offset.Posts
, Web.Offset.Queries
, Web.Offset.Splices
, Web.Offset.Splices.Helpers
, Web.Offset.Types
, Web.Offset.Utils
, Web.Offset.WordPress.Field
, Web.Offset.WordPress.Posts
, Web.Offset.WordPress.Queries
, Web.Offset.WordPress.Splices
, Web.Offset.WordPress.Types
build-depends: base
, aeson
, async
Expand Down
105 changes: 53 additions & 52 deletions spec/Common.hs
Original file line number Diff line number Diff line change
Expand Up @@ -7,42 +7,43 @@
module Common where

import Control.Concurrent.MVar
import Control.Lens hiding ((.=))
import Control.Monad (void)
import Control.Monad.State (StateT, evalStateT)
import qualified Control.Monad.State as S
import Control.Monad.Trans (liftIO)
import Data.Aeson hiding (Success)
import Control.Lens hiding ((.=))
import Control.Monad (void)
import Control.Monad.State (StateT, evalStateT)
import qualified Control.Monad.State as S
import Control.Monad.Trans (liftIO)
import Data.Aeson hiding (Success)
import Data.Default
import qualified Data.HashMap.Strict as HM
import qualified Data.Map as M
import qualified Data.HashMap.Strict as HM
import qualified Data.Map as M
import Data.Maybe
import Data.Monoid
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as TL
import qualified Database.Redis as R
import Network.Wai (defaultRequest, rawPathInfo)
import Prelude hiding ((++))
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as TL
import qualified Database.Redis as R
import Network.Wai (defaultRequest, rawPathInfo)
import Prelude hiding ((++))
import Test.Hspec
import Web.Fn
import Web.Larceny

import Web.Offset
import Web.Offset.Cache.Redis
import Web.Offset.Types
import Web.Offset.WordPress.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
Expand Down Expand Up @@ -119,9 +120,9 @@ tplLibrary =
,(["department"], parse "<wpPosts departments=\"sports\"><wpTitle/></wpPosts>")
,(["author-date"], parse "Hello<wp><wpPostByPermalink><wpAuthor><wpName/></wpAuthor><wpDate><wpYear/>/<wpMonth/></wpDate></wpPostByPermalink></wp>")
,(["fields"], parse "<wp><wpPosts limit=1 categories=\"-cat1\"><wpFeaturedImage><wpAttachmentMeta><wpSizes><wpThumbnail><wpUrl/></wpThumbnail></wpSizes></wpAttachmentMeta></wpFeaturedImage></wpPosts></wp>")
,(["custom-endpoint-object"], parse "<wpCustom endpoint=\"wp/v2/taxonomies\"><wpCategory><wpRestBase /></wpCategory></wpCustom>")
,(["custom-endpoint-array"], parse "<wpCustom endpoint=\"wp/v2/posts\"><wpDate /></wpCustom>")
,(["custom-endpoint-enter-the-matrix"], parse "<wpCustom endpoint=\"wp/v2/posts\"><wpCustom endpoint=\"wp/v2/posts/${wpId}\"><wpDate /></wpCustom></wpCustom>")
,(["custom-endpoint-object"], parse "<cmsCustom endpoint=\"wp/v2/taxonomies\"><cmsCategory><cmsRestBase /></cmsCategory></cmsCustom>")
,(["custom-endpoint-array"], parse "<cmsCustom endpoint=\"wp/v2/posts\"><cmsDate /></cmsCustom>")
,(["custom-endpoint-enter-the-matrix"], parse "<cmsCustom endpoint=\"wp/v2/posts\"><cmsCustom endpoint=\"wp/v2/posts/${cmsId}\"><cmsDate /></cmsCustom></cmsCustom>")
]

renderLarceny :: Ctxt ->
Expand All @@ -131,7 +132,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

Expand Down Expand Up @@ -170,17 +171,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 =
Expand Down Expand Up @@ -218,29 +219,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)
Expand All @@ -250,7 +251,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
Expand All @@ -263,10 +264,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
Expand Down
76 changes: 38 additions & 38 deletions spec/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -3,7 +3,7 @@
{-# LANGUAGE RankNTypes #-}

module Main where

import Prelude hiding ((++))

import Control.Concurrent.MVar
Expand Down Expand Up @@ -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"]
Expand All @@ -84,31 +84,31 @@ 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"

describe "<wpCustom>" $
it "should render an HTML comment if JSON field is null" $
"<wpCustom endpoint=\"dev/null\"><wpThisIsNull /></wpCustom>" `shouldRender` "<!-- JSON field found, but value is null. -->"
describe "<wpCustomDate>" $ do
"<cmsCustom endpoint=\"dev/null\"><cmsThisIsNull /></cmsCustom>" `shouldRender` "<!-- JSON field found, but value is null. -->"
describe "<cmsCustomDate>" $ do
it "should parse a date field with the format string it's given" $
"<wpCustomDate date=\"2013-04-26 10:11:52\" wp_format=\"%Y-%m-%d %H:%M:%S\"> \
\ <wpDay />~<wpMonth />~<wpYear /> \
\ </wpCustomDate>" `shouldRender` "26~04~2013"
"<cmsCustomDate date=\"2013-04-26 10:11:52\" format=\"%Y-%m-%d %H:%M:%S\"> \
\ <cmsDay />~<cmsMonth />~<cmsYear /> \
\ </cmsCustomDate>" `shouldRender` "26~04~2013"
it "should format a date field with the format strings it's given" $
"<wpCustomDate date=\"2013-04-26 10:11:52\" wp_format=\"%Y-%m-%d %H:%M:%S\"> \
\ <wpMonth format=\"%B\"/> <wpDay format=\"%-d\"/>, <wpYear /> \
\ </wpCustomDate>" `shouldRender` "April 26, 2013"
"<cmsCustomDate date=\"2013-04-26 10:11:52\" format=\"%Y-%m-%d %H:%M:%S\"> \
\ <cmsMonth format=\"%B\"/> <cmsDay format=\"%-d\"/>, <cmsYear /> \
\ </cmsCustomDate>" `shouldRender` "April 26, 2013"
it "should use default WordPress date format if none specified" $
"<wpCustomDate date=\"2013-04-26 10:11:52\"> \
\ <wpDay />~<wpMonth />~<wpYear /> \
\ </wpCustomDate>" `shouldRender` "26~04~2013"
"<cmsCustomDate date=\"2013-04-26 10:11:52\"> \
\ <cmsDay />~<cmsMonth />~<cmsYear /> \
\ </cmsCustomDate>" `shouldRender` "26~04~2013"
it "should allow formatting the whole date in a single tag" $
"<wpCustomDate date=\"2013-04-26 10:11:52\"> \
\ <wpFullDate /> \
\ </wpCustomDate>" `shouldRender` "04/26/13"
"<cmsCustomDate date=\"2013-04-26 10:11:52\"> \
\ <cmsFullDate /> \
\ </cmsCustomDate>" `shouldRender` "04/26/13"

-- Caching tests

Expand All @@ -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 =
Expand Down
Loading