[Initial addition of unit tests and correction of ordering in main data structure on insert. prb@mult.ifario.us**20080125084111] { adddir ./perpubplat/testsrc adddir ./perpubplat/testsrc/Blog adddir ./perpubplat/testsrc/Blog/Model hunk ./perpubplat/perpubplat.cabal 10 -build-depends: base >= 2.0, parsec >= 2.0, xhtml >= 3000, haskell98, filepath >= 1.0, - old-time >= 1.0, containers, directory -exposed-modules: Utilities, - Blog.Constants, - Blog.Model.Entry, Blog.Model.EntryParser, Blog.Model.CommentBodyParser, - Blog.Model.CommentForm, Blog.Model.CommentQueue - Blog.FrontEnd.ContentAtoms, Blog.FrontEnd.CommentEntry, - Blog.FrontEnd.Presentation, Blog.FrontEnd.Syndication, - Blog.FrontEnd.Routes, Blog.FrontEnd.Feeds, Blog.FrontEnd.Views, - Blog.FrontEnd.Actions, Blog.FrontEnd.Urls, - Blog.BackEnd.DataController, Blog.BackEnd.IoOperations, - Blog.BackEnd.ModelTransformations, - Blog.Widgets.TagCloud, Blog.Widgets.FlickrBadge, - Blog.Admin.PendingComments, - Text.Atom -hs-source-dirs: src -ghc-options: -O -Werror -fwarn-unused-binds -fwarn-unused-imports -fwarn-unused-matches +stability: alpha +build-type: Simple +cabal-version: >= 1.2 hunk ./perpubplat/perpubplat.cabal 14 + + +Library + build-depends: + base >= 2.0, parsec >= 2.0, xhtml >= 3000, haskell98, filepath >= 1.0, + old-time >= 1.0, containers, directory + exposed-modules: + Utilities, + Blog.Constants, + Blog.Model.Entry, Blog.Model.EntryParser, Blog.Model.CommentBodyParser, + Blog.Model.CommentForm, Blog.Model.CommentQueue + Blog.FrontEnd.ContentAtoms, Blog.FrontEnd.CommentEntry, + Blog.FrontEnd.Presentation, Blog.FrontEnd.Syndication, + Blog.FrontEnd.Routes, Blog.FrontEnd.Feeds, Blog.FrontEnd.Views, + Blog.FrontEnd.Actions, Blog.FrontEnd.Urls, + Blog.BackEnd.DataController, Blog.BackEnd.IoOperations, + Blog.BackEnd.ModelTransformations, + Blog.Widgets.TagCloud, Blog.Widgets.FlickrBadge, + Blog.Admin.PendingComments, + Text.Atom + hs-source-dirs: + src + ghc-options: + -O -Werror -fwarn-unused-binds -fwarn-unused-imports -fwarn-unused-matches + +Executable runtests + buildable: + False + build-depends: + HUnit + main-is: + runtests.hs + hs-source-dirs: + testsrc hunk ./perpubplat/src/Blog/BackEnd/ModelTransformations.hs 21 - ; let model' = insert model new_item + ; let (_,model') = insert model new_item hunk ./perpubplat/src/Blog/BackEnd/ModelTransformations.hs 35 - ; let model' = insert model new_comment + ; let (_,model') = insert model new_comment hunk ./perpubplat/src/Blog/Model/Entry.hs 56 -insert :: Model -> Item -> Model -insert m i = m { by_permatitle = M.insert (permatitle i') i' $ by_permatitle m - , by_int_id = M.insert n i' $ by_int_id m - , child_map = M.insert (internal_id i') [] $ - case parent i of - Nothing -> - child_map m - (Just p_id) -> - M.insert p_id (insert_comment_ m (item_by_id m p_id) i') $ child_map m - , all_items = insert_ (all_items m) i' - , next_id = n + 1 } +insert :: Model -> Item -> (Item,Model) +insert m i = (i', m { by_permatitle = M.insert (permatitle i') i' $ by_permatitle m + , by_int_id = M.insert n i' $ by_int_id m + , child_map = M.insert (internal_id i') [] $ + case parent i of + Nothing -> + child_map m + (Just p_id) -> + M.insert p_id (insert_comment_ m (item_by_id m p_id) i') $ child_map m + , all_items = insert_ after (all_items m) i' + , next_id = n + 1 } ) hunk ./perpubplat/src/Blog/Model/Entry.hs 72 -insert_comment_ m p c = map internal_id (insert_ (children m p) c) +insert_comment_ m p c = map internal_id (insert_ before (children m p) c) hunk ./perpubplat/src/Blog/Model/Entry.hs 74 -insert_ :: [Item] -> Item -> [Item] -insert_ [] y = [y] -insert_ s@(x:xs) y = if (x `before` y) then - (x:(insert_ xs y)) - else - (y:s) +insert_ :: (Item -> Item -> Bool) -> [Item] -> Item -> [Item] +insert_ _ [] y = [y] +insert_ o s@(x:xs) y = if (x `o` y) then + (x:(insert_ o xs y)) + else + (y:s) + +after :: Item -> Item -> Bool +after a b = (created a) > (created b) hunk ./perpubplat/src/Blog/Model/Entry.hs 98 - , all_items = insert_ all_but i' } } + , all_items = insert_ after all_but i' } } hunk ./perpubplat/src/Blog/Model/Entry.hs 104 - resort_siblings = map internal_id (insert_ (filter not_i $ children m p) i) + resort_siblings = map internal_id (insert_ before (filter not_i $ children m p) i) hunk ./perpubplat/src/Blog/Model/Entry.hs 288 +all_comments :: Model -> [Item] +all_comments = (filter (\x -> Comment == kind x)) . all_items + hunk ./perpubplat/src/Utilities.hs 1 -module Utilities ( subst, hotness, readFile', now +module Utilities ( subst, hotness, readFile', now, format_time hunk ./perpubplat/src/Utilities.hs 22 +last_page _ [] = 1 hunk ./perpubplat/src/Utilities.hs 127 - ; return $ concat [ yy d, "-", mm d, "-", dd d, "T", - hh d, ":", mmmm d, ":", ss d , "Z" ] } + ; return $ format_time d } + +format_time :: CalendarTime -> String +format_time d = concat [ yy d, "-", mm d, "-", dd d, "T" + , hh d, ":", mmmm d, ":", ss d , "Z" ] addfile ./perpubplat/testsrc/Blog/Model/EntryTests.hs hunk ./perpubplat/testsrc/Blog/Model/EntryTests.hs 1 +module Blog.Model.EntryTests where + +import qualified Blog.Model.Entry as B + +import Data.List +import Test.HUnit + +testBlogModel = TestList [ testPostInsertion + , testCommentInsertion ] + +p1 = B.Item { B.internal_id = -1 + , B.kind = B.Post + , B.title = "Post 1" + , B.summary = Nothing + , B.body = "Post 1 body" + , B.tags = ["a","b","c"] + , B.uid = "uid://1" + , B.permatitle = "post-1" + , B.created = "2000-01-01T00:00:00Z" + , B.updated = "2000-01-01T00:00:00Z" + , B.author = B.default_author + , B.visible = True + , B.parent = Nothing } + +p2 = p1 { B.internal_id = -1 + , B.title = "Post 2" + , B.body = "Post 2 body" + , B.tags = ["b","c","d"] + , B.uid = "uid://2" + , B.permatitle = "post-2" + , B.created = "2000-01-02T00:00:00Z" + , B.updated = "2000-01-02T00:00:00Z" } + +p3 = p1 { B.internal_id = -1 + , B.title = "Post 3" + , B.body = "Post 3 body" + , B.tags = ["d","e","f"] + , B.uid = "uid://3" + , B.permatitle = "post-3" + , B.created = "2000-01-03T00:00:00Z" + , B.updated = "2000-01-03T00:00:00Z" } + +testPostInsertion = test [ + -- all_posts contains entries inserted + (B.permatitle_exists m123 (B.permatitle p1)) ~? "p1 should be present by permatitle" + , (B.permatitle_exists m123 (B.permatitle p2)) ~? "p2 should be present by permatitle" + , (B.permatitle_exists m123 (B.permatitle p3)) ~? "p3 should be present by permatitle" + -- all_posts is in reverse chronological order + , (map (B.permatitle) (B.all_posts m123)) ~?= ["post-3","post-2","post-1"] + -- all internal_ids were updated, i.e., no -1's + , not (-1 `elem` (map B.internal_id $ B.all_posts m123)) ~? "No internal ids should be -1 after insertion." + ] + where + m123 = snd . (ins p1) . (ins p2) . (ins p3) $ (p1, B.empty) + ins = (flip (B.insert . snd)) + + +c :: Int -> B.Item +c i = B.Item { B.internal_id = -1 + , B.kind = B.Comment + , B.title = "" + , B.summary = Nothing + , B.body = "Comment " ++ si ++ " body" + , B.tags = [] + , B.uid = "comment://" ++ si + , B.permatitle = "comment-" ++ si + , B.created = "2000-0" ++ si ++ "-01T00:00:00Z" + , B.updated = "2000-0" ++ si ++ "-01T00:00:00Z" + , B.author = B.default_author + , B.visible = True + , B.parent = Just 0 } + where + si = show i + +testCommentInsertion = test [ + -- all_posts contains comments inserted + "all comments present" ~: (sort . (map B.permatitle) $ B.all_comments mc) ~?= ["comment-1","comment-2","comment-3"] + -- comments in reverse chronological order as post items + , (map B.permatitle $ B.all_comments mc) ~?= ["comment-3","comment-2","comment-1"] + , (map B.permatitle $ B.all_items mc) ~?= ["comment-3","comment-2","comment-1","post-1"] + -- commentsi n chronological order as children + , (map B.permatitle $ B.children mc ip1) ~?= ["comment-1","comment-2","comment-3"] + -- all internal_ids were updated, i.e., no -1's + , (not (-1 `elem` (map B.internal_id $ B.all_items mc))) ~? "No internal ids should be -1 after insertion." + -- make sure that relative URLs are right + , (map (B.relative_url mc) (B.all_items mc)) ~?= [ "/post-1#comment-3" + , "/post-1#comment-2" + , "/post-1#comment-1" + , "/post-1" ] + ] + where + ins = (flip (B.insert . snd)) + (ip1, mp1) = B.insert B.empty p1 + c1 = (c 1) { B.parent = Just $ B.internal_id ip1 } + c2 = (c 2) { B.parent = Just $ B.internal_id ip1 } + c3 = (c 3) { B.parent = Just $ B.internal_id ip1 } + mc = snd . (ins c1) . (ins c3) . (ins c2) $ (p1,mp1) + addfile ./perpubplat/testsrc/UtilitiesTests.hs hunk ./perpubplat/testsrc/UtilitiesTests.hs 1 +module UtilitiesTests where + +import qualified Utilities as U +import Time +import Test.HUnit.Base +import Control.Monad ( liftM ) + +testUtilities = TestList [ testPaginate + , testLastPage + , testTimeFormatting ] + +testPaginate = test [ + -- empty list + "empty list paginates to empty list" ~: (U.paginate 20 10 ([]::[Int])) ~?= ([]::[Int]) + -- spot testing + , "first 10-item page of [1..500]" ~: (U.paginate 10 1 [1..500]) ~?= [1..10] + , "10th 10-item page of [1..500]" ~: (U.paginate 10 10 [1..500]) ~?= [91..100] + -- pages hanging over the end + , "second 3-item page of [1,2,3,4,5]" ~: (U.paginate 3 2 [1,2,3,4,5]) ~?= [4,5] + , "third 3-item page of [1,2,3,4,5]" ~: (U.paginate 3 3 [1,2,3,4,5]) ~?= [4,5] + -- first page not full + , "first 3-item page of [1,2]" ~: (U.paginate 3 1 [1,2]) ~?= [1,2] ] + +testLastPage = test [ + -- empty list + "last page of empty list is 1" ~: (U.last_page 20 []) ~?= 1 + , -- two pages + "last 3-item page of [1,2,3,4]" ~: (U.last_page 3 [1,2,3,4]) ~?= 2 + , -- two pages + "last 3-item page of [1,2,3,4,5,6]" ~: (U.last_page 3 [1,2,3,4,5,6]) ~?= 2 + , -- fifty pages + "last 10-item page of [1..500]" ~: (U.last_page 10 [1..500]) ~?= 50 + , -- first page not full + "last 3-item page of [1,2]" ~: (U.last_page 3 [1,2]) ~?= 1 ] + +_n = CalendarTime { ctYear = 2000 + , ctMonth = January + , ctDay = 1 + , ctHour = 5 + , ctMin = 9 + , ctSec = 0 + , ctPicosec = 0 + , ctTZName = "UTC" + , ctTZ = 0 + , ctWDay = Wednesday + , ctYDay = 5 + , ctIsDST = False} + +_m = CalendarTime { ctYear = 2000 + , ctMonth = October + , ctDay = 11 + , ctHour = 12 + , ctMin = 55 + , ctSec = 33 + , ctPicosec = 0 + , ctTZName = "UTC" + , ctTZ = 0 + , ctWDay = Sunday + , ctYDay = 285 + , ctIsDST = False} + + +testTimeFormatting = test [ + -- check for delimiters + "delimiters when padded" ~: "--T::Z" ~?= [f!!4,f!!7,f!!10,f!!13,f!!16,f!!19] + , "delimiters when unpadded" ~: "--T::Z" ~?= [g!!4,g!!7,g!!10,g!!13,g!!16,g!!19] + -- check lengths + , "length when padded" ~: (length f) ~?= 20 + , "length when unpadded" ~: (length g) ~?= 20 + -- check components + , "year" ~: (take 4 f) ~?= "2000" + , "zero-padded month" ~: (take 2 $ drop 5 f) ~?= "01" + , "zero-padded day" ~: (take 2 $ drop 8 f) ~?= "01" + , "zero-padded hour" ~: (take 2 $ drop 11 f) ~?= "05" + , "zero-padded minutes" ~: (take 2 $ drop 14 f) ~?= "09" + , "zero-padded seconds" ~: (take 2 $ drop 17 f) ~?= "00" + , "year" ~: (take 4 g) ~?= "2000" + , "unpadded month" ~: (take 2 $ drop 5 g) ~?= "10" + , "unpadded day" ~: (take 2 $ drop 8 g) ~?= "11" + , "unpadded hour" ~: (take 2 $ drop 11 g) ~?= "12" + , "unpadded minutes" ~: (take 2 $ drop 14 g) ~?= "55" + , "unpadded seconds" ~: (take 2 $ drop 17 g) ~?= "33" + ] + where + f = U.format_time _n + g = U.format_time _m + addfile ./perpubplat/testsrc/runtests.hs hunk ./perpubplat/testsrc/runtests.hs 1 - +module Main where + +import Test.HUnit +import Blog.Model.EntryTests +import UtilitiesTests + +main :: IO Counts +main = runTestTT allTests + +allTests = TestList [ + -- tests Utilities + testUtilities + -- tests Blog.Model.Entry + , testBlogModel + ] }