This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "heist".
The branch, master has been updated
via 8727251b626f0c331511e15331a8ac2ffeadf173 (commit)
via 0eb4619cf1810388ae6ec49d7b3e6a61cbf4fb40 (commit)
via 6281b10e3ea22aca06535a6419dd88fc07d193dd (commit)
via 87da7dc6816aa83b4e4066a13019ce67a0326c72 (commit)
from c6123314cc4f46644fa0a95a8a5a71119bd10c70 (commit)
Summary of changes:
test/suite/Text/Templating/Heist/Tests.hs | 353 ++++++++++++++++-------------
test/templates/markdown.tpl | 1 +
test/templates/test.md | 1 +
3 files changed, 202 insertions(+), 153 deletions(-)
create mode 100644 test/templates/markdown.tpl
create mode 100644 test/templates/test.md
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 8727251b626f0c331511e15331a8ac2ffeadf173
Author: Gregory Collins <[email protected]>
Date: Fri Oct 22 11:23:20 2010 +0200
Strip newlines out before testing equality in markdown test
diff --git a/test/suite/Text/Templating/Heist/Tests.hs
b/test/suite/Text/Templating/Heist/Tests.hs
index cbcb159..50fa340 100644
--- a/test/suite/Text/Templating/Heist/Tests.hs
+++ b/test/suite/Text/Templating/Heist/Tests.hs
@@ -162,10 +162,13 @@ markdownTest :: H.Assertion
markdownTest = do
ets <- loadT "templates"
let ts = either (error "Error loading templates") id ets
- check ts "\n<div class=\"markdown\">\n<p>This <em>is</em> a
test.</p>\n</div>\n\n"
+
+ check ts "<div class=\"markdown\"><p>This <em>is</em> a test.</p></div>"
+
where
check ts str = do
- result <- renderTemplate ts "markdown"
+ result <- liftM (fmap $ B.filter (/= '\n')) $
+ renderTemplate ts "markdown"
H.assertEqual ("Should match " ++ (show str)) str (fromJust result)
commit 0eb4619cf1810388ae6ec49d7b3e6a61cbf4fb40
Author: stwill <[email protected]>
Date: Thu Oct 21 15:36:37 2010 -0400
added test files
diff --git a/test/templates/markdown.tpl b/test/templates/markdown.tpl
new file mode 100644
index 0000000..9c14b66
--- /dev/null
+++ b/test/templates/markdown.tpl
@@ -0,0 +1 @@
+<markdown file="test.md"/>
diff --git a/test/templates/test.md b/test/templates/test.md
new file mode 100644
index 0000000..c40fab0
--- /dev/null
+++ b/test/templates/test.md
@@ -0,0 +1 @@
+This *is* a test.
commit 6281b10e3ea22aca06535a6419dd88fc07d193dd
Author: stwill <[email protected]>
Date: Thu Oct 21 15:35:34 2010 -0400
added a simple pandoc markdown test
diff --git a/test/suite/Text/Templating/Heist/Tests.hs
b/test/suite/Text/Templating/Heist/Tests.hs
index 8ec4070..cbcb159 100644
--- a/test/suite/Text/Templating/Heist/Tests.hs
+++ b/test/suite/Text/Templating/Heist/Tests.hs
@@ -44,6 +44,7 @@ tests = [ testProperty "simpleBindTest" $ monadicIO $ forAllM
arbitrary prop_sim
, testCase "doctypeTest" doctypeTest
, testCase "attributeSubstitutionTest" attrSubstTest
, testCase "bindAttributeTest" bindAttrTest
+ , testCase "markdownTest" markdownTest
, testCase "applyTest" applyTest
]
@@ -92,7 +93,7 @@ loadTest = do
ets <- loadT "templates"
either (error "Error loading templates")
(\ts -> do let tm = _templateMap ts
- H.assertBool "loadTest size" $ Map.size tm == 16
+ H.assertBool "loadTest size" $ Map.size tm == 17
) ets
@@ -156,6 +157,17 @@ bindAttrTest = do
H.assertBool ("attr subst bar") $
B.null $ snd $ B.breakSubstring "$(bar)" $ fromJust res
+
+markdownTest :: H.Assertion
+markdownTest = do
+ ets <- loadT "templates"
+ let ts = either (error "Error loading templates") id ets
+ check ts "\n<div class=\"markdown\">\n<p>This <em>is</em> a
test.</p>\n</div>\n\n"
+ where
+ check ts str = do
+ result <- renderTemplate ts "markdown"
+ H.assertEqual ("Should match " ++ (show str)) str (fromJust result)
+
applyTest :: H.Assertion
applyTest = do
commit 87da7dc6816aa83b4e4066a13019ce67a0326c72
Author: stwill <[email protected]>
Date: Thu Oct 21 14:44:10 2010 -0400
Test.hs: quick clean-up to code style guide
diff --git a/test/suite/Text/Templating/Heist/Tests.hs
b/test/suite/Text/Templating/Heist/Tests.hs
index 21f1599..8ec4070 100644
--- a/test/suite/Text/Templating/Heist/Tests.hs
+++ b/test/suite/Text/Templating/Heist/Tests.hs
@@ -31,6 +31,7 @@ import Text.XML.Expat.Cursor
import Text.XML.Expat.Format
import qualified Text.XML.Expat.Tree as X
+
tests :: [Test]
tests = [ testProperty "simpleBindTest" $ monadicIO $ forAllM arbitrary
prop_simpleBindTest
, testProperty "simpleApplyTest" $ monadicIO $ forAllM arbitrary
prop_simpleApplyTest
@@ -41,71 +42,80 @@ tests = [ testProperty "simpleBindTest" $ monadicIO $
forAllM arbitrary prop_sim
, testCase "fsLoadTest" fsLoadTest
, testCase "renderNoNameTest" renderNoNameTest
, testCase "doctypeTest" doctypeTest
- , testCase "attributeSubstitution" attrSubstTest
- , testCase "bindAttribute" bindAttrTest
+ , testCase "attributeSubstitutionTest" attrSubstTest
+ , testCase "bindAttributeTest" bindAttrTest
, testCase "applyTest" applyTest
]
-applyTest :: H.Assertion
-applyTest = do
- let es = emptyTemplateState :: TemplateState IO
- res <- evalTemplateMonad applyImpl
- (X.Element "apply" [("template", "nonexistant")] []) es
- H.assertEqual "apply nothing" res []
-
+
+prop_simpleBindTest :: Bind -> PropertyM IO ()
+prop_simpleBindTest bind = do
+ let template = buildBindTemplate bind
+ result = buildResult bind
+ spliceResult <- run $ evalTemplateMonad (runNodeList template)
+ (X.Text "")
+ emptyTemplateState
+ assert $ result == spliceResult
+
+
+prop_simpleApplyTest :: Apply -> PropertyM IO ()
+prop_simpleApplyTest 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
+ 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.assertBool "lookup test" $ Just [] == (fmap (_itNodes . fst) $
lookupTemplate "aoeu" ts)
- H.assertBool "splice touched" $ Map.size (_spliceMap ts) == 0
+ H.assertBool "lookup test" $ Just [] == (fmap (_itNodes . fst) $
lookupTemplate "aoeu" ts)
+ H.assertBool "splice touched" $ Map.size (_spliceMap ts) == 0
where ts = addTemplate "aoeu" [] (mempty::TemplateState IO)
-isLeft :: Either a b -> Bool
-isLeft (Left _) = True
-isLeft (Right _) = False
+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
-loadT :: String -> IO (Either String (TemplateState IO))
-loadT s = loadTemplates s emptyTemplateState
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 == 16
- ) ets
-
-renderNoNameTest :: H.Assertion
-renderNoNameTest = do
- ets <- loadT "templates"
- either (error "Error loading templates")
- (\ts -> do t <- renderTemplate ts ""
- H.assertBool "renderNoName" $ t == Nothing
- ) ets
+ ets <- loadT "templates"
+ either (error "Error loading templates")
+ (\ts -> do let tm = _templateMap ts
+ H.assertBool "loadTest size" $ Map.size tm == 16
+ ) ets
-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
fsLoadTest :: H.Assertion
fsLoadTest = do
- ets <- loadT "templates"
- let tm = either (error "Error loading templates") _templateMap ets
- let ts = setTemplates tm emptyTemplateState :: TemplateState IO
- f p n = H.assertBool ("loading template "++n) $ p $ lookupTemplate
(B.pack n) ts
- f isNothing "abc/def/xyz"
- f isJust "a"
- f isJust "bar/a"
- f isJust "/bar/a"
+ ets <- loadT "templates"
+ let tm = either (error "Error loading templates") _templateMap ets
+ let ts = setTemplates tm emptyTemplateState :: TemplateState IO
+ f p n = H.assertBool ("loading template " ++ n) $ p $ lookupTemplate
(B.pack n) ts
+ f isNothing "abc/def/xyz"
+ f isJust "a"
+ f isJust "bar/a"
+ f isJust "/bar/a"
+
+
+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
@@ -116,6 +126,7 @@ doctypeTest = do
ioc <- renderTemplate ts "ioc"
H.assertBool "doctype test ioc" $ hasDoctype $ fromJust ioc
+
attrSubstTest :: H.Assertion
attrSubstTest = do
ets <- loadT "templates"
@@ -126,7 +137,7 @@ attrSubstTest = do
setTs val = bindSplice "foo" (return [X.Text val])
check ts str = do
res <- renderTemplate ts "attrs"
- H.assertBool ("attr subst "++(show str)) $
+ 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
@@ -146,6 +157,14 @@ bindAttrTest = do
B.null $ snd $ B.breakSubstring "$(bar)" $ fromJust res
+applyTest :: H.Assertion
+applyTest = do
+ let es = emptyTemplateState :: TemplateState IO
+ res <- evalTemplateMonad applyImpl
+ (X.Element "apply" [("template", "nonexistant")] []) es
+ H.assertEqual "apply nothing" res []
+
+
-- dotdotTest :: H.Assertion
-- dotdotTest = do
-- ets <- loadT "templates"
@@ -153,68 +172,65 @@ bindAttrTest = do
-- let ts = setTemplates tm emptyTemplateState :: TemplateState IO
-- f p n = H.assertBool ("loading template "++n) $ p $ lookupTemplate
(B.pack n) ts
+
+{-
+-- Utility functions
+-}
+isLeft :: Either a b -> Bool
+isLeft (Left _) = True
+isLeft (Right _) = False
+
+
+loadT :: String -> IO (Either String (TemplateState IO))
+loadT s = loadTemplates s emptyTemplateState
+
+
+loadTS :: FilePath -> IO (TemplateState IO)
+loadTS baseDir = do
+ etm <- loadTemplates baseDir emptyTemplateState
+ return $ either error id etm
+
+
identStartChar :: [Char]
identStartChar = ['a'..'z']
-identChar :: [Char]
-identChar = '_' : identStartChar
-newtype Name = Name { unName :: B.ByteString } deriving (Show)
-instance Arbitrary Name where
- arbitrary = do
- x <- elements identStartChar
- n <- choose (4,10)
- rest <- vectorOf n $ elements identChar
- return $ Name $ B.pack (x:rest)
+identChar :: [Char]
+identChar = '_' : identStartChar
-instance Arbitrary Node where
- arbitrary = limitedDepth 3
- shrink (X.Text _) = []
- shrink (X.Element _ [] []) = []
- shrink (X.Element n [] (_:cs)) = [X.Element n [] cs]
- shrink (X.Element n (_:as) []) = [X.Element n as []]
- shrink (X.Element n as cs) = [X.Element n as (tail cs), X.Element n (tail
as) cs]
textGen :: Gen [Char]
textGen = listOf $ elements ((replicate 5 ' ') ++ identStartChar)
+
limitedDepth :: Int -> Gen Node
limitedDepth 0 = liftM (X.Text . B.pack) textGen
limitedDepth n = oneof [ liftM (X.Text . B.pack) textGen
, liftM3 X.Element arbitrary
(liftM (take 2) arbitrary)
- (liftM (take 3) $ listOf $
limitedDepth (n-1))
+ (liftM (take 3) $ listOf $
limitedDepth (n - 1))
]
-instance Arbitrary B.ByteString where
- arbitrary = liftM unName arbitrary
-
-{-
- - Code for inserting nodes into any point of a tree
- -}
-
-type Loc = Cursor B.ByteString B.ByteString
-type Insert a = State Int a
-
-{-
- - Returns the number of unique insertion points in the tree.
- - If h = insertAt f n g", the following property holds:
- - insSize h == (insSize f) + (insSize g) - 1
- -}
+-- | Returns the number of unique insertion points in the tree.
+-- If h = insertAt f n g", the following property holds:
+-- insSize h == (insSize f) + (insSize g) - 1
insSize :: [X.Node tag text] -> Int
insSize ns = 1 + (sum $ map nodeSize ns)
where nodeSize (X.Text _) = 1
nodeSize (X.Element _ _ c) = 1 + (insSize c)
+
insertAt :: [Node] -> Int -> [Node] -> [Node]
insertAt elems 0 ns = elems ++ ns
insertAt elems _ [] = elems
insertAt elems n list = maybe [] (toForest . root) $
- evalState (processNode elems $ fromJust $ fromForest list) n
+ evalState (processNode elems $ fromJust $ fromForest list) n
+
move :: Insert ()
move = modify (\x -> x-1)
+
processNode :: [Node] -> Loc -> Insert (Maybe Loc)
processNode elems loc = liftM2 mplus (move >> goDown loc) (move >> goRight loc)
where goDown l = case current l of
@@ -227,45 +243,86 @@ processNode elems loc = liftM2 mplus (move >> goDown loc)
(move >> goRight loc)
then return $ insertFunc l
else maybe (return Nothing) (processNode elems) $ next l
+
+-- | Reloads the templates from disk and renders the specified
+-- template. (Old convenience code.)
+quickRender :: FilePath -> ByteString -> IO (Maybe ByteString)
+quickRender baseDir name = do
+ ts <- loadTS baseDir
+ renderTemplate ts name
+
+
+newtype Name = Name { unName :: B.ByteString } deriving (Show)
+
+instance Arbitrary Name where
+ arbitrary = do
+ x <- elements identStartChar
+ n <- choose (4,10)
+ rest <- vectorOf n $ elements identChar
+ return $ Name $ B.pack (x:rest)
+
+instance Arbitrary Node where
+ arbitrary = limitedDepth 3
+ shrink (X.Text _) = []
+ shrink (X.Element _ [] []) = []
+ shrink (X.Element n [] (_:cs)) = [X.Element n [] cs]
+ shrink (X.Element n (_:as) []) = [X.Element n as []]
+ shrink (X.Element n as cs) = [X.Element n as (tail cs), X.Element n (tail
as) cs]
+
+
+instance Arbitrary B.ByteString where
+ arbitrary = liftM unName arbitrary
+
+{-
+ - Code for inserting nodes into any point of a tree
+ -}
+type Loc = Cursor B.ByteString B.ByteString
+type Insert a = State Int a
+
+
{-
- <bind> tests
-}
-- Data type encapsulating the parameters for a bind operation
-data Bind = Bind {
- _bindElemName :: Name,
- _bindChildren :: [Node],
- _bindDoc :: [Node],
- _bindPos :: Int,
- _bindRefPos :: Int
-} -- deriving (Show)
+data Bind = Bind
+ { _bindElemName :: Name
+ , _bindChildren :: [Node]
+ , _bindDoc :: [Node]
+ , _bindPos :: Int
+ , _bindRefPos :: Int
+ } -- deriving (Show)
+
instance Show Bind where
show b@(Bind e c d p r) = unlines
- ["\n"
- ,"Bind element name: "++(show e)
- ,"Bind pos: "++(show p)
- ,"Bind ref pos: "++(show r)
- ,"Bind document:"
- ,L.unpack $ L.concat $ map formatNode d
- ,"Bind children:"
- ,L.unpack $ L.concat $ map formatNode c
- ,"Result:"
- ,L.unpack $ L.concat $ map formatNode $ buildResult b
- ,"Splice result:"
- ,L.unpack $ L.concat $ map formatNode $ unsafePerformIO $
+ [ "\n"
+ , "Bind element name: " ++ (show e)
+ , "Bind pos: " ++ (show p)
+ , "Bind ref pos: " ++ (show r)
+ , "Bind document:"
+ , L.unpack $ L.concat $ map formatNode d
+ , "Bind children:"
+ , L.unpack $ L.concat $ map formatNode c
+ , "Result:"
+ , L.unpack $ L.concat $ map formatNode $ buildResult b
+ , "Splice result:"
+ , L.unpack $ L.concat $ map formatNode $ unsafePerformIO $
evalTemplateMonad (runNodeList $ buildBindTemplate b)
(X.Text "") emptyTemplateState
- ,"Template:"
- ,L.unpack $ L.concat $ map formatNode $ buildBindTemplate b
+ , "Template:"
+ , L.unpack $ L.concat $ map formatNode $ buildBindTemplate b
]
+
buildNode :: B.ByteString -> B.ByteString -> Bind -> Node
buildNode tag attr (Bind s c _ _ _) = X.Element tag [(attr, unName s)] c
+
buildBind :: Bind -> Node
buildBind = buildNode "bind" "tag"
+
instance Arbitrary Bind where
arbitrary = do
name <- arbitrary
@@ -279,87 +336,64 @@ instance Arbitrary Bind where
shrink (Bind e (_:cs) d p r) = [Bind e cs d p r]
shrink _ = []
+
empty :: tag -> X.Node tag text
empty n = X.Element n [] []
+
buildBindTemplate :: Bind -> [Node]
buildBindTemplate s@(Bind n _ d b r) =
- insertAt [empty $ unName $ n] pos $ withBind
+ insertAt [empty $ unName $ n] pos $ withBind
where bind = [buildBind s]
bindSize = insSize bind
withBind = insertAt bind b d
pos = b + bindSize - 1 + r
+
buildResult :: Bind -> [Node]
-buildResult (Bind _ c d b r) = insertAt c (b+r) d
+buildResult (Bind _ c d b r) = insertAt c (b + r) d
-prop_simpleBindTest :: Bind -> PropertyM IO ()
-prop_simpleBindTest bind = do
- let template = buildBindTemplate bind
- result = buildResult bind
- spliceResult <- run $ evalTemplateMonad (runNodeList template)
- (X.Text "")
- emptyTemplateState
-
- assert $ result == spliceResult
{-
- <apply> tests
-}
+data Apply = Apply
+ { _applyName :: Name
+ , _applyCaller :: [Node]
+ , _applyCallee :: Template
+ , _applyChildren :: [Node]
+ , _applyPos :: Int
+ } deriving (Show)
-data Apply = Apply {
- _applyName :: Name,
- _applyCaller :: [Node],
- _applyCallee :: Template,
- _applyChildren :: [Node],
- _applyPos :: Int
-} deriving (Show)
instance Arbitrary Apply where
- arbitrary = do
- name <- arbitrary
- kids <- liftM (take 3) $ listOf $ limitedDepth 2
- caller <- liftM (take 5) arbitrary
- callee <- liftM (take 1) $ listOf $ limitedDepth 3
- let s = insSize caller
- loc <- choose (0, s-1)
- return $ Apply name caller callee kids loc
+ arbitrary = do
+ name <- arbitrary
+ kids <- liftM (take 3) $ listOf $ limitedDepth 2
+ caller <- liftM (take 5) arbitrary
+ callee <- liftM (take 1) $ listOf $ limitedDepth 3
+ let s = insSize caller
+ loc <- choose (0, s-1)
+ return $ Apply name caller callee kids loc
+
buildApplyCaller :: Apply -> [Node]
buildApplyCaller (Apply name caller _ kids pos) =
- insertAt [X.Element "apply" [("template", unName name)] kids] pos caller
+ insertAt [X.Element "apply" [("template", unName name)] kids] pos caller
+
calcCorrect :: Apply -> [Node]
calcCorrect (Apply _ caller callee _ pos) = insertAt callee pos caller
+
calcResult :: (MonadIO m) => Apply -> m [Node]
calcResult apply@(Apply name _ callee _ _) =
- evalTemplateMonad (runNodeList $ buildApplyCaller apply)
- (X.Text "") ts
-
+ evalTemplateMonad (runNodeList $ buildApplyCaller apply)
+ (X.Text "") ts
where ts = setTemplates (Map.singleton [unName name]
- (InternalTemplate Nothing callee))
- emptyTemplateState
+ (InternalTemplate Nothing callee))
+ emptyTemplateState
-prop_simpleApplyTest :: Apply -> PropertyM IO ()
-prop_simpleApplyTest apply = do
- let correct = calcCorrect apply
- result <- run $ calcResult apply
- assert $ correct == result
-
-
-loadTS :: FilePath -> IO (TemplateState IO)
-loadTS baseDir = do
- etm <- loadTemplates baseDir emptyTemplateState
- return $ either error id etm
-
-------------------------------------------------------------------------------
--- | Reloads the templates from disk and renders the specified
--- template. (Old convenience code.)
-quickRender :: FilePath -> ByteString -> IO (Maybe ByteString)
-quickRender baseDir name = do
- ts <- loadTS baseDir
- renderTemplate ts name
{-
@@ -387,8 +421,6 @@ r name etm = do
let ts = either (error "Danger Will Robinson!") id etm
ns <- runNodeList ts name
return $ (Just . formatList') =<< ns
-
-
-}
-----------------------------------------------------------------------
hooks/post-receive
--
heist
_______________________________________________
Snap mailing list
[email protected]
http://mailman-mail5.webfaction.com/listinfo/snap
