on master help sign in
WIP count implemented
commit5e4b9b8cfcace4db941d984b1518648d61cfc1b3 authorAgentM <agentm@Tatyanas-MacBook.local> dateTue 15 Sep 2015, 14:38 (11 years ago) parent75c4f08
1 file changed+32−2
Database/Persist/ProjectM36.hs+32−2
Database/Persist/ProjectM36.hs+32−2
@@ -28,6 +28,7 @@ import qualified Database.Persist.Sql as Sql
2828import Control.Monad.Trans.Either
2929import Database.Persist.Class
3030import qualified Database.Persist.Types as DPT
31+import qualified Data.Set as S
3132
3233type ProjectM36Backend = C.Connection
3334
@@ -416,6 +417,7 @@ filterAsRestrictionPredicate :: (PersistEntity val, PersistEntityBackend val ~ C
416417filterAsRestrictionPredicate filter = case filter of
417418 FilterAnd filters -> multiFilterAsRestrictionPredicate True filters
418419 FilterOr filters -> multiFilterAsRestrictionPredicate False filters
420+ BackendFilter _ -> error "BackendFilter not supported"
419421 Filter field value pfilter -> let attrName = unDBName $ fieldDB (persistFieldDef field) in
420422 case value of
421423 Left val -> case pfilter of
@@ -428,6 +430,7 @@ filterAsRestrictionPredicate filter = case filter of
428430 Right vals -> Left $ AtomTypeNotSupported attrName
429431
430432updateToUpdateTuple :: (PersistEntity val, PersistEntityBackend val ~ C.Connection) => DPT.Update val -> Either RelationalError (AttributeName, Atom)
433+updateToUpdateTuple (BackendUpdate _) = error "BackendUpdate not supported"
431434updateToUpdateTuple up@(DPT.Update field value op) = let entDef = entityDef $ dummyFromUpdate up
432435 attrName = unDBName $ fieldDB (persistFieldDef field)
433436 atom = persistValueAtom $ toPersistValue value
@@ -468,5 +471,32 @@ instance PersistQuery C.Connection where
468471 Just err -> left err
469472 Nothing -> right ()
470473 case e of
471− Left err -> Trans.liftIO $ throwIO $ PersistError "updateWhere pooped"
472− Right () -> return ()
474+ Left err -> Trans.liftIO $ throwIO $ PersistError "deleteWhere pooped"
475+ Right () -> return ()
476+
477+ count filters = do
478+ conn <- ask
479+ e <- runEitherT $ do
480+ restrictionPredicate <- hoistEither $ multiFilterAsRestrictionPredicate True filters
481+ let entDef = entityDef $ dummyFromFilters filters
482+ relVarName = unDBName $ entityDB entDef
483+ allAttrNamesList = map (unDBName . fieldDB) (entityFields entDef)
484+ allAttrNames = AttributeNames $ S.fromList allAttrNamesList
485+ groupExpr = Group allAttrNames "persistcountrel" (RelationVariable relVarName)
486+ tupleExpr = AttributeTupleExpr "persistcount" (FunctionAtomExpr "count" [AttributeAtomExpr "persistcountrel"])
487+ countExpr = Extend tupleExpr groupExpr
488+ rel <- Trans.liftIO $ C.executeRelationalExpr conn countExpr
489+ case rel of
490+ Left err -> left err
491+ Right rel' -> case singletonTuple rel' of
492+ Nothing -> Trans.liftIO $ throwIO $ PersistError "failed to get count tuple"
493+ Just tuple -> case atomForAttributeName "persistcount" tuple of
494+ (Right (IntAtom c)) -> return c
495+ Right _ -> Trans.liftIO $ throwIO $ PersistError "count returned wrong data type"
496+ Left err -> left err
497+ case e of
498+ Left err -> Trans.liftIO $ throwIO $ PersistError "count pooped"
499+ Right c -> return c
500+
501+ selectSourceRes = undefined
502+ selectKeysRes = undefined