sql.hs

{-# LANGUAGE MultiParamTypeClasses #-}

import Text.Printf

data SQLLiteral
    = SQLFloatLiteral Float
    | SQLIntLiteral Integer
    | SQLStringLiteral String
    deriving (Show, Eq)

data SQLType
    = SQLInt
    | SQLText
    deriving (Show, Eq)

data SQLOperator
    = SQLMul
    | SQLAdd
    | SQLSub
    | SQLEql
    | SQLNegate
    deriving (Show, Eq)

data SQLExpression
    = SQLLiteralExpression SQLLiteral
    | SQLBinaryExpression SQLOperator SQLExpression SQLExpression
    | SQLColumn SQLType String
    deriving (Show, Eq)

data Postgres = Postgres
data SQLite = SQLite


class Dialect d ex where
    compile :: d -> ex -> String
    -- This does not work:
    -- compile d (SQLIntLiteral lit) = "defaultlit " ++ (show lit)

instance Dialect SQLite SQLLiteral where
    compile SQLite (SQLIntLiteral l) = "sqlitelit " ++ (show l)
    compile SQLite (SQLFloatLiteral l) = "sqlitelitf " ++ (show l)

instance Dialect Postgres SQLLiteral where
    compile Postgres (SQLIntLiteral l) = "pglit " ++ (show l)
    -- compile :: Postgres -> SQLExpression -> String

instance Dialect Postgres SQLExpression where
    compile Postgres (SQLLiteralExpression ex) = compile Postgres ex
    compile Postgres (SQLBinaryExpression SQLMul left right) = printf "MULTIPLY(%s, %s)" left' right'
        where
            left' = compile Postgres left
            right' = compile Postgres right

    compile Postgres (SQLBinaryExpression op left right) = left' ++ op' ++ right'
        where
            left' = compile Postgres left
            right' = compile Postgres right
            op' = printf " %s " (show op)

-- (1 + 2) * 3
ex :: SQLExpression
ex = SQLBinaryExpression
        SQLMul
        (SQLBinaryExpression
            SQLAdd
            (SQLLiteralExpression (SQLIntLiteral 1))
            (SQLLiteralExpression (SQLIntLiteral 2))
        )
        (SQLLiteralExpression (SQLIntLiteral 3))