bitemyapp / esqueleto

New home of Esqueleto, please file issues so we can get things caught up!
BSD 3-Clause "New" or "Revised" License
370 stars 107 forks source link

a monad for sqlexpr #264

Open parsonsmatt opened 3 years ago

parsonsmatt commented 3 years ago

thinking that it'd be nice to have a monad for SqlExpr to make it a bit easier and clearer how to write code with it

newtype SqlExprM a = SqlExprM (ReaderT NeedsParens (ReaderT IdentInfo (Writer (TLB.Builder, [PersistValue])) a)

unSqlExprM :: SqlExprM () -> NeedsParens -> IdentInfo -> (TLB.Builder, [PersistValue])
unSqlExprM (SqlExprM expr) np ident = 
    execWrtier $ runReaderT (runReaderT expr np) ident

instance (a ~ ()) => IsString (SqlExprM a) where
    fromString str = tell (fromString str, []) 

param :: (PersistField a) => a -> SqlExprM ()
param a = tell ("?", [toPersistValue a])

This makes it much easier to write raw SQL expressions. Taking the example from the Finally Tagless blog post, we could write:

bool :: Bool -> SqlExpr Bool
bool b = param b

int :: Int -> SqlExpr Int
int i = param i

paren :: SqlExpr a -> SqlExpr a
paren = local (\_ -> True)

leq :: SqlExpr Int -> SqlExpr Int -> SqlExpr Bool
leq e1 e2 = do
    paren e1
    " <= "
    paren e2

and_ :: SqlExpr Bool -> SqlExpr Bool -> SqlExpr Bool
and_ e1 e2 = do
    paren e1
    " AND "
    paren e2

binop :: Builder -> SqlExpr a -> SqlExpr b -> SqlExpr c
binop op e1 e2 = do
    paren e1
    " "
    tell (op, [])
    " "
    paren e2

or_ :: SqlExpr Bool -> SqlExpr Bool -> SqlExpr Bool
or_ = binop "OR"

op :: Builder -> SqlExpr a -> SqlExpr b
op x a =
    tell (x, [])
    " "
    a 

not_ :: SqlExpr Bool -> SqlExpr Bool 
not_ = op "NOT"

where_ :: SqlExpr Bool -> (Builder, [PersistValue])
where_ e =
    unSqlExprM e False

Needs some work to get the types to check but overall may be a nice UX improvement

belevy commented 3 years ago

I believe (->) already admits MonadReader. Just uncurry the function. tell would need to be manually lifted using const. I however don't feel that the code this leads to is particularly clear. Is there something I'm missing?