Source

haskellblog / src / Blog / DB.hs

module Blog.DB ( connect
               , commit
               , doInsert
               , mkInsertStatement
               , doUpdate
               , mkUpdateStatement
               , doDelete
               )
where

import Database.HDBC (run, prepare, execute, commit, rollback, finish, SqlError(..), catchSql, throwSqlError)
import Database.HDBC.Sqlite3 (connectSqlite3)
import Data.List
import Data.Maybe (fromMaybe)

import Ella.GenUtils (exactParse)
import qualified Blog.Settings as Settings

connect = connectSqlite3 Settings.sqlite_path

doSql conn sql values = do
    stmnt <- prepare conn sql
    catchSql (do
               execute stmnt values
               commit conn
             )
              (\ e1@(SqlError s1 sne1 m1) -> do
                 rollback conn
                 finish stmnt
               `catchSql` \e2@(SqlError s2 sne2 m2) ->
                   throwSqlError SqlError { seState = s1, seNativeError = sne1,
                                            seErrorMsg = "Part 1: " ++ m1 ++
                                                         "; Part 2: " ++ m2 }
              )

doInsert conn table columns values =
    let sql = mkInsertStatement table columns
    in doSql conn sql values

doUpdate conn table columns values whereClause whereClauseVals =
    let sql = mkUpdateStatement table columns
    in doSql conn (sql ++ " " ++ whereClause ++ ";") (values ++ whereClauseVals)

doDelete conn table whereClause whereClauseVals =
    doSql conn ("DELETE FROM " ++ table ++ " " ++ whereClause ++ ";") whereClauseVals

mkInsertStatement table columns = let joinC = concat . intersperse ", "
                                      colSql = joinC columns
                                      valSql = joinC $ take (length columns) $ repeat "?"
                                   in "INSERT INTO " ++ table ++ 
                                      " (" ++ colSql ++ ")" ++
                                      " VALUES " ++
                                      " (" ++ valSql ++ ");"

mkUpdateStatement table columns = let joinC = concat . intersperse ", "
                                      valSql = joinC $ [c ++ "=?" | c <- columns]
                                  in "UPDATE " ++ table ++
                                     " SET " ++ valSql
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.