groundhog 0.4.2 → 0.4.2.1
raw patch · 4 files changed
+15/−11 lines, 4 files
Files
- Database/Groundhog/Core.hs +1/−1
- Database/Groundhog/Generic/Sql.hs +7/−7
- Database/Groundhog/Instances.hs +6/−2
- groundhog.cabal +1/−1
Database/Groundhog/Core.hs view
@@ -228,7 +228,7 @@ orderBy opts ord = case getSelectOptions opts of SelectOptions c lim off _ -> SelectOptions c lim off ord -newtype Monad m => DbPersist conn m a = DbPersist { unDbPersist :: ReaderT conn m a }+newtype DbPersist conn m a = DbPersist { unDbPersist :: ReaderT conn m a } deriving (Monad, MonadIO, Functor, Applicative, MonadTrans, MonadReader conn) instance MonadBase IO m => MonadBase IO (DbPersist conn m) where
Database/Groundhog/Generic/Sql.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, OverloadedStrings, FlexibleInstances, TypeFamilies, UndecidableInstances, RecordWildCards #-}+{-# LANGUAGE FlexibleContexts, OverloadedStrings, FlexibleInstances, TypeFamilies, RecordWildCards #-} {-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -174,17 +174,17 @@ {-# INLINABLE renderCond #-} -- | Renders conditions for SQL backend. Returns Nothing if the fields don't have any columns.-renderCond :: forall r db . (SqlDb db, QueryRaw db ~ Snippet db)+renderCond :: (SqlDb db, QueryRaw db ~ Snippet db) => RenderConfig -> Cond db r -> Maybe (RenderS db r) renderCond conf cond = renderCondPriority conf 0 cond where {-# INLINABLE renderCondPriority #-} -- | Renders conditions for SQL backend. Returns Nothing if the fields don't have any columns.-renderCondPriority :: forall r db . (SqlDb db, QueryRaw db ~ Snippet db)+renderCondPriority :: (SqlDb db, QueryRaw db ~ Snippet db) => RenderConfig -> Int -> Cond db r -> Maybe (RenderS db r)-renderCondPriority conf@RenderConfig{..} priority (cond :: Cond db r) = go cond priority where+renderCondPriority conf@RenderConfig{..} priority cond = go cond priority where go (And a b) p = perhaps andP p " AND " a b go (Or a b) p = perhaps orP p " OR " a b go (Not a) p = fmap (\a' -> parens notP p $ "NOT " <> a') $ go a notP@@ -211,7 +211,6 @@ andP = 30 orP = 20 - perhaps :: Int -> Int -> Utf8 -> Cond db r -> Cond db r -> Maybe (RenderS db r) perhaps p pOuter op a b = result where -- we don't know if the current operator is present until we render both operands. Rendering requires priority of the outer operator. We tie a knot to defer calculating the priority (p', result) = case (go a p', go b p') of@@ -250,12 +249,13 @@ defaultShowPrim (PersistCustom _ _) = error "Unexpected PersistCustom" {-# INLINABLE renderOrders #-}-renderOrders :: forall db r . RenderConfig -> [Order db r] -> Utf8+renderOrders :: RenderConfig -> [Order db r] -> Utf8 renderOrders _ [] = mempty renderOrders conf xs = if null orders then mempty else " ORDER BY " <> commasJoin orders where orders = foldr go [] xs go (Asc a) acc = renderChain conf (fieldChain a) acc- go (Desc a) acc = map (<> " DESC") $ renderChain conf (fieldChain a) acc+ go (Desc a) acc = renderChain conf' (fieldChain a) acc where+ conf' = conf { esc = \f -> esc conf f <> " DESC" } {-# INLINABLE renderFields #-} -- Returns string with comma separated escaped fields like "name,age"
Database/Groundhog/Instances.hs view
@@ -3,7 +3,7 @@ module Database.Groundhog.Instances (Selector(..)) where import Database.Groundhog.Core-import Database.Groundhog.Generic (primToPersistValue, primFromPersistValue, primToPurePersistValues, primFromPurePersistValues, primToSinglePersistValue, primFromSinglePersistValue, pureFromPersistValue, phantomDb)+import Database.Groundhog.Generic (primToPersistValue, primFromPersistValue, primToPurePersistValues, primFromPurePersistValues, primToSinglePersistValue, primFromSinglePersistValue, phantomDb) import qualified Data.Text as T import qualified Data.Text.Encoding as T@@ -458,6 +458,10 @@ projectionExprs (Expr e) = (e:) projectionResult _ = fromPersistValues +instance a ~ Bool => Projection (Cond db r) db r a where+ projectionExprs cond = (ExprCond cond:)+ projectionResult _ = fromPersistValues+ instance (EntityConstr v c, a ~ AutoKey v) => Projection (AutoKeyField v c) db (RestrictionHolder v c) a where projectionExprs f = (ExprField (fieldChain f):) projectionResult _ = fromPersistValues@@ -477,7 +481,7 @@ UniqueDef _ _ uFields = constrUniques constr !! uniqueNum ((undefined :: u (UniqueMarker v) -> Key v (Unique u)) u) chains = map (\f -> (f, [])) uFields constr = head $ constructors (entityDef ((undefined :: u (UniqueMarker v) -> v) u))- projectionResult _ = pureFromPersistValue+ projectionResult _ = fromPersistValues instance (Projection a1 db r a1', Projection a2 db r a2') => Projection (a1, a2) db r (a1', a2') where projectionExprs (a1, a2) = projectionExprs a1 . projectionExprs a2
groundhog.cabal view
@@ -1,5 +1,5 @@ name: groundhog-version: 0.4.2+version: 0.4.2.1 license: BSD3 license-file: LICENSE author: Boris Lykah <lykahb@gmail.com>