{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeSynonymInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Heist.Interpreted.Tests ( tests , quickRender ) where ------------------------------------------------------------------------------ import Blaze.ByteString.Builder import Control.Error import Control.Monad.State import Data.Aeson import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy.Char8 as L import qualified Data.HashMap.Strict as Map import Data.Map.Syntax import Data.Maybe import Data.Monoid import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Encoding as T import System.IO.Unsafe import Test.Framework (Test) import Test.Framework.Providers.HUnit import Test.Framework.Providers.QuickCheck2 import qualified Test.HUnit as H import Test.QuickCheck import Test.QuickCheck.Monadic ------------------------------------------------------------------------------ import Heist import Heist.Common import Heist.Interpreted.Internal import Heist.Splices.Apply import Heist.Splices.Ignore import Heist.Splices.Json import Heist.Splices.Markdown import Heist.TestCommon import Heist.Internal.Types import qualified Text.XmlHtml as X import qualified Text.XmlHtml.Cursor as X ------------------------------------------------------------------------------ tests :: [Test] tests = [ testProperty "heist/simpleBind" simpleBindTest , testProperty "heist/simpleApply" simpleApplyTest , testCase "heist/templateAdd" addTest , testCase "heist/hasTemplate" hasTemplateTest , testCase "heist/getDoc" getDocTest , testCase "heist/load" loadTest , testCase "heist/fsLoad" fsLoadTest , testCase "heist/renderNoName" renderNoNameTest , testCase "heist/doctype" doctypeTest , testCase "heist/attributeSubstitution" attrSubstTest , testCase "heist/bindAttribute" bindAttrTest , testCase "heist/markdown" markdownTest , testCase "heist/title_expansion" titleExpansion , testCase "heist/textarea_expansion" textareaExpansion , testCase "heist/div_expansion" divExpansion , testCase "heist/bind_param" bindParam , testCase "heist/markdownText" markdownTextTest , testCase "heist/apply" applyTest , testCase "heist/ignore" ignoreTest , testCase "heist/lookupTemplateContext" lookupTemplateTest , testCase "heist/attrSpliceContext" attrSpliceContext , testCase "heist/json/values" jsonValueTest , testCase "heist/json/object" jsonObjectTest , testCase "heist/renderXML" xmlNotHtmlTest ] ------------------------------------------------------------------------------ simpleBindTest :: Property simpleBindTest = monadicIO $ forAllM arbitrary prop where prop :: Bind -> PropertyM IO () prop bind = do let template = buildBindTemplate bind let result = buildResult bind spliceResult <- run $ do hs <- loadEmpty defaultLoadTimeSplices mempty mempty mempty evalHeistT (runNodeList template) (X.TextNode "") hs assert $ result == spliceResult ------------------------------------------------------------------------------ simpleApplyTest :: Property simpleApplyTest = monadicIO $ forAllM arbitrary prop where prop :: Apply -> PropertyM IO () prop apply = do let correct = calcCorrect apply result <- run $ calcResult apply assert $ correct == result ------------------------------------------------------------------------------ addTest :: IO () addTest = do es <- loadEmpty mempty mempty mempty mempty let hs = addTemplate "aoeu" [] Nothing es H.assertEqual "lookup test" (Just []) $ fmap (X.docContent . dfDoc . fst) $ lookupTemplate "aoeu" hs _templateMap ------------------------------------------------------------------------------ hasTemplateTest :: H.Assertion hasTemplateTest = do ets <- loadIO "templates" mempty mempty mempty mempty let tm = either (error . unlines) _templateMap ets hs <- loadEmpty mempty mempty mempty mempty let hs's = setTemplates tm hs H.assertBool "hasTemplate hs's" (hasTemplate "index" hs's) ------------------------------------------------------------------------------ getDocTest :: H.Assertion getDocTest = do d <- getDoc "bkteoar" H.assertBool "non-existent doc" $ isLeft d f <- getDoc "templates/index.tpl" H.assertBool "index doc" $ not $ isLeft f ------------------------------------------------------------------------------ loadTest :: H.Assertion loadTest = do ets <- loadIO "templates" mempty mempty mempty mempty either (error "Error loading templates") (\ts -> do let tm = _templateMap ts H.assertEqual "loadTest size" 38 $ Map.size tm ) ets ------------------------------------------------------------------------------ fsLoadTest :: H.Assertion fsLoadTest = do ets <- loadIO "templates" mempty mempty mempty mempty let tm = either (error "Error loading templates") _templateMap ets es <- loadEmpty mempty mempty mempty mempty let hs = setTemplates tm es let f = g hs f isNothing "abc/def/xyz" f isJust "a" f isJust "bar/a" f isJust "/bar/a" where g ts p n = H.assertBool ("loading template " ++ n) $ p $ lookupTemplate (B.pack n) ts _templateMap ------------------------------------------------------------------------------ renderNoNameTest :: H.Assertion renderNoNameTest = do ets <- loadT "templates" mempty mempty mempty mempty either (error "Error loading templates") (\ts -> do t <- renderTemplate ts "" H.assertBool "renderNoName" $ isNothing t ) ets ------------------------------------------------------------------------------ doctypeTest :: H.Assertion doctypeTest = do ets <- loadT "templates" mempty mempty mempty mempty let ts = either (error "Error loading templates") id ets Just (indexDoc, _) <- renderTemplate ts "index" H.assertEqual "index doctype test" indexRes $ toByteString $ indexDoc Just (_, _) <- renderTemplate ts "ioc" H.assertEqual "ioc doctype test" indexRes $ toByteString $ indexDoc where indexRes = B.concat [doctype ,"\n \n