Commits

Luke Plant committed f6e31d3

Model definition and migration for comments table

  • Participants
  • Parent commits 324c9a4

Comments (0)

Files changed (4)

   Main-is: Migrate.hs
   hs-source-dirs: src
 
-Executable installdb
-  Build-Depends:
-        base == 3.*,
-        haskell98 >= 1.0.1,
-        HDBC-sqlite3 >= 1.1.4,
-        HDBC >= 1.1.5
-  Main-is: Installdb.hs
-  hs-source-dirs: src
-
 Executable blog.cgi
   Build-Depends:
         base == 3.*,

File src/Blog/Comment.hs

 module Blog.Comment where
 
 
+data Comment = Comment {
+      uid :: Int
+    , post_id :: Int
+    , timestamp :: Int
+    , name :: String
+    , email :: String
+    , text_raw :: String
+    , text_formatted :: String
+    , format_id :: Int
+    } deriving (Show, Eq)

File src/Blog/Model.hs

 module Blog.Model ( addPost
                   , addCategory
-                  , makePostSlug
                   , addPostCategory
+                  , addComment
                   , getPostBySlug
                   , getRecentPosts
                   , getCategoriesForPost
 import qualified Blog.Comment as Cm
 
 ------ Create -------
+getDbId cn =
+    do
+      [[newid]] <- quickQuery' cn "SELECT last_insert_rowid();" []
+      return $ fromSql newid
+
 addPost cn p = do theslug <- makePostSlug cn p
                   let p2 = p { P.slug = theslug }
                   DB.doInsert cn "posts" [
                          toSql $ P.timestamp p2,
                          toSql $ P.comments_open p2
                         ]
-                  [[newid]] <- quickQuery' cn "SELECT last_insert_rowid();" []
-                  return p2 { P.uid = fromSql $ newid }
+                  newid <- getDbId cn
+                  return p2 { P.uid = newid }
 
 makePostSlug cn p = makeSlugGeneric cn (P.title p) "posts"
 
                               "slug"]
                              [toSql $ Ct.name c2,
                               toSql $ Ct.slug c2]
-                       [[newid]] <- quickQuery cn "SELECT last_insert_rowid();" [];
-                       return c2 { Ct.uid = fromSql $ newid }
+                       newid <- getDbId cn
+                       return c2 { Ct.uid = newid }
 
 makeCategorySlug cn cat = makeSlugGeneric cn (Ct.name cat) "categories"
 
                               toSql $ snd pc];
                              return pc; }
 
+
+addComment cn cm = do
+  DB.doInsert cn "comments" [
+                    "post_id"
+                   , "timestamp"
+                   , "name"
+                   , "email"
+                   , "text_raw"
+                   , "text_formatted"
+                   , "format_id"
+                   ] [
+                    toSql $ Cm.post_id cm
+                   , toSql $ Cm.timestamp cm
+                   , toSql $ Cm.name cm
+                   , toSql $ Cm.email cm
+                   , toSql $ Cm.text_raw cm
+                   , toSql $ Cm.text_formatted cm
+                   , toSql $ Cm.format_id cm
+                   ]
+  newid <- getDbId cn
+  return cm { Cm.uid = newid }
+
 -------- Queries -----------
 
 ---- Statements -----

File src/Migrate.hs

 import Monad (liftM)
 import Text.Template (readTemplate, renderToFile)
 import qualified Blog.Category as C
+import qualified Blog.Comment as Cm
 import qualified Blog.DB as DB
 import qualified Blog.Formats as Formats
 import qualified Blog.Post as P
   rows <- readTable (Settings.old_data_path ++ filename)
   return $ map constructor rows
 
+
+-- Reading functions
 readCategories = makeItems "categories.txt" mkCat
     where mkCat row = C.Category { C.uid = read (row !! 0),
                                    C.name = row !! 1,
     where mkPostCategory row = (read (row !! 0),
                                 read (row !! 1)) :: (Int, Int)
 
+readComments = makeItems "comments.txt" mkComment
+               >>= return . sortBy (comparing Cm.timestamp)
+    where mkComment row = Cm.Comment { Cm.uid = read (row !! 0)
+                                     , Cm.post_id = read (row !! 1)
+                                     , Cm.timestamp = read (row !! 2)
+                                     , Cm.name = row !! 3
+                                     , Cm.email = row !! 4
+                                     , Cm.text_raw = row !! 5
+                                     , Cm.text_formatted = row !! 5
+                                     , Cm.format_id = Formats.rawhtml
+                                     }
+-- Writing
+
 writeItems cn writer items = mapM (writer cn) items
 
 utf8 = UTF8.fromString
 
 main = handleSqlError $ do
   cn <- DB.connect
+  -- Categories
   origCats <- readCategories
   newCats <- writeItems cn addCategory origCats
+  -- Posts
   origPosts <- readPosts
   newPosts <- writeItems cn addPost origPosts
   -- we need the new/old IDs of posts/categories to rewrite comments tables
   -- and the post/categories m2m
   let post_id_map = Map.fromList $ zip (map P.uid origPosts) (map P.uid newPosts)
   let cat_id_map = Map.fromList $ zip (map C.uid origCats) (map C.uid newCats)
+
+  -- post-categories
   postCategories' <- readPostCategories
   let postCategories = correctIds postCategories' post_id_map cat_id_map
   writeItems cn addPostCategory postCategories
 
+  -- comments
+  comments' <- readComments
+  let comments = correctCommentPostIds comments' post_id_map
+  writeItems cn addComment comments
+
+  -- Redirect file
   let postUrlMap = Map.fromList $ zip (map (show . P.uid) origPosts)
                                       (map Links.postUrl newPosts)
   let categoryUrlMap = Map.fromList $ zip (map (show . C.uid) origCats)
     where correctIds pcs p_id_map c_id_map =
               map (\(p_id, c_id) -> (fromJust $ Map.lookup p_id p_id_map,
                                      fromJust $ Map.lookup c_id c_id_map)) pcs
+          correctCommentPostIds cms p_id_map =
+              map (\cm -> cm { Cm.post_id = fromJust $ Map.lookup (Cm.post_id cm) p_id_map }) cms