Commits

Luke Plant committed 34f6b78

Pulled functions out of Migrate.hs into Post.hs and Category.hs

  • Participants
  • Parent commits a7d7f00

Comments (0)

Files changed (4)

src/Blog/Category.hs

 module Blog.Category where
-{
 
-    data Category = Category { id :: Int,
-                               name :: String,
-                               slug :: String
-                             } deriving (Show, Eq)
+import Database.HDBC
+import Blog.DBUtils (makeSlugGeneric, slugFromTitle)
+import qualified Blog.DB as DB
 
-}
+data Category = Category { uid :: Int,
+                           name :: String,
+                           slug :: String
+                         } deriving (Show, Eq)
+
+addCategory cn c =  do theslug <- makeCategorySlug cn c
+                       let c2 = c { slug = theslug }
+                       DB.doInsert cn "categories"
+                             ["name",
+                              "slug"]
+                             [toSql $ name c2,
+                              toSql $ slug c2]
+                       [[newid]] <- quickQuery cn "SELECT last_insert_rowid();" [];
+                       return c2 { uid = fromSql $ newid }
+
+makeCategorySlug cn cat = makeSlugGeneric cn (slugFromTitle $ name cat) "categories" 1
 module Blog.Post where
-{
-  data Post = Post {
-        id :: Int,
-        title :: String,
-        slug :: String,
-        post_raw :: String,
-        post_formatted :: String,
-        summary_raw :: String,
-        summary_formatted :: String,
-        format_id :: Int,
-        timestamp :: Int,
-        comments_open :: Bool
-      } deriving (Show, Eq)
-}
 
+import Database.HDBC
+import Blog.DBUtils (makeSlugGeneric, slugFromTitle)
+import qualified Blog.DB as DB
+
+data Post = Post {
+      uid :: Int,
+      title :: String,
+      slug :: String,
+      post_raw :: String,
+      post_formatted :: String,
+      summary_raw :: String,
+      summary_formatted :: String,
+      format_id :: Int,
+      timestamp :: Int,
+      comments_open :: Bool
+    } deriving (Show, Eq)
+
+addPost cn p = do { theslug <- makePostSlug cn p;
+                    p2 <- return $ p { slug = theslug };
+                    DB.doInsert cn "posts"
+                    ["title",
+                     "slug",
+                     "post_raw",
+                     "post_formatted",
+                     "summary_raw",
+                     "summary_formatted",
+                     "format_id",
+                     "timestamp",
+                     "comments_open"]
+                    [toSql $ title p2,
+                     toSql $ slug p2,
+                     toSql $ post_raw p2,
+                     toSql $ post_formatted p2,
+                     toSql $ summary_raw p2,
+                     toSql $ summary_formatted p2,
+                     toSql $ format_id p2,
+                     toSql $ timestamp p2,
+                     toSql $ comments_open p2];
+                    [[newid]] <- quickQuery cn "SELECT last_insert_rowid();" [];
+                    return p2 { uid = fromSql $ newid } ;
+                  }
+
+makePostSlug cn p = makeSlugGeneric cn (slugFromTitle $ title p) "posts" 1

src/Blog/Utils.hs

              else case (str =~~ re) :: Maybe (B.ByteString, B.ByteString, B.ByteString) of
                Nothing -> B.concat . reverse $ (str:res)
                Just (bef, _ , aft) -> go aft (rep:bef:res)
+
+split :: String -> Char -> [String]
+split [] delim = [""]
+split (c:cs) delim
+   | c == delim = "" : rest
+   | otherwise = (c : head rest) : tail rest
+   where
+       rest = split cs delim
-import Blog.Utils (regexReplace)
+import Blog.Utils (regexReplace, split)
 import Data.Maybe (fromJust)
 import Data.Ord (comparing)
 import Database.HDBC
-import GHC.Unicode (toLower)
 import List (sortBy, intersperse)
 import Monad (liftM)
 import Text.Template (readTemplate, renderToFile)
 import qualified Data.Map as Map
 -- Migration script for the old data
 
--- Misc utilities
-split :: String -> Char -> [String]
-split [] delim = [""]
-split (c:cs) delim
-   | c == delim = "" : rest
-   | otherwise = (c : head rest) : tail rest
-   where
-       rest = split cs delim
-
 -- Read a table of newline/tab delimited data,
 -- padding columns to specified amount
 readTable :: FilePath -> IO [[String]]
   return $ map constructor rows
 
 readCategories = makeItems "categories.txt" mkCat
-    where mkCat row = C.Category { C.id = read (row !! 0),
+    where mkCat row = C.Category { C.uid = read (row !! 0),
                                    C.name = row !! 1,
                                    C.slug = ""}
 writeItems cn writer items = mapM (writer cn) items
 
-addCategory cn c =  do slug <- makeCategorySlug cn c
-                       let c2 = c { C.slug = slug }
-                       DB.doInsert cn "categories"
-                             ["name",
-                              "slug"]
-                             [toSql $ C.name c2,
-                              toSql $ C.slug c2]
-                       [[newid]] <- quickQuery cn "SELECT last_insert_rowid();" [];
-                       return c2 { C.id = fromSql $ newid }
 
-slugFromTitle title = map toLower $ B.unpack $
-                      regexReplace (B.pack "-+$") (B.pack "") $
-                      regexReplace (B.pack "[^A-Za-z0-9]+") (B.pack "-") (B.pack title)
 
-makePostSlug cn p = makeSlugGeneric cn (slugFromTitle $ P.title p) "posts" 1
 
-makeCategorySlug cn cat = makeSlugGeneric cn (slugFromTitle $ C.name cat) "categories" 1
 
-makeSlugGeneric cn slugBase table iter = do
-  let slugAttempt =  (slugBase ++ makeSuffix iter);
-  [[SqlString c]] <- quickQuery cn ("SELECT count(slug) FROM " ++ table ++ " WHERE slug = ?") [toSql slugAttempt];
-  case c of
-    "0" -> return slugAttempt
-    _   -> makeSlugGeneric cn slugBase table (iter + 1)
-
- where
-   makeSuffix 1 = ""
-   makeSuffix n = show n
 
 readPosts = makeItems "posts.txt" mkPost
             >>= mapM addFullText
             >>= return . sortBy (comparing P.timestamp)
-    where mkPost row = P.Post { P.id = read (row !! 0),
+    where mkPost row = P.Post { P.uid = read (row !! 0),
                                 P.title = row !! 1,
                                 P.slug = "",
                                 P.post_raw = "",
                                 P.timestamp = read (row !! 2),
                                 P.comments_open = True
                               }
-          addFullText p = do let dataFile = Settings.old_data_path ++ "posts/" ++ (show $ P.id p)
+          addFullText p = do let dataFile = Settings.old_data_path ++ "posts/" ++ (show $ P.uid p)
                              f <- readFile dataFile
                              let fixed = fixCodes f
                              return p { P.post_raw = fixed,
                                         P.post_formatted = fixed }
           fixCodes txt = B.unpack $ regexReplace (B.pack "&#10;") (B.pack "\n") (B.pack txt)
 
-addPost cn p = do { slug <- makePostSlug cn p;
-                    p2 <- return $ p { P.slug = slug };
-                    DB.doInsert cn "posts"
-                    ["title",
-                     "slug",
-                     "post_raw",
-                     "post_formatted",
-                     "summary_raw",
-                     "summary_formatted",
-                     "format_id",
-                     "timestamp",
-                     "comments_open"]
-                    [toSql $ P.title p2,
-                     toSql $ P.slug p2,
-                     toSql $ P.post_raw p2,
-                     toSql $ P.post_formatted p2,
-                     toSql $ P.summary_raw p2,
-                     toSql $ P.summary_formatted p2,
-                     toSql $ P.format_id p2,
-                     toSql $ P.timestamp p2,
-                     toSql $ P.comments_open p2];
-                    [[newid]] <- quickQuery cn "SELECT last_insert_rowid();" [];
-                    return p2 { P.id = fromSql $ newid } ;
-                  }
-
 readPostCategories = makeItems "postcategories.txt" mkPostCategory
     where mkPostCategory row = (read (row !! 0),
                                 read (row !! 1)) :: (Int, Int)
 main = handleSqlError $ do
   cn <- DB.connect
   origCats <- readCategories
-  newCats <- writeItems cn addCategory origCats
+  newCats <- writeItems cn C.addCategory origCats
   origPosts <- readPosts
-  newPosts <- writeItems cn addPost origPosts
+  newPosts <- writeItems cn P.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.id origPosts) (map P.id newPosts)
-  let cat_id_map = Map.fromList $ zip (map C.id origCats) (map C.id newCats)
+  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)
   postCategories' <- readPostCategories
   let postCategories = correctIds postCategories' post_id_map cat_id_map
   writeItems cn addPostCategory postCategories
 
-  let postUrlMap = Map.fromList $ zip (map (show . P.id) origPosts)
+  let postUrlMap = Map.fromList $ zip (map (show . P.uid) origPosts)
                                       (map makePostUrl newPosts)
-  let categoryUrlMap = Map.fromList $ zip (map (show . C.id) origCats)
+  let categoryUrlMap = Map.fromList $ zip (map (show . C.uid) origCats)
                                           (map makeCategoryUrl newCats)
   createRedirectFile postUrlMap categoryUrlMap
   commit cn