khibino/haskell-relational-record
1
1
Fork 0
mirror of https://github.com/khibino/haskell-relational-record.git synced 2025-01-05 20:04:49 +03:00
Code Issues Projects Releases Wiki Activity

Update sepBy combinators.

Browse Source
This commit is contained in:
Kei Hibino 2013-03-29 14:14:33 +09:00
parent 719180e268
commit ddcd62ade1
2 changed files with 9 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
schema-th/src/Database/HDBC/TH.hs
View File

@ -1,4 +1,5 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
@ -334,7 +335,7 @@ defineSqlPrimarySelect name' (table, recordType) fields pkey =
defineConstantSqlQuery pkeyType recordType name'
. SQL.unwordsSQL
$ [SELECT, fields' `SQL.sepBy` ", ",
FROM, SQL.word table, WHERE, SQL.word pkey <=> SQL.word "?"]
FROM, SQL.word table, WHERE, SQL.word pkey <=> "?"]
where fields' = map (SQL.word . fst) fields
pkeyType = fromJust $ lookup pkey fields
@ -343,8 +344,8 @@ defineSqlPrimaryUpdate name' table fields pkey =
defineConstantSql name'
. SQL.unwordsSQL
$ [UPDATE, SQL.word table, SET, assignments `SQL.sepBy` ", ",
WHERE, SQL.word pkey, SQL.word "= ?"]
where assignments = map (\f -> SQL.word f <=> SQL.word "?") . filter (/= pkey) $ fields
WHERE, SQL.word pkey, "= ?"]
where assignments = map (\f -> SQL.word f <=> "?") . filter (/= pkey) $ fields
defineSqlInsert :: VarName -> String -> [String] -> Q [Dec]
defineSqlInsert name' table fields = do
@ -353,7 +354,7 @@ defineSqlInsert name' table fields = do
$ [INSERT, INTO, SQL.word table, fields' `SQL.parenSepBy` ", ",
VALUES, pfs `SQL.parenSepBy` ", "]
where fields' = map SQL.word fields
pfs = replicate (length fields) (SQL.word "?")
pfs = replicate (length fields) "?"
defineSqls :: VarName -- ^ SQL insert statement var name
-> (String, TypeQ)

8
schema-th/src/Language/SQL/SqlWord.hs
View File

@ -69,8 +69,8 @@ wordShow = d where
d (Sequence s) = s
d w = show w
sepBy' :: [SqlWord] -> String -> [String]
ws `sepBy'` d = intersperse d $ map wordShow ws
sepBy' :: [SqlWord] -> SqlWord -> [String]
ws `sepBy'` d = map wordShow . intersperse d $ ws
unwordsSQL :: [SqlWord] -> String
unwordsSQL = unwords . map wordShow
@ -81,10 +81,10 @@ unwordsSQL = unwords . map wordShow
concat' :: [String] -> SqlWord
concat' = word . concat
sepBy :: [SqlWord] -> String -> SqlWord
sepBy :: [SqlWord] -> SqlWord -> SqlWord
ws `sepBy` d = concat' $ ws `sepBy'` d
parenSepBy :: [SqlWord] -> String -> SqlWord
parenSepBy :: [SqlWord] -> SqlWord -> SqlWord
ws `parenSepBy` d = concat' $ "(" : (ws `sepBy'` d) ++ [")"]
(<.>) :: SqlWord -> SqlWord -> SqlWord