QueryWriter.hs

{- |
   Module     : Database.SQLDeps.QueryWriter
   Copyright  : Copyright (C) 2013 Alexander Thiemann
   License    : BSD3

   Maintainer : Alexander Thiemann <mail@agrafix.net>
   Stability  : provisional
   Portability: portable

Helper module to generate prepared statements from SQLDeps.Types types
-}
module Database.SQLDeps.QueryWriter where

import Database.SQLDeps.Types
import Database.HDBC
import Data.List

fName :: FieldName -> String
fName (tbl, field) = tbl ++ "." ++ field

fFilter :: Filter -> String
fFilter (LargerThan f _) = fName f ++ " > ?"
fFilter (SmallerThan f _) = fName f ++ " < ?"
fFilter (EqualTo f _) = fName f ++ " = ?"

vVal :: FieldVal -> SqlValue
vVal (IntVal i) = toSql i
vVal (StrVal s) = toSql s

vFilter :: Filter -> SqlValue
vFilter (LargerThan _ v) = vVal v
vFilter (SmallerThan _ v) = vVal v
vFilter (EqualTo _ v) = vVal v

class QueryWriter a where
    preparedStmt :: a -> (String, [SqlValue])

instance QueryWriter Upsert where
    preparedStmt (Update table fieldVals filters) =
        (q, vals' ++ vals'')
        where
          vals' = map (vVal . snd) fieldVals
          vals'' = map vFilter filters
          q = "UPDATE " ++ table ++ " SET " ++ ups ++ " "
              ++ (if length filters /= 0 then whereC else "")
          whereC = " WHERE " ++ (intercalate " AND " $ map fFilter filters)
          ups = intercalate ", " (map (\(name, _) -> snd name ++ " = ?") fieldVals)

    preparedStmt (Insert table fieldVals) =
        (q, vals)
        where
          vals = map (vVal . snd) fieldVals
          q = "INSERT INTO " ++ table ++ " ("
              ++ (intercalate ", " $ map (snd . fst) fieldVals) ++ ") VALUES ( "
              ++ (intercalate ", " $ replicate (length fieldVals) "?") ++ ")"

instance QueryWriter Select where
    preparedStmt (Select fields table filters) =
        (q, vals)
        where
          vals = map vFilter filters
          q = "SELECT " ++ (intercalate ", " $ map fName fields) ++ " FROM "
              ++ (intercalate ", " table)
              ++ (if length filters /= 0 then whereC else "")
          whereC = " WHERE " ++ (intercalate " AND " $ map fFilter filters)