{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeSynonymInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Text.Templating.Heist.Tests ( tests , quickRender ) where ------------------------------------------------------------------------------ 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 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 Text.XML.Expat.Cursor import Text.XML.Expat.Format import qualified Text.XML.Expat.Tree 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/markdownText" markdownTextTest , testCase "heist/apply" applyTest , testCase "heist/ignore" ignoreTest ] ------------------------------------------------------------------------------ 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.Text "") 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 (_itNodes . fst) $ lookupTemplate "aoeu" ts H.assertEqual "splice touched" 0 $ Map.size (_spliceMap ts) where ts = addTemplate "aoeu" [] (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 == 17 ) 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" $ t == Nothing ) ets ------------------------------------------------------------------------------ doctypeTest :: H.Assertion doctypeTest = do ets <- loadT "templates" let ts = either (error "Error loading templates") id ets index <- renderTemplate ts "index" H.assertBool "doctype test index" $ hasDoctype $ fromJust index ioc <- renderTemplate ts "ioc" H.assertBool "doctype test ioc" $ hasDoctype $ fromJust ioc ------------------------------------------------------------------------------ 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.Text val]) check ts str = do res <- renderTemplate ts "attrs" H.assertBool ("attr subst " ++ (show str)) $ not $ B.null $ snd $ B.breakSubstring str $ fromJust res H.assertBool ("attr subst foo") $ not $ B.null $ snd $ B.breakSubstring "$(foo)" $ fromJust res ------------------------------------------------------------------------------ bindAttrTest :: H.Assertion bindAttrTest = do ets <- loadT "templates" let ts = either (error "Error loading templates") id ets check ts "
This is a test.