Skip to content

Stack test pedantic #39

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.

Sign up for GitHub

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

Merged
emhoracek merged 4 commits into from
Mar 1, 2017
Merged

Stack test pedantic #39

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
b1d91a3
Fix compiler warnings
emhoracek Feb 9, 2017
5aa9464
Reduce duplication of wpDate code
emhoracek Mar 1, 2017
a0502e5
Fix merge conflict, remove unnecessary imports
emhoracek Mar 1, 2017
54fc174
Merge branch 'master' into stack-test-pedantic
emhoracek Mar 1, 2017
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
14 changes: 14 additions & 0 deletions offset.cabal
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -60,6 +60,20 @@ Test-Suite test-offset
hs-source-dirs: spec, src
main-is: Main.hs
other-modules: Misc
, Common
, Web.Offset
, Web.Offset.Cache
, Web.Offset.Cache.Redis
, Web.Offset.Cache.Types
, Web.Offset.Field
, Web.Offset.HTTP
, Web.Offset.Init
, Web.Offset.Internal
, Web.Offset.Posts
, Web.Offset.Queries
, Web.Offset.Splices
, Web.Offset.Types
, Web.Offset.Utils
build-depends: base
, aeson
, async
Expand Down
80 changes: 38 additions & 42 deletions spec/Common.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -6,46 +6,32 @@

module Common where

import Prelude hiding ((++))

import Blaze.ByteString.Builder
import Configuration.Dotenv (loadFile)
import Control.Concurrent (forkIO)
import Control.Concurrent.MVar
import Control.Exception (throw)
import Control.Lens hiding ((.=))
import Control.Monad (mplus, void, when)
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 qualified Data.Set as Set
import Data.Text (Text, pack, unpack)
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 qualified Misc
import Network.Wai (Application, Response,
defaultRequest, pathInfo,
rawPathInfo)
import System.Directory (doesFileExist)
import System.Environment (lookupEnv)
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 Test.Hspec.Core.Spec (Result (..))
import qualified Text.XmlHtml as X
import Web.Fn
import Web.Larceny

import Web.Offset
import Web.Offset.Cache.Redis
import Web.Offset.Splices (wpPostsHelper)
import Web.Offset.Types

----------------------------------------------------------
Expand All @@ -64,7 +50,8 @@ makeLenses ''Ctxt
instance RequestContext Ctxt where
requestLens = req

enc a = TL.toStrict . TL.decodeUtf8 . encode $ a
enc :: ToJSON r => r -> Text
enc val = TL.toStrict . TL.decodeUtf8 . encode $ val

article1 :: Value
article1 = object [ "id" .= (1 :: Int)
Expand All @@ -74,18 +61,21 @@ article1 = object [ "id" .= (1 :: Int)
, "departments" .= [ object [ "name" .= ("some department" :: Text)]]
]

article2 :: Value
article2 = object [ "id" .= (2 :: Int)
, "date" .= ("2014-10-20T07:00:00" :: Text)
, "title" .= object ["rendered" .= ("The post" :: Text)]
, "excerpt" .= object ["rendered" .= ("summary" :: Text)]
]

page1 :: Value
page1 = object [ "id" .= (3 :: Int)
, "date" .= ("2014-10-20T07:00:00" :: Text)
, "title" .= object ["rendered" .= ("Page foo" :: Text)]
, "content" .= object ["rendered" .= ("<b>rendered</b> page content" :: Text)]
]

customFields :: [Field s]
customFields = [N "featured_image" [N "attachment_meta" [N "sizes" [N "mag-featured" [F "width"
,F "height"
,F "url"]
Expand Down Expand Up @@ -177,6 +167,7 @@ fauxRequester mRecord rqPath rqParams = do
url <> "?"
<> T.intercalate "&" (map (\(k, v) -> k <> "=" <> v) params)

initializer :: Either UserPassword Requester -> CacheBehavior -> Text -> IO Ctxt
initializer requester cache endpoint =
do rconn <- R.connect R.defaultConnectInfo
let wpconf = def { wpConfEndpoint = endpoint
Expand All @@ -191,9 +182,11 @@ initializer requester cache endpoint =
(wp,wpSubs) <- initWordpress wpconf rconn getUri wordpress
return (Ctxt defaultFnRequest rconn wp wpSubs mempty)

initFauxRequestNoCache :: IO Ctxt
initFauxRequestNoCache =
initializer (Right $ Requester (fauxRequester Nothing)) NoCache ""

initNoRequestWithCache :: IO Ctxt
initNoRequestWithCache =
initializer (Right $ Requester (\_ _ -> return (Right "") )) (CacheSeconds 600) ""

Expand All @@ -214,8 +207,10 @@ unobj :: Value -> Object
unobj (Object x) = x
unobj _ = error "Not an object"

toTpl :: Text -> Template s
toTpl tpl = parse (TL.fromStrict tpl)

ignoreWhitespace :: Text -> Text
ignoreWhitespace = T.replace " " ""

shouldRender :: TemplateText
Expand All @@ -229,20 +224,22 @@ shouldRender t output = do

-- Caching helpers

wpCacheGet' wordpress wpKey = do
let WordpressInt{..} = cacheInternals wordpress
wpCacheGet' :: S.MonadIO m => Wordpress b -> WPKey -> m (Maybe Text)
wpCacheGet' wordpress' wpKey = do
let WordpressInt{..} = cacheInternals wordpress'
liftIO $ wpCacheGet wpKey

wpCacheSet' wordpress wpKey o = do
let WordpressInt{..} = cacheInternals wordpress
wpCacheSet' :: S.MonadIO m => Wordpress b -> WPKey -> Text -> m ()
wpCacheSet' wordpress' wpKey o = do
let WordpressInt{..} = cacheInternals wordpress'
liftIO $ wpCacheSet wpKey o

wpExpireAggregates' wordpress = do
let Wordpress{..} = wordpress
wpExpireAggregates' :: S.MonadIO m => Wordpress t -> m Bool
wpExpireAggregates' Wordpress{..} =
liftIO wpExpireAggregates

wpExpirePost' wordpress k = do
let Wordpress{..} = wordpress
wpExpirePost' :: S.MonadIO m => Wordpress t -> WPKey -> m Bool
wpExpirePost' Wordpress{..} k =
liftIO $ wpExpirePost k

{-
Expand Down Expand Up @@ -270,7 +267,7 @@ shouldQueryTo hQuery wpQuery =
NoCache
""
let s = _wpsubs ctxt
evalStateT (runTemplate (toTpl hQuery) [] s mempty) ctxt
void $ evalStateT (runTemplate (toTpl hQuery) [] s mempty) ctxt
x <- liftIO $ tryTakeMVar record
x `shouldBe` Just wpQuery

Expand Down Expand Up @@ -312,8 +309,7 @@ shouldRenderAtUrlContaining :: (TemplateName, Ctxt)
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
$ (\(_,x) -> (requestWithUrl, x)) defaultFnRequest
rendered <- renderLarceny ctxt' template
let rendered' = fromMaybe "" rendered
(match `T.isInfixOf` rendered') `shouldBe` True
79 changes: 31 additions & 48 deletions spec/Main.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -4,45 +4,24 @@

module Main where

import Prelude hiding ((++))
import Prelude hiding ((++))

import Blaze.ByteString.Builder
import Configuration.Dotenv (loadFile)
import Control.Concurrent.MVar
import Control.Lens hiding ((.=))
import Control.Monad (mplus, void, when)
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 Data.Maybe
import Control.Lens hiding ((.=))
import Control.Monad (void)
import Control.Monad.State (evalStateT)
import Control.Monad.Trans (liftIO)
import Data.Aeson hiding (Success)
import Data.Monoid
import qualified Data.Set as Set
import Data.Text (Text, pack, unpack)
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 qualified Data.Set as Set
import qualified Data.Text.Encoding as T
import qualified Misc
import Network.Wai (Application, Response,
defaultRequest, pathInfo,
rawPathInfo)
import System.Directory (doesFileExist)
import System.Environment (lookupEnv)
import Network.Wai (defaultRequest, rawPathInfo)
import Test.Hspec
import Test.Hspec.Core.Spec (Result (..))
import qualified Text.XmlHtml as X
import Web.Fn
import Web.Larceny

import Web.Offset
import Web.Offset.Cache.Redis
import Web.Offset.Splices (wpPostsHelper)
import Web.Offset.Types

import Common

Expand All @@ -57,6 +36,8 @@ runTests = hspec $ do
main :: IO ()
main = runTests

--larcenyFillTests :: SpecM () ()
larcenyFillTests :: Spec
larcenyFillTests = do
describe "<wpPosts>" $ do
it "should show the title, id, and excerpt" $ do
Expand Down Expand Up @@ -93,16 +74,16 @@ larcenyFillTests = do
(CacheSeconds 10)
""
let ctxt' = setRequest ctxt
$ (\(x,y) -> (requestWithUrl, y)) defaultFnRequest
$ (\(_,y) -> (requestWithUrl, y)) defaultFnRequest
let s = _wpsubs ctxt'
let tpl = toTpl "<wp><wpPostByPermalink><wpTitle/></wpPostByPermalink></wp"
evalStateT (runTemplate tpl [] s mempty) ctxt'
void $ evalStateT (runTemplate tpl [] s mempty) ctxt'
liftIO (tryTakeMVar record) `shouldReturn` Just ["/wp/v2/posts?slug=the-post"]
it "should render stuff" $ do
ctxt <- initFauxRequestNoCache
let requestWithUrl = defaultRequest {rawPathInfo = T.encodeUtf8 "/2009/10/the-post/"}
let ctxt' = setRequest ctxt
$ (\(x,y) -> (requestWithUrl, y)) defaultFnRequest
$ (\(_,y) -> (requestWithUrl, y)) defaultFnRequest
let s = view wpsubs ctxt'
let tpl = toTpl "<wp><wpNoPostDuplicates/><wpPostByPermalink><wpTitle/></wpPostByPermalink><wpPosts limit=1><wpTitle/></wpPosts></wp>"
rendered <- evalStateT (runTemplate tpl [] s mempty) ctxt'
Expand Down Expand Up @@ -131,6 +112,7 @@ larcenyFillTests = do

-- Caching tests

cacheTests :: Spec
cacheTests = do
describe "should grab post from cache if it's there" $
it "should render the post even w/o json source" $ do
Expand All @@ -147,51 +129,52 @@ cacheTests = do
p `shouldBe` Nothing
it "should find something if there is a post in cache" $ do
ctxt <- initNoRequestWithCache
wpCacheSet' (view wordpress ctxt) (PostByPermalinkKey "2000" "1" "the-article")
(enc article1)
void $ wpCacheSet' (view wordpress ctxt) (PostByPermalinkKey "2000" "1" "the-article")
(enc article1)
p <- wpCacheGet' (view wordpress 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
wpCacheSet' (view wordpress ctxt) (PostByPermalinkKey "2000" "1" "the-article")
(enc article1)
wpExpirePost' (view wordpress ctxt) (PostByPermalinkKey "2000" "1" "the-article")
void $ wpCacheSet' (view wordpress 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")
>>= shouldBe Nothing
it "should find post aggregates in cache" $
do ctxt <- initNoRequestWithCache
let key = PostsKey (Set.fromList [NumFilter 20, OffsetFilter 0])
wpCacheSet' (view wordpress ctxt) key ("[" <> enc article1 <> "]")
wpCacheGet' (view wordpress ctxt) key
void $ wpCacheSet' (view wordpress ctxt) key ("[" <> enc article1 <> "]")
void $ wpCacheGet' (view wordpress 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])
wpCacheSet' (view wordpress ctxt) key ("[" <> enc article1 <> "]")
wpExpirePost' (view wordpress ctxt) (PostByPermalinkKey "2000" "1" "the-article")
void $ wpCacheSet' (view wordpress ctxt) key ("[" <> enc article1 <> "]")
void $ wpExpirePost' (view wordpress ctxt) (PostByPermalinkKey "2000" "1" "the-article")
wpCacheGet' (view wordpress ctxt) key
>>= shouldBe Nothing
it "should find single post after expiring aggregates" $
do ctxt <- initNoRequestWithCache
wpCacheSet' (view wordpress ctxt) (PostByPermalinkKey "2000" "1" "the-article")
void $ wpCacheSet' (view wordpress ctxt) (PostByPermalinkKey "2000" "1" "the-article")
(enc article1)
wpExpireAggregates' (view wordpress ctxt)
void $ wpExpireAggregates' (view wordpress ctxt)
wpCacheGet' (view wordpress 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"
wpCacheSet' (view wordpress ctxt) key1 (enc article1)
wpCacheSet' (view wordpress ctxt) key2 (enc article2)
wpExpirePost' (view wordpress ctxt) (PostByPermalinkKey "2000" "1" "the-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))
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))

queryTests :: Spec
queryTests =
describe "generate queries from <wpPosts>" $ do
"<wpPosts></wpPosts>" `shouldQueryTo`
Expand Down Expand Up @@ -233,7 +216,7 @@ liveTests :: Spec
liveTests =
describe "live tests (which require running wordpress server)" $ do
ctxt <- runIO $ initializer (Left ("offset", "111")) NoCache "http://localhost:5555/wp-json"
runIO $ clearRedisCache ctxt
void $ runIO $ clearRedisCache ctxt
do it "should have title on page" $
("single", ctxt)
`shouldRenderAtUrlContaining` ("/2014/10/a-first-post", "A first post")
Expand Down
10 changes: 1 addition & 9 deletions spec/Misc.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,5 +1,4 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}

module Misc where

Expand All @@ -14,14 +13,7 @@ shouldTransformTo :: Text -> Text -> Spec
shouldTransformTo from to =
it (T.unpack ("should convert " <> from <> " to " <> to)) $ transformName from `shouldBe` to

-- NOTE(dbp 2014-11-07): We define equality that is 'good enough' for testing.
-- In truth, our definition is wrong because of the functions inside of 'P' variants.
instance Eq (Field s) where
F t1 == F t2 = t1 == t2
P t1 _ == P t2 _ = t1 == t2
N t1 n1 == N t2 n2 = t1 == t2 && n1 == n2
M t1 m1 == M t2 m2 = t1 == t2 && m1 == m2

tests :: Spec
tests = do
describe "mergeFields" $ do
it "should be able to right-bias merge two Field trees" $
Expand Down
Loading