Concurrent Clean : SQLを組み立てる

プログラミング

CleanでSQLの文法を真似した構文で、SQLを動的に組み立てるようなものを作ってみようと思った。特に、何に使うというわけではないが、唐突に。
１０分程度で適当に作ってみた。

Start = sql_select ["col1" @ "t", "col2" @ "s"]
                   ["table1" as "t", "table2" as "s"]
                   ("col1" @ "t" :=: "col3" @ "s" `and` "col2" @ "s" :>: (str "s"))

が

select t.col1, s.col2 from table1 as t, table2 as s where (t.col1 = s.col3 and s.col2 > 's')

になる。
感想は、SQLは構文に統一感がないので、結構ややこしい気がした。SQLに近づけるということをやめれば、もっとスマートにできそうな気がする。
あと、シンプルな識別子は標準ライブラリに取られているので、関数名や演算子名をつけるのに工夫がいる。（クラスになっているものは、インスタンスを作ればいいのだけど）

module Main

import StdEnv

::Relation :== [Term] -> String
::Term = Term String
::Expr = Expr Relation [Term]
       | ExprAnd [Expr]
       | ExprOr  [Expr]
       | ExprNot Expr
::Table = Table String

sql_select :: [Term] [Table] Expr -> String
sql_select terms tables expr
    = "select " +++ select_clause terms +++
      " from " +++ from_clause tables +++
      " where " +++ where_clause expr
  where
    select_clause [] = abort "no column specified"
    select_clause [Term s] = s
    select_clause [Term s:tr] = s +++ ", " +++ select_clause tr

    from_clause [] = abort "no table specified"
    from_clause [Table s] = s
    from_clause [Table s:tr] = s +++ ", " +++ from_clause tr

    where_clause (Expr f ts) = f ts
    where_clause (ExprAnd [e:er]) = foldl (\x y = "(" +++ x +++ " and " +++ where_clause y +++ ")") (where_clause e) er
    where_clause (ExprOr  [e:er]) = foldl (\x y = "(" +++ x +++ " or " +++ where_clause y +++ ")") (where_clause e) er
    where_clause (ExprNot e) = "not (" +++ where_clause e +++ ")"

(:>:) infixl 7
(:>:) x y = Expr f [x,y]
  where
    f [Term a,Term b] = a +++ " > " +++ b

(:=:) infixl 7
(:=:) x y = Expr f [x,y]
  where
    f [Term a, Term b] = a +++ " = " +++ b

(`and`) infixl 4
(`and`) x y = ExprAnd [x,y]

(@) infixl 8
(@) a b = Term (b +++ "." +++ a)

(as) infixl 8
(as) a b = Table (a +++ " as " +++ b)

str s = Term ("'" +++ s +++ "'")

Start = sql_select ["col1" @ "t", "col2" @ "s"]
                   ["table1" as "t", "table2" as "s"]
                   ("col1" @ "t" :=: "col3" @ "s" `and` "col2" @ "s" :>: (str "s"))