在 Haskell 中写一个简单的 SQL DSL

很喜欢 Rails 的 Active Record 风格的查询接口，比如这个

result = viewable_by(user, order: order, preload: preload)
result = by_status(result, status)
result = result.where(id: ids) if ids
result = result.where("reviewables.type = ?", Reviewable.sti_class_for(type).sti_name) if type
result = result.where("reviewables.category_id = ?", category_id) if category_id
result = result.where("reviewables.topic_id = ?", topic_id) if topic_id
result = result.where("reviewables.created_at >= ?", from_date) if from_date
result = result.where("reviewables.created_at <= ?", to_date) if to_date

很好的运用了重绑定的做法，允许根据上下文动态调整查询条件。

在 Haskell 中怎么写呢？尝试了一下。

{-# LANGUAGE NoImplicitPrelude #-}

import Relude

data SqlBuilder = SqlBuilder
  { selects :: [String],
    from :: String,
    joins :: [String],
    wheres :: [String]
  }
  deriving (Show)

prettySql :: SqlBuilder -> String
prettySql builder =
  "SELECT "
    ++ intercalate ", " (selects builder)
    ++ "\n  FROM "
    ++ from builder
    ++ ( if null (joins builder)
           then ""
           else
             "\n  JOIN "
               ++ intercalate "\n  JOIN " (joins builder)
       )
    ++ ( if null . wheres $ builder
           then ""
           else
             "\n WHERE " ++ intercalate "\n       AND " (reverse . wheres $ builder)
       )

where_ :: String -> SqlBuilder -> SqlBuilder
where_ condition builder = builder {wheres = condition : wheres builder}

join_ :: String -> SqlBuilder -> SqlBuilder
join_ condition builder = builder {joins = condition : joins builder}

selectFrom :: [String] -> String -> SqlBuilder
selectFrom columns from =
  SqlBuilder
    { selects = columns,
      from = from,
      joins = [],
      wheres = []
    }

might :: (a -> SqlBuilder -> SqlBuilder) -> Maybe a -> SqlBuilder -> SqlBuilder
might _ Nothing builder = builder
might f (Just x) builder = f x builder

list :: (Show a) => [a] -> String
list items = "(" ++ intercalate ", " (map show items) ++ ")"

main = do
  putStrLn $ prettySql query
  where
    ids = Just [1, 2, 3]
    typ = Just "miao"
    category_id = Nothing :: Maybe Int
    topic_id = Just 1234
    from_date = Just "2023-01-01"
    to_date = Nothing :: Maybe String

    query =
      selectFrom ["name", "age", "id"] "users"
        & join_ "profiles ON users.id = profiles.user_id"
        & where_ "age > 18"
        & might where_ (("id IN " ++) . list <$> ids)
        & might where_ (("type = " ++) . show <$> typ)
        & might where_ (("category_id = " ++) . show <$> category_id)
        & might where_ (("good_topic_id = " ++) . show <$> topic_id)
        & might where_ (("created_at >= " ++) . show <$> from_date)
        & might where_ (("created_at <= " ++) . show <$> to_date)

输出结果：

SELECT name, age, id
  FROM users
  JOIN profiles ON users.id = profiles.user_id
 WHERE age > 18
       AND id IN (1, 2, 3)
       AND type = "miao"
       AND good_topic_id = 1234
       AND created_at >= "2023-01-01"

（当然，没考虑安全性，这只是一个为了测试 haskell 能不能写出类似 ruby 那样优雅的查询代码的例子）