groundhog 0.4.0.1 → 0.4.0.2
raw patch · 4 files changed
+29/−22 lines, 4 filesdep ~base
Dependency ranges changed: base
Files
- Database/Groundhog/Core.hs +2/−2
- Database/Groundhog/Generic/PersistBackendHelpers.hs +24/−18
- Database/Groundhog/Generic/Sql.hs +2/−1
- groundhog.cabal +1/−1
Database/Groundhog/Core.hs view
@@ -121,9 +121,9 @@ data Unique (u :: (* -> *) -> *) -- | Key marked with this type can have value for any backend data BackendSpecific--- | A phantom datatype to make instance head diffirent @c (ConstructorMarker v)@+-- | A phantom datatype to make instance head different @c (ConstructorMarker v)@ data ConstructorMarker v a--- | A phantom datatype to make instance head diffirent @u (UniqueMarker v)@+-- | A phantom datatype to make instance head different @u (UniqueMarker v)@ data UniqueMarker v a -- | It allows to store autogenerated keys of one database in another
Database/Groundhog/Generic/PersistBackendHelpers.hs view
@@ -50,9 +50,9 @@ case x of Just [discr] -> do let constructorNum = fromPrimitivePersistValue proxy discr- let constr = constructors e !! constructorNum- let fields = renderFields escape (constrParams constr)- let cQuery = "SELECT " <> fields <> " FROM " <> tableName escape e constr <> " WHERE " <> fromJust (constrId escape constr) <> "=?"+ constr = constructors e !! constructorNum+ fields = renderFields escape (constrParams constr)+ cQuery = "SELECT " <> fields <> " FROM " <> tableName escape e constr <> " WHERE " <> fromJust (constrId escape constr) <> "=?" x2 <- queryFunc cQuery (getConstructorTypes constr) [toPrimitivePersistValue proxy k] id case x2 of Just xs -> liftM (Just . fst) $ fromEntityPersistValues $ discr:xs@@ -102,13 +102,17 @@ proxy = undefined :: Proxy (PhantomDb m) getBy :: forall m v u . (PersistBackend m, PersistEntity v, IsUniqueKey (Key v (Unique u)))- => (Utf8 -> Utf8) -> (forall a . Utf8 -> [DbType] -> [PersistValue] -> (RowPopper m -> m a) -> m a) -> Key v (Unique u) -> m (Maybe v)-getBy escape queryFunc (k :: Key v (Unique u)) = do+ => (Utf8 -> Utf8) -- ^ escape+ -> (forall a . Utf8 -> [DbType] -> [PersistValue] -> (RowPopper m -> m a) -> m a) -- ^ function to run query+ -> Utf8 -- ^ condition to compare with constant+ -> Key v (Unique u)+ -> m (Maybe v)+getBy escape queryFunc equalsTo (k :: Key v (Unique u)) = do uniques <- toPersistValues k let e = entityDef (undefined :: v) u = (undefined :: Key v (Unique u) -> u (UniqueMarker v)) k- uFields = (renderChain escape $ fieldChain u) []- cond = intercalateS " AND " $ map (<> "=?") uFields+ uFields = renderChain escape (fieldChain u) []+ cond = intercalateS " AND " $ map (<> equalsTo) uFields constr = head $ constructors e fields = renderFields escape (constrParams constr) query = "SELECT " <> fields <> " FROM " <> tableName escape e constr <> " WHERE " <> cond@@ -131,7 +135,6 @@ (l, o) -> (" LIMIT ? OFFSET ?", [toPrimitivePersistValue proxy l, toPrimitivePersistValue proxy o]) cond' = renderCond' cond chains = projectionExprs p []--- fields = intercalateS (fromChar ',') $ foldr (renderChain escape) [] chains RenderS fields fieldVals = intercalateS (fromChar ',') $ concatMap (renderExprExtended escape 0) chains query = "SELECT " <> fields <> " FROM " <> tableName escape e constr <> whereClause <> orders <> lim whereClause = maybe "" (\c -> " WHERE " <> getQuery c) cond'@@ -220,24 +223,25 @@ else "DELETE FROM " <> mainTableName escape e <> " WHERE id IN(SELECT " <> fromJust (constrId escape constr) <> " FROM " <> tableName escape e constr <> whereClause <> ")" insertByAll :: forall m v . (PersistBackend m, PersistEntity v)- => (Utf8 -> Utf8) -> (forall a . Utf8 -> [DbType] -> [PersistValue] -> (RowPopper m -> m a) -> m a)+ => (Utf8 -> Utf8) -- ^ escape+ -> (forall a . Utf8 -> [DbType] -> [PersistValue] -> (RowPopper m -> m a) -> m a) -- ^ function to run query+ -> Utf8 -- ^ condition to compare with constant -> v -> m (Either (AutoKey v) (AutoKey v))-insertByAll escape queryFunc v = do+insertByAll escape queryFunc equalsTo v = do let e = entityDef v proxy = undefined :: Proxy (PhantomDb m) (constructorNum, uniques) = getUniques proxy v constr = constructors e !! constructorNum uniqueDefs = constrUniques constr- cond = intercalateS " OR " $ map (intercalateS " AND " . map (\(fname, _) -> escape (fromString fname) <> "=?")) $ map (\(UniqueDef _ _ fields) -> fields) uniqueDefs if null uniques then liftM Right $ Core.insert v else do- let query = "SELECT " <> maybe "1" id (constrId escape constr) <> " FROM " <> tableName escape e constr <> " WHERE " <> cond+ let cond = intercalateS " OR " $ map (intercalateS " AND " . foldr (flatten $ \x -> escape x <> equalsTo) [] . uniqueFields) uniqueDefs+ query = "SELECT " <> maybe "1" id (constrId escape constr) <> " FROM " <> tableName escape e constr <> " WHERE " <> cond x <- queryFunc query [dbInt64] (foldr ((.) . snd) id uniques []) id case x of- Nothing -> liftM Right $ Core.insert v- Just [k] -> return $ Left $ fst $ fromPurePersistValues proxy [k]- Just xs -> fail $ "unexpected query result: " ++ show xs+ Nothing -> liftM Right $ Core.insert v+ Just xs -> return $ Left $ fst $ fromPurePersistValues proxy xs deleteByKey :: forall m v . (PersistBackend m, PersistEntity v, PrimitivePersistField (Key v BackendSpecific)) => (Utf8 -> Utf8) -> (Utf8 -> [PersistValue] -> m ()) -> Key v BackendSpecific -> m ()@@ -264,14 +268,16 @@ Nothing -> fail $ "COUNT returned no rows" insertBy :: forall m v u . (PersistBackend m, PersistEntity v, IsUniqueKey (Key v (Unique u)))- => (Utf8 -> Utf8) -> (forall a . Utf8 -> [DbType] -> [PersistValue] -> (RowPopper m -> m a) -> m a)+ => (Utf8 -> Utf8)+ -> (forall a . Utf8 -> [DbType] -> [PersistValue] -> (RowPopper m -> m a) -> m a)+ -> Utf8 -> u (UniqueMarker v) -> v -> m (Either (AutoKey v) (AutoKey v))-insertBy escape queryFunc u v = do+insertBy escape queryFunc equalsTo u v = do uniques <- toPersistValues $ (extractUnique v `asTypeOf` ((undefined :: u (UniqueMarker v) -> Key v (Unique u)) u)) let e = entityDef v proxy = undefined :: Proxy (PhantomDb m) uFields = (renderChain escape $ fieldChain u) []- cond = intercalateS " AND " $ map (<> "=?") uFields+ cond = intercalateS " AND " $ map (<> equalsTo) uFields -- this is safe because unique keys exist only for entities with one constructor constr = head $ constructors e query = "SELECT " <> maybe "1" id (constrId escape constr) <> " FROM " <> tableName escape e constr <> " WHERE " <> cond
Database/Groundhog/Generic/Sql.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, GADTs, OverloadedStrings, TypeSynonymInstances, FlexibleInstances, TypeFamilies, MultiParamTypeClasses, FunctionalDependencies, UndecidableInstances #-}+{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, OverloadedStrings, FlexibleInstances, TypeFamilies, UndecidableInstances #-} {-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -18,6 +18,7 @@ , renderPersistValue , intercalateS , commasJoin+ , flatten , RenderS(..) , Utf8(..) , fromUtf8
groundhog.cabal view
@@ -1,5 +1,5 @@ name: groundhog-version: 0.4.0.1+version: 0.4.0.2 license: BSD3 license-file: LICENSE author: Boris Lykah <lykahb@gmail.com>