Commits

Luke Plant committed 0b92b6b

Added some type signatures, and pulled some DB functions out into DBUtils

  • Participants
  • Parent commits b28e49c

Comments (0)

Files changed (2)

src/Blog/DBUtils.hs

-module Blog.DBUtils where
+module Blog.DBUtils ( makeSlugGeneric
+                    , slugFromTitle
+                    , getDbId
+                    , sqlInIds
+                    , pagedQuery
+                    )
+
+where
 
 import Blog.Utils (regexReplace)
 import Database.HDBC
 import GHC.Unicode (toLower)
 import qualified Data.ByteString.Lazy.Char8 as BL
+import qualified Data.List as List
 
 slugFromTitle title = map toLower $ BL.unpack $
                       regexReplace (BL.pack "-+$") (BL.pack "") $
  where
    makeSuffix 1 = ""
    makeSuffix n = show n
+
+getDbId :: (IConnection conn, SqlType a) => conn -> IO a
+getDbId cn =
+    do
+      [[newid]] <- quickQuery' cn "SELECT last_insert_rowid();" []
+      return $ fromSql newid
+
+-- SQL stuff
+sqlInIds :: [Int] -> String
+sqlInIds ids = "(" ++ (concat $ List.intersperse "," $ map show ids) ++ ")"
+
+addLimitOffset sql limitOffset =
+    BL.unpack $ regexReplace (" \\$LIMITOFFSET") (BL.pack $ " " ++ limitOffset) (BL.pack sql)
+
+-- return 'LIMIT/OFFSET' for a page (1 indexed), with an extra row
+-- which allows us to tell if there are more records
+makePagingLimitOffset page size =
+    let limit = size + 1
+        offset = (page - 1) * size
+    in "LIMIT " ++ (show limit) ++ " OFFSET " ++ (show offset)
+
+-- | Get a page of results, and a boolean which is True if there are more rows
+--
+-- The query must contain "$LIMITOFFSET" in an appropriate place to be replaced
+-- with the actual limit/offset clause
+pagedQuery :: (IConnection conn) =>
+              conn -> [Char] -> [SqlValue] -> Int -> Int -> IO ([[SqlValue]], Bool)
+pagedQuery cn sql params page pagesize =
+    let limitOffset = makePagingLimitOffset page pagesize
+        q = addLimitOffset sql limitOffset
+    in do
+      res <- quickQuery' cn q params
+      let (recs,rest) = splitAt pagesize res
+      return (recs, not $ null rest)

src/Blog/Model.hs

                   ) where
 
 import Database.HDBC
-import Blog.DBUtils (makeSlugGeneric)
+import Blog.DBUtils (makeSlugGeneric, pagedQuery, sqlInIds, getDbId)
 import Blog.Utils (regexReplace)
 import qualified Blog.DB as DB
 import qualified Blog.Post as P
 import qualified Blog.Category as Ct
 import qualified Blog.Comment as Cm
-import qualified Data.List as List
 import qualified Data.ByteString.Lazy.Char8 as BL
 
 ------ 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" [
 getCommentsForPostQuery  = "SELECT id, '',      timestamp, name, email, '',       text_formatted, ''        FROM comments WHERE post_id = ? ORDER BY timestamp ASC;"
 
 
--- SQL stuff
-sqlInIds :: [Int] -> String
-sqlInIds ids = "(" ++ (concat $ List.intersperse "," $ map show ids) ++ ")"
-
-addLimitOffset sql limitOffset =
-    BL.unpack $ regexReplace (" \\$LIMITOFFSET") (BL.pack $ " " ++ limitOffset) (BL.pack sql)
-
--- return 'LIMIT/OFFSET' for a page (1 indexed), with an extra row
--- which allows us to tell if there are more records
-makePagingLimitOffset page size =
-    let limit = size + 1
-        offset = (page - 1) * size
-    in "LIMIT " ++ (show limit) ++ " OFFSET " ++ (show offset)
-
--- | Get a page of results, and a boolean which is True if there are more rows
---
--- The query must contain "$LIMITOFFSET" in an appropriate place to be replaced
--- with the actual limit/offset clause
-pagedQuery cn sql params page pagesize =
-    let limitOffset = makePagingLimitOffset page pagesize
-        q = addLimitOffset sql limitOffset
-    in do
-      res <- quickQuery' cn q params
-      let (recs,rest) = splitAt pagesize res
-      return (recs, not $ null rest)
 
 ---- Constructors ----
 
 
 ---- Public API for queries ----
 
+getPostBySlug :: (SqlType a, IConnection conn) => conn -> a -> IO (Maybe P.Post)
 getPostBySlug cn slug = do
   res <- quickQuery' cn getPostBySlugQuery [toSql slug]
   case res of
     [] -> return Nothing
     (postdata:_) -> return $ Just $ makePost postdata
 
+getRecentPosts :: (IConnection conn) => conn -> Int -> IO ([P.Post], Bool)
 getRecentPosts cn page = do
   (res,more) <- pagedQuery cn getRecentPostsQuery [] page 20
   return (map makePost res, more)
 
+getCategoriesForPost :: (IConnection conn) => conn -> P.Post -> IO [Ct.Category]
 getCategoriesForPost cn post = do
   res <- quickQuery' cn getCategoriesForPostQuery [toSql $ P.uid post]
   return $ map makeCategory res
 
+getCommentsForPost :: (IConnection conn) => conn -> P.Post -> IO [Cm.Comment]
 getCommentsForPost cn post = do
   res <- quickQuery' cn getCommentsForPostQuery [toSql $ P.uid post]
   return $ map makeComment res
 
+getRelatedPosts :: (IConnection conn) =>
+                   conn -> P.Post -> [Ct.Category] -> IO [P.Post]
 getRelatedPosts cn post categories = do
   let ids = map (Ct.uid) categories
   (res,_) <- pagedQuery cn (getRelatedPostsQuery ids) [ toSql $ P.uid post