{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE NoMonomorphismRestriction #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Text.Templating.Heist.Tests ( tests , quickRender ) where ------------------------------------------------------------------------------ import Blaze.ByteString.Builder import Control.Monad.State import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy.Char8 as L import qualified Data.Map as Map import Data.Maybe import Data.Monoid import qualified Data.Text as T import qualified Data.Text.Encoding as T import Data.Text (Text) 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 Text.Templating.Heist import Text.Templating.Heist.Internal import Text.Templating.Heist.Types import Text.Templating.Heist.Splices.Apply import Text.Templating.Heist.Splices.Ignore import Text.Templating.Heist.Splices.Markdown 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/stateMonoid" monoidTest , 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 ] ------------------------------------------------------------------------------ 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 $ evalTemplateMonad (runNodeList template) (X.TextNode "") emptyTemplateState 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 ------------------------------------------------------------------------------ monoidTest :: IO () monoidTest = do H.assertBool "left monoid identity" $ mempty `mappend` es == es H.assertBool "right monoid identity" $ es `mappend` mempty == es where es = emptyTemplateState :: TemplateState IO ------------------------------------------------------------------------------ addTest :: IO () addTest = do H.assertEqual "lookup test" (Just []) $ fmap (X.docContent . dfDoc . fst) $ lookupTemplate "aoeu" ts H.assertEqual "splice touched" 0 $ Map.size (_spliceMap ts) where ts = addTemplate "aoeu" [] Nothing (mempty::TemplateState IO) ------------------------------------------------------------------------------ hasTemplateTest :: H.Assertion hasTemplateTest = do ets <- loadT "templates" let tm = either (error "Error loading templates") _templateMap ets let ts = setTemplates tm emptyTemplateState :: TemplateState IO H.assertBool "hasTemplate ts" (hasTemplate "index" ts) ------------------------------------------------------------------------------ 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 <- loadT "templates" either (error "Error loading templates") (\ts -> do let tm = _templateMap ts H.assertBool "loadTest size" $ Map.size tm == 23 ) ets ------------------------------------------------------------------------------ fsLoadTest :: H.Assertion fsLoadTest = do ets <- loadT "templates" let tm = either (error "Error loading templates") _templateMap ets let ts = setTemplates tm emptyTemplateState :: TemplateState IO let f = g ts 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 ------------------------------------------------------------------------------ renderNoNameTest :: H.Assertion renderNoNameTest = do ets <- loadT "templates" either (error "Error loading templates") (\ts -> do t <- renderTemplate ts "" H.assertBool "renderNoName" $ isNothing t ) ets ------------------------------------------------------------------------------ doctypeTest :: H.Assertion doctypeTest = do ets <- loadT "templates" let ts = either (error "Error loading templates") id ets Just (indexDoc, indexMIME) <- renderTemplate ts "index" H.assertBool "doctype test index" $ isJust $ X.docType $ fromRight $ (X.parseHTML "index") $ toByteString $ indexDoc Just (iocDoc, iocMIME) <- renderTemplate ts "ioc" H.assertBool "doctype test ioc" $ isJust $ X.docType $ fromRight $ (X.parseHTML "index") $ toByteString $ iocDoc where fromRight (Right x) = x fromRight (Left s) = error s ------------------------------------------------------------------------------ attrSubstTest :: H.Assertion attrSubstTest = do ets <- loadT "templates" let ts = either (error "Error loading templates") id ets check (setTs "meaning_of_everything" ts) "pre_meaning_of_everything_post" check ts "pre__post" where setTs val = bindSplice "foo" (return [X.TextNode val]) check ts str = do Just (resDoc, resMIME) <- renderTemplate ts "attrs" H.assertBool ("attr subst " ++ (show str)) $ not $ B.null $ snd $ B.breakSubstring str $ toByteString $ resDoc H.assertBool ("attr subst foo") $ not $ B.null $ snd $ B.breakSubstring "${foo}" $ toByteString $ resDoc ------------------------------------------------------------------------------ bindAttrTest :: H.Assertion bindAttrTest = do ets <- loadT "templates" let ts = either (error "Error loading templates") id ets check ts "