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

Update for PrimeRelation.

Browse Source
This commit is contained in:
Kei Hibino 2013-05-11 11:51:15 +09:00
parent 71558e4918
commit 6223573b72
1 changed files with 7 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
relational-join/src/Database/Relational/Query/TH.hs
View File

@ -26,7 +26,7 @@ import Database.Record.TH
(recordTypeDefault, defineRecordDefault, defineHasKeyConstraintInstance) (recordTypeDefault, defineRecordDefault, defineHasKeyConstraintInstance)
import Database.Relational.Query import Database.Relational.Query
(Table, Pi, Relation, fromTable, toSQL, Query, (Table, Pi, Relation, PrimeRelation, fromTable, toSQL, Query,
HasConstraintKey(constraintKey), Primary, NotNull) HasConstraintKey(constraintKey), Primary, NotNull)
import Database.Relational.Query.Constraint (defineConstraintKey, appendConstraint) import Database.Relational.Query.Constraint (defineConstraintKey, appendConstraint)
@ -135,17 +135,18 @@ defineRecordAndTableDefault sqlValueType schema table columns drives = do
return $ recDs ++ tableDs return $ recDs ++ tableDs
inlineQuery :: VarName -> Relation r -> VarName -> TypeQ -> Q [Dec] inlineQuery :: VarName -> PrimeRelation p r -> VarName -> Q [Dec]
inlineQuery relVar' rel qVar' paramType = do inlineQuery relVar' rel qVar' = do
let relVar = varName relVar' let relVar = varName relVar'
qVar = varName qVar' qVar = varName qVar'
relInfo <- reify relVar relInfo <- reify relVar
case relInfo of case relInfo of
VarI _ (AppT (ConT rn) r) _ _ | rn == ''Relation -> do VarI _ (AppT (AppT (ConT prn) p) r) _ _
sig <- sigD qVar [t| Query $(paramType) $(return r) |] | prn == ''PrimeRelation -> do
sig <- sigD qVar [t| Query $(return p) $(return r) |]
var <- valD (varP qVar) var <- valD (varP qVar)
(normalB [| unsafeTypedQuery $(stringE . toSQL $ rel) |]) (normalB [| unsafeTypedQuery $(stringE . toSQL $ rel) |])
[] []
return [sig, var] return [sig, var]
_ -> _ ->
compileError $ "expandRelation: Variable must have Relation type: " ++ show relVar compileError $ "expandRelation: Variable must have PrimeRelation type: " ++ show relVar