haskellpostgresql-simple

How do I deal with arbitrary length tuple to build up a complex SQL query for Haskell's postgresql-simple's query function?


https://hackage.haskell.org/package/postgresql-simple-0.7.0.0/docs/Database-PostgreSQL-Simple.html#v:query

query :: (ToRow q, FromRow r) => Connection -> Query -> q -> IO [r]

The challenge I'm having with query is the q parameter which can somehow magically accept any length of tuple ((a,b) or (a,b,c,d,e,...) etc).

I am trying to implement a function that builds up a complex sql query, for example lets say based on includeLarger = Just 123, we want to add where value => ? to the sql query (parameterized sql), but there could be multiple of these 'filters'.

For the SQL query we can easily append this to a string where we later convert to Query with fromString. But for the postgresql-simple parametized value I don't see how to "build up" this q parameter. I can't make it a list because the values might be of different types.

query connection (fromString ("SELECT * FROM example WHERE " ++ f)) undefined

So if I really wanted to use this approach I'd have to keep track of how many values I need to pass for q, but this becomes incredibly cumbersome and error prone because I think it grows combinatorially (see example code below).

Is this just an unfortunate limitation of how postgresql-simple is designed or is there solution to this?

{-# LANGUAGE OverloadedStrings #-}

module Main where

import Database.PostgreSQL.Simple
import Data.String (fromString)

connectDB :: IO Connection
connectDB = connect defaultConnectInfo
  { connectUser = "postgres"
  , connectPassword = "example"
}

runQuery :: Connection -> Bool -> Bool -> Bool -> IO ()
runQuery conn useF1 useF2 useF3 = do
    let f1 = "id = ?"
    let f2 = "name = ?"
    let f3 = "age = ?"

    let v1 = 1 :: Int
    let v2 = "Chris" :: String
    let v3 = 30  :: Int

    if useF1 && not useF2 && not useF3
    then
        query conn (fromString $ "SELECT * FROM (VALUES (1, 'Chris', 25)) AS t (id, name, age) WHERE " ++ f1) (Only v1) >>= printResult
    else if useF1 && useF2 && not useF3
    then
        query conn (fromString $ "SELECT * FROM (VALUES (1, 'Chris', 25)) AS t (id, name, age) WHERE " ++ f1 ++ " AND " ++ f2) (v1, v2) >>= printResult
    else if useF1 && not useF2 && useF3
    then
        query conn (fromString $ "SELECT * FROM (VALUES (1, 'Chris', 25)) AS t (id, name, age) WHERE " ++ f1 ++ " AND " ++ f3) (v1, v3) >>= printResult
    else if not useF1 && useF2 && not useF3
    then
        query conn (fromString $ "SELECT * FROM (VALUES (1, 'Chris', 25)) AS t (id, name, age) WHERE " ++ f2) (Only v2) >>= printResult
    else if not useF1 && useF2 && useF3
    then
        query conn (fromString $ "SELECT * FROM (VALUES (1, 'Chris', 25)) AS t (id, name, age) WHERE " ++ f2 ++ " AND " ++ f3) (v2, v3) >>= printResult
    else if useF1 && useF2 && useF3
    then
        query conn (fromString $ "SELECT * FROM (VALUES (1, 'Chris', 25)) AS t (id, name, age) WHERE " ++ f1 ++ " AND " ++ f2 ++ " AND " ++ f3) (v1, v2, v3) >>= printResult
    else if not useF1 && not useF2 && useF3
    then
        query conn (fromString $ "SELECT * FROM (VALUES (1, 'Chris', 25)) AS t (id, name, age) WHERE " ++ f3) (Only v3) >>= printResult
    else
        putStrLn "No filters applied."

printResult :: [(Int, String, Int)] -> IO ()
printResult = mapM_ print

main :: IO ()
main = do
    conn <- connectDB
    putStrLn "Running query with f1 and f2..."
    runQuery conn True True False
    putStrLn "Running query with f1 and f3..."
    runQuery conn True False True
    putStrLn "Running query with f2 and f3..."
    runQuery conn False True True
    putStrLn "Running query with only f3..."
    runQuery conn False False True
    putStrLn "Running query with all filters..."
    runQuery conn True True True
    putStrLn "Running query with no filters..."
    runQuery conn False False False

Solution

  • Well, just don't use a Tuple. It's the wrong type to use if you don't know in advance how many elements you need. The *-simple libraries have a ToField a => ToRow [a] instance for this purpose. The other part of the puzzle is that the result of toField itself has a ToField instance, meaning we can use a list of those for heterogenous rows.

    This means you can build up a list of fragments like name = ?, age = ? and so on along with the parameters for those toField user.name, toField user.age and so on and combine these to form a larger query.

    Here is an example (using sqlite-simple instead of postgresql-simple because I don't have postgres installed on this machine, but the APIs are very similar so the only real difference is that the SQLData type I'm referring to in the following code snippet is called Action in postgresql-simple):

    What we want is to be able to look up users by various attributes (using just equality to keep it simple for now):

     findUser db [ByAge 4]
     findUser db [ByName "Alpha", ByAge 4]
     findUser db [ById 1]
    

    where findUser is the function doing the querying and the ByUser and so on are just identifying the things we're trying to look up:

    data FindUser = ByName String | ByAge Int | ById Int
    findUser :: SQL.Connection -> [FindUser] -> IO [(Int, String, Int)]
    

    To turn our FindUsers into usable fragments, we define a helper:

    toFragment (ByName n) = ("name = ?", SQL.toField n)
    toFragment (ByAge a) = ("age = ?", SQL.toField a)
    toFragment (ById i) = ("id = ?", SQL.toField i)
    

    We can then use these in another helper to combine these to an actual query + list of parameters:

    -- reminder: SQL.SQLData here is called SQL.Action in postgresql-simple!
    findUserQ :: [FindUser] -> (SQL.Query, [SQL.SQLData])
    findUserQ byAttrs = case map toFragment byAttrs of
      -- handle the edge case of not filtering for anything
      [] -> ("SELECT id, name, age FROM users", [])
      -- otherwise just AND our query fragments and remember the parameters
      fragments -> (fromString $ "SELECT id, name, age FROM users WHERE "
              <> intercalate " AND " (map fst fragments)
            , map snd fragments)
    

    and then our findUser is simply applying the query to the parameters:

    findUser :: SQL.Connection -> [FindUser] -> IO [(Int, String, Int)]
    findUser db fu = uncurry (SQL.query db) $ findUserQ f
    

    Note

    Of course you could relatively easily extend this to be much more flexible (like allowing different types of where conditions, allowing nested AND/OR groups and so on). Worth noting here that there already are query builder libraries like esqueleto that do more-or-less this with different tradeoffs like being more typesafe or having a more convenient API in exchange for being more complicated / needing your data to be described in a particular way and so on, so if you find yourself often having to construct queries dynamically like this I'd encourage you to look into those.

    Full example

    {-# LANGUAGE GHC2021 #-}
    {-# LANGUAGE OverloadedStrings #-}
    module Main (main) where
    
    import Control.Monad (forM_)
    import Database.SQLite.Simple qualified as SQL
    import Database.SQLite.Simple.ToField qualified as SQL
    import Data.String (IsString(..))
    import Data.List(intercalate)
    
    data FindUser = ByName String | ByAge Int | ById Int
    
    findUserQ :: [FindUser] -> (SQL.Query, [SQL.SQLData])
    findUserQ byAttrs = case map toFragment byAttrs of
      -- handle the edge case of not filtering for anything
      [] -> ("SELECT id, name, age FROM users", [])
      -- otherwise just AND our query fragments and remember the parameters
      as -> (fromString $ "SELECT id, name, age FROM users WHERE "
              <> intercalate " AND " (map fst as)
            , map snd as)
    
    findUser :: SQL.Connection -> [FindUser] -> IO [(Int, String, Int)]
    findUser db fu = uncurry (SQL.query db) $ findUserQ fu
    
    toFragment (ByName n) = ("name = ?", SQL.toField n)
    toFragment (ByAge a) = ("age = ?", SQL.toField a)
    toFragment (ById i) = ("id = ?", SQL.toField i)
    
    main :: IO ()
    main = do
      db <- SQL.open ":memory:"
      SQL.execute_ db "CREATE TABLE users(id INTEGER PRIMARY KEY, name TEXT, age INTEGER)"
      forM_ [("Alpha", 9), ("Beta", 23), ("Alpha", 4), ("Beta", 4)] $
        SQL.execute @(String,Int) db "INSERT INTO users (name,age) VALUES (?,?)"
      findUser db [ByAge 4] >>= print
      findUser db [ByName "Alpha", ByAge 4] >>= print
      findUser db [ById 1] >>= print